markdown-mode.el (441581B)
1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2007-2023 Jason R. Blevins and markdown-mode 4 ;; contributors (see the commit log for details). 5 6 ;; Author: Jason R. Blevins <jblevins@xbeta.org> 7 ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> 8 ;; Created: May 24, 2007 9 ;; Package-Version: 20241107.349 10 ;; Package-Revision: 6f59f72ca040 11 ;; Package-Requires: ((emacs "27.1")) 12 ;; Keywords: Markdown, GitHub Flavored Markdown, itex 13 ;; URL: https://jblevins.org/projects/markdown-mode/ 14 15 ;; This file is not part of GNU Emacs. 16 17 ;; This program is free software; you can redistribute it and/or modify 18 ;; it under the terms of the GNU General Public License as published by 19 ;; the Free Software Foundation, either version 3 of the License, or 20 ;; (at your option) any later version. 21 22 ;; This program is distributed in the hope that it will be useful, 23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 ;; GNU General Public License for more details. 26 27 ;; You should have received a copy of the GNU General Public License 28 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 29 30 ;;; Commentary: 31 32 ;; See the README.md file for details. 33 34 35 ;;; Code: 36 37 (require 'easymenu) 38 (require 'outline) 39 (require 'thingatpt) 40 (require 'cl-lib) 41 (require 'url-parse) 42 (require 'button) 43 (require 'color) 44 (require 'rx) 45 (require 'subr-x) 46 47 (defvar jit-lock-start) 48 (defvar jit-lock-end) 49 (defvar flyspell-generic-check-word-predicate) 50 (defvar electric-pair-pairs) 51 (defvar sh-ancestor-alist) 52 53 (declare-function project-roots "project") 54 (declare-function sh-set-shell "sh-script") 55 (declare-function mailcap-file-name-to-mime-type "mailcap") 56 (declare-function dnd-get-local-file-name "dnd") 57 58 ;; for older emacs<29 59 (declare-function mailcap-mime-type-to-extension "mailcap") 60 (declare-function file-name-with-extension "files") 61 (declare-function yank-media-handler "yank-media") 62 63 64 ;;; Constants ================================================================= 65 66 (defconst markdown-mode-version "2.7-alpha" 67 "Markdown mode version number.") 68 69 (defconst markdown-output-buffer-name "*markdown-output*" 70 "Name of temporary buffer for markdown command output.") 71 72 73 ;;; Global Variables ========================================================== 74 75 (defvar markdown-reference-label-history nil 76 "History of used reference labels.") 77 78 (defvar markdown-live-preview-mode nil 79 "Sentinel variable for command `markdown-live-preview-mode'.") 80 81 (defvar markdown-gfm-language-history nil 82 "History list of languages used in the current buffer in GFM code blocks.") 83 84 (defvar markdown-follow-link-functions nil 85 "Functions used to follow a link. 86 Each function is called with one argument, the link's URL. It 87 should return non-nil if it followed the link, or nil if not. 88 Functions are called in order until one of them returns non-nil; 89 otherwise the default link-following function is used.") 90 91 92 ;;; Customizable Variables ==================================================== 93 94 (defvar markdown-mode-hook nil 95 "Hook run when entering Markdown mode.") 96 97 (defvar markdown-before-export-hook nil 98 "Hook run before running Markdown to export XHTML output. 99 The hook may modify the buffer, which will be restored to it's 100 original state after exporting is complete.") 101 102 (defvar markdown-after-export-hook nil 103 "Hook run after XHTML output has been saved. 104 Any changes to the output buffer made by this hook will be saved.") 105 106 (defgroup markdown nil 107 "Major mode for editing text files in Markdown format." 108 :prefix "markdown-" 109 :group 'text 110 :link '(url-link "https://jblevins.org/projects/markdown-mode/")) 111 112 (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") 113 when (executable-find cmd) 114 return (file-name-nondirectory it)))) 115 (or command "markdown")) 116 "Command to run markdown." 117 :group 'markdown 118 :type '(choice (string :tag "Shell command") (repeat (string)) function)) 119 120 (defcustom markdown-command-needs-filename nil 121 "Set to non-nil if `markdown-command' does not accept input from stdin. 122 Instead, it will be passed a filename as the final command line 123 option. As a result, you will only be able to run Markdown from 124 buffers which are visiting a file." 125 :group 'markdown 126 :type 'boolean) 127 128 (defcustom markdown-open-command nil 129 "Command used for opening Markdown files directly. 130 For example, a standalone Markdown previewer. This command will 131 be called with a single argument: the filename of the current 132 buffer. It can also be a function, which will be called without 133 arguments." 134 :group 'markdown 135 :type '(choice file function (const :tag "None" nil))) 136 137 (defcustom markdown-open-image-command nil 138 "Command used for opening image files directly. 139 This is used at `markdown-follow-link-at-point'." 140 :group 'markdown 141 :type '(choice file function (const :tag "None" nil))) 142 143 (defcustom markdown-hr-strings 144 '("-------------------------------------------------------------------------------" 145 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" 146 "---------------------------------------" 147 "* * * * * * * * * * * * * * * * * * * *" 148 "---------" 149 "* * * * *") 150 "Strings to use when inserting horizontal rules. 151 The first string in the list will be the default when inserting a 152 horizontal rule. Strings should be listed in decreasing order of 153 prominence (as in headings from level one to six) for use with 154 promotion and demotion functions." 155 :group 'markdown 156 :type '(repeat string)) 157 158 (defcustom markdown-bold-underscore nil 159 "Use two underscores when inserting bold text instead of two asterisks." 160 :group 'markdown 161 :type 'boolean) 162 163 (defcustom markdown-italic-underscore nil 164 "Use underscores when inserting italic text instead of asterisks." 165 :group 'markdown 166 :type 'boolean) 167 168 (defcustom markdown-marginalize-headers nil 169 "When non-nil, put opening atx header markup in a left margin. 170 171 This setting goes well with `markdown-asymmetric-header'. But 172 sadly it conflicts with `linum-mode' since they both use the 173 same margin." 174 :group 'markdown 175 :type 'boolean 176 :safe 'booleanp 177 :package-version '(markdown-mode . "2.4")) 178 179 (defcustom markdown-marginalize-headers-margin-width 6 180 "Character width of margin used for marginalized headers. 181 The default value is based on there being six heading levels 182 defined by Markdown and HTML. Increasing this produces extra 183 whitespace on the left. Decreasing it may be preferred when 184 fewer than six nested heading levels are used." 185 :group 'markdown 186 :type 'integer 187 :safe 'natnump 188 :package-version '(markdown-mode . "2.4")) 189 190 (defcustom markdown-asymmetric-header nil 191 "Determines if atx header style will be asymmetric. 192 Set to a non-nil value to use asymmetric header styling, placing 193 header markup only at the beginning of the line. By default, 194 balanced markup will be inserted at the beginning and end of the 195 line around the header title." 196 :group 'markdown 197 :type 'boolean) 198 199 (defcustom markdown-indent-function 'markdown-indent-line 200 "Function to use to indent." 201 :group 'markdown 202 :type 'function) 203 204 (defcustom markdown-indent-on-enter t 205 "Determines indentation behavior when pressing \\[newline]. 206 Possible settings are nil, t, and \\='indent-and-new-item. 207 208 When non-nil, pressing \\[newline] will call `newline-and-indent' 209 to indent the following line according to the context using 210 `markdown-indent-function'. In this case, note that 211 \\[electric-newline-and-maybe-indent] can still be used to insert 212 a newline without indentation. 213 214 When set to \\='indent-and-new-item and the point is in a list item 215 when \\[newline] is pressed, the list will be continued on the next 216 line, where a new item will be inserted. 217 218 When set to nil, simply call `newline' as usual. In this case, 219 you can still indent lines using \\[markdown-cycle] and continue 220 lists with \\[markdown-insert-list-item]. 221 222 Note that this assumes the variable `electric-indent-mode' is 223 non-nil (enabled). When it is *disabled*, the behavior of 224 \\[newline] and `\\[electric-newline-and-maybe-indent]' are 225 reversed." 226 :group 'markdown 227 :type '(choice (const :tag "Don't automatically indent" nil) 228 (const :tag "Automatically indent" t) 229 (const :tag "Automatically indent and insert new list items" indent-and-new-item))) 230 231 (defcustom markdown-enable-wiki-links nil 232 "Syntax highlighting for wiki links. 233 Set this to a non-nil value to turn on wiki link support by default. 234 Support can be toggled later using the `markdown-toggle-wiki-links' 235 function or \\[markdown-toggle-wiki-links]." 236 :group 'markdown 237 :type 'boolean 238 :safe 'booleanp 239 :package-version '(markdown-mode . "2.2")) 240 241 (defcustom markdown-wiki-link-alias-first t 242 "When non-nil, treat aliased wiki links like [[alias text|PageName]]. 243 Otherwise, they will be treated as [[PageName|alias text]]." 244 :group 'markdown 245 :type 'boolean 246 :safe 'booleanp) 247 248 (defcustom markdown-wiki-link-search-subdirectories nil 249 "When non-nil, search for wiki link targets in subdirectories. 250 This is the default search behavior for GitHub and is 251 automatically set to t in `gfm-mode'." 252 :group 'markdown 253 :type 'boolean 254 :safe 'booleanp 255 :package-version '(markdown-mode . "2.2")) 256 257 (defcustom markdown-wiki-link-search-parent-directories nil 258 "When non-nil, search for wiki link targets in parent directories. 259 This is the default search behavior of Ikiwiki." 260 :group 'markdown 261 :type 'boolean 262 :safe 'booleanp 263 :package-version '(markdown-mode . "2.2")) 264 265 (defcustom markdown-wiki-link-search-type nil 266 "Searching type for markdown wiki link. 267 268 sub-directories: search for wiki link targets in sub directories 269 parent-directories: search for wiki link targets in parent directories 270 project: search for wiki link targets under project root" 271 :group 'markdown 272 :type '(set 273 (const :tag "search wiki link from subdirectories" sub-directories) 274 (const :tag "search wiki link from parent directories" parent-directories) 275 (const :tag "search wiki link under project root" project)) 276 :package-version '(markdown-mode . "2.5")) 277 278 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") 279 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") 280 281 (defcustom markdown-wiki-link-fontify-missing nil 282 "When non-nil, change wiki link face according to existence of target files. 283 This is expensive because it requires checking for the file each time the buffer 284 changes or the user switches windows. It is disabled by default because it may 285 cause lag when typing on slower machines." 286 :group 'markdown 287 :type 'boolean 288 :safe 'booleanp 289 :package-version '(markdown-mode . "2.2")) 290 291 (defcustom markdown-uri-types 292 '("acap" "cid" "data" "dav" "fax" "file" "ftp" 293 "geo" "gopher" "http" "https" "imap" "ldap" "mailto" 294 "mid" "message" "modem" "news" "nfs" "nntp" 295 "pop" "prospero" "rtsp" "service" "sip" "tel" 296 "telnet" "tip" "urn" "vemmi" "wais") 297 "Link types for syntax highlighting of URIs." 298 :group 'markdown 299 :type '(repeat (string :tag "URI scheme"))) 300 301 (defcustom markdown-url-compose-char 302 '(?∞ ?… ?⋯ ?# ?★ ?⚓) 303 "Placeholder character for hidden URLs. 304 This may be a single character or a list of characters. In case 305 of a list, the first one that satisfies `char-displayable-p' will 306 be used." 307 :type '(choice 308 (character :tag "Single URL replacement character") 309 (repeat :tag "List of possible URL replacement characters" 310 character)) 311 :package-version '(markdown-mode . "2.3")) 312 313 (defcustom markdown-blockquote-display-char 314 '("▌" "┃" ">") 315 "String to display when hiding blockquote markup. 316 This may be a single string or a list of string. In case of a 317 list, the first one that satisfies `char-displayable-p' will be 318 used." 319 :type '(choice 320 (string :tag "Single blockquote display string") 321 (repeat :tag "List of possible blockquote display strings" string)) 322 :package-version '(markdown-mode . "2.3")) 323 324 (defcustom markdown-hr-display-char 325 '(?─ ?━ ?-) 326 "Character for hiding horizontal rule markup. 327 This may be a single character or a list of characters. In case 328 of a list, the first one that satisfies `char-displayable-p' will 329 be used." 330 :group 'markdown 331 :type '(choice 332 (character :tag "Single HR display character") 333 (repeat :tag "List of possible HR display characters" character)) 334 :package-version '(markdown-mode . "2.3")) 335 336 (defcustom markdown-definition-display-char 337 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) 338 "Character for replacing definition list markup. 339 This may be a single character or a list of characters. In case 340 of a list, the first one that satisfies `char-displayable-p' will 341 be used." 342 :type '(choice 343 (character :tag "Single definition list character") 344 (repeat :tag "List of possible definition list characters" character)) 345 :package-version '(markdown-mode . "2.3")) 346 347 (defcustom markdown-enable-math nil 348 "Syntax highlighting for inline LaTeX and itex expressions. 349 Set this to a non-nil value to turn on math support by default. 350 Math support can be enabled, disabled, or toggled later using 351 `markdown-toggle-math' or \\[markdown-toggle-math]." 352 :group 'markdown 353 :type 'boolean 354 :safe 'booleanp) 355 (make-variable-buffer-local 'markdown-enable-math) 356 357 (defcustom markdown-enable-html t 358 "Enable font-lock support for HTML tags and attributes." 359 :group 'markdown 360 :type 'boolean 361 :safe 'booleanp 362 :package-version '(markdown-mode . "2.4")) 363 364 (defcustom markdown-enable-highlighting-syntax nil 365 "Enable highlighting syntax." 366 :group 'markdown 367 :type 'boolean 368 :safe 'booleanp 369 :package-version '(markdown-mode . "2.5")) 370 371 (defcustom markdown-css-paths nil 372 "List of URLs of CSS files to link to in the output XHTML." 373 :group 'markdown 374 :type '(repeat (string :tag "CSS File Path"))) 375 376 (defcustom markdown-content-type "text/html" 377 "Content type string for the http-equiv header in XHTML output. 378 When set to an empty string, this attribute is omitted. Defaults to 379 `text/html'." 380 :group 'markdown 381 :type 'string) 382 383 (defcustom markdown-coding-system nil 384 "Character set string for the http-equiv header in XHTML output. 385 Defaults to `buffer-file-coding-system' (and falling back to 386 `utf-8' when not available). Common settings are `iso-8859-1' 387 and `iso-latin-1'. Use `list-coding-systems' for more choices." 388 :group 'markdown 389 :type 'coding-system) 390 391 (defcustom markdown-export-kill-buffer t 392 "Kill output buffer after HTML export. 393 When non-nil, kill the HTML output buffer after 394 exporting with `markdown-export'." 395 :group 'markdown 396 :type 'boolean 397 :safe 'booleanp 398 :package-version '(markdown-mode . "2.4")) 399 400 (defcustom markdown-xhtml-header-content "" 401 "Additional content to include in the XHTML <head> block." 402 :group 'markdown 403 :type 'string) 404 405 (defcustom markdown-xhtml-body-preamble "" 406 "Content to include in the XHTML <body> block, before the output." 407 :group 'markdown 408 :type 'string 409 :safe 'stringp 410 :package-version '(markdown-mode . "2.4")) 411 412 (defcustom markdown-xhtml-body-epilogue "" 413 "Content to include in the XHTML <body> block, after the output." 414 :group 'markdown 415 :type 'string 416 :safe 'stringp 417 :package-version '(markdown-mode . "2.4")) 418 419 (defcustom markdown-xhtml-standalone-regexp 420 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" 421 "Regexp indicating whether `markdown-command' output is standalone XHTML." 422 :group 'markdown 423 :type 'regexp) 424 425 (defcustom markdown-link-space-sub-char "_" 426 "Character to use instead of spaces when mapping wiki links to filenames." 427 :group 'markdown 428 :type 'string) 429 430 (defcustom markdown-reference-location 'header 431 "Position where new reference definitions are inserted in the document." 432 :group 'markdown 433 :type '(choice (const :tag "At the end of the document" end) 434 (const :tag "Immediately after the current block" immediately) 435 (const :tag "At the end of the subtree" subtree) 436 (const :tag "Before next header" header))) 437 438 (defcustom markdown-footnote-location 'end 439 "Position where new footnotes are inserted in the document." 440 :group 'markdown 441 :type '(choice (const :tag "At the end of the document" end) 442 (const :tag "Immediately after the current block" immediately) 443 (const :tag "At the end of the subtree" subtree) 444 (const :tag "Before next header" header))) 445 446 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) 447 "Display specification for footnote markers and inline footnotes. 448 By default, footnote text is reduced in size and raised. Set to 449 nil to disable this." 450 :group 'markdown 451 :type '(choice (sexp :tag "Display specification") 452 (const :tag "Don't set display property" nil)) 453 :package-version '(markdown-mode . "2.4")) 454 455 (defcustom markdown-sub-superscript-display 456 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) 457 "Display specification for subscript and superscripts. 458 The car is used for subscript, the cdr is used for superscripts." 459 :group 'markdown 460 :type '(cons (choice (sexp :tag "Subscript form") 461 (const :tag "No lowering" nil)) 462 (choice (sexp :tag "Superscript form") 463 (const :tag "No raising" nil))) 464 :package-version '(markdown-mode . "2.4")) 465 466 (defcustom markdown-unordered-list-item-prefix " * " 467 "String inserted before unordered list items." 468 :group 'markdown 469 :type 'string) 470 471 (defcustom markdown-ordered-list-enumeration t 472 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. 473 While nil, always uses '1.' for the marker" 474 :group 'markdown 475 :type 'boolean 476 :package-version '(markdown-mode . "2.5")) 477 478 (defcustom markdown-nested-imenu-heading-index t 479 "Use nested or flat imenu heading index. 480 A nested index may provide more natural browsing from the menu, 481 but a flat list may allow for faster keyboard navigation via tab 482 completion." 483 :group 'markdown 484 :type 'boolean 485 :safe 'booleanp 486 :package-version '(markdown-mode . "2.2")) 487 488 (defcustom markdown-add-footnotes-to-imenu t 489 "Add footnotes to end of imenu heading index." 490 :group 'markdown 491 :type 'boolean 492 :safe 'booleanp 493 :package-version '(markdown-mode . "2.4")) 494 495 (defcustom markdown-make-gfm-checkboxes-buttons t 496 "When non-nil, make GFM checkboxes into buttons." 497 :group 'markdown 498 :type 'boolean) 499 500 (defcustom markdown-use-pandoc-style-yaml-metadata nil 501 "When non-nil, allow YAML metadata anywhere in the document." 502 :group 'markdown 503 :type 'boolean) 504 505 (defcustom markdown-split-window-direction 'any 506 "Preference for splitting windows for static and live preview. 507 The default value is \\='any, which instructs Emacs to use 508 `split-window-sensibly' to automatically choose how to split 509 windows based on the values of `split-width-threshold' and 510 `split-height-threshold' and the available windows. To force 511 vertically split (left and right) windows, set this to \\='vertical 512 or \\='right. To force horizontally split (top and bottom) windows, 513 set this to \\='horizontal or \\='below. 514 515 If this value is \\='any and `display-buffer-alist' is set then 516 `display-buffer' is used for open buffer function" 517 :group 'markdown 518 :type '(choice (const :tag "Automatic" any) 519 (const :tag "Right (vertical)" right) 520 (const :tag "Below (horizontal)" below)) 521 :package-version '(markdown-mode . "2.2")) 522 523 (defcustom markdown-live-preview-window-function 524 #'markdown-live-preview-window-eww 525 "Function to display preview of Markdown output within Emacs. 526 Function must update the buffer containing the preview and return 527 the buffer." 528 :group 'markdown 529 :type 'function) 530 531 (defcustom markdown-live-preview-delete-export 'delete-on-destroy 532 "Delete exported HTML file when using `markdown-live-preview-export'. 533 If set to \\='delete-on-export, delete on every export. When set to 534 \\='delete-on-destroy delete when quitting from command 535 `markdown-live-preview-mode'. Never delete if set to nil." 536 :group 'markdown 537 :type '(choice 538 (const :tag "Delete on every export" delete-on-export) 539 (const :tag "Delete when quitting live preview" delete-on-destroy) 540 (const :tag "Never delete" nil))) 541 542 (defcustom markdown-list-indent-width 4 543 "Depth of indentation for markdown lists. 544 Used in `markdown-demote-list-item' and 545 `markdown-promote-list-item'." 546 :group 'markdown 547 :type 'integer) 548 549 (defcustom markdown-enable-prefix-prompts t 550 "Display prompts for certain prefix commands. 551 Set to nil to disable these prompts." 552 :group 'markdown 553 :type 'boolean 554 :safe 'booleanp 555 :package-version '(markdown-mode . "2.3")) 556 557 (defcustom markdown-gfm-additional-languages nil 558 "Extra languages made available when inserting GFM code blocks. 559 Language strings must have be trimmed of whitespace and not 560 contain any curly braces. They may be of arbitrary 561 capitalization, though." 562 :group 'markdown 563 :type '(repeat (string :validate markdown-validate-language-string))) 564 565 (defcustom markdown-gfm-use-electric-backquote t 566 "Use `markdown-electric-backquote' when backquote is hit three times." 567 :group 'markdown 568 :type 'boolean) 569 570 (defcustom markdown-gfm-downcase-languages t 571 "If non-nil, downcase suggested languages. 572 This applies to insertions done with 573 `markdown-electric-backquote'." 574 :group 'markdown 575 :type 'boolean) 576 577 (defcustom markdown-edit-code-block-default-mode 'normal-mode 578 "Default mode to use for editing code blocks. 579 This mode is used when automatic detection fails, such as for GFM 580 code blocks with no language specified." 581 :group 'markdown 582 :type '(choice function (const :tag "None" nil)) 583 :package-version '(markdown-mode . "2.4")) 584 585 (defcustom markdown-gfm-uppercase-checkbox nil 586 "If non-nil, use [X] for completed checkboxes, [x] otherwise." 587 :group 'markdown 588 :type 'boolean 589 :safe 'booleanp) 590 591 (defcustom markdown-hide-urls nil 592 "Hide URLs of inline links and reference tags of reference links. 593 Such URLs will be replaced by a single customizable 594 character, defined by `markdown-url-compose-char', but are still part 595 of the buffer. Links can be edited interactively with 596 \\[markdown-insert-link] or, for example, by deleting the final 597 parenthesis to remove the invisibility property. You can also 598 hover your mouse pointer over the link text to see the URL. 599 Set this to a non-nil value to turn this feature on by default. 600 You can interactively set the value of this variable by calling 601 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], 602 or from the menu Markdown > Links & Images menu." 603 :group 'markdown 604 :type 'boolean 605 :safe 'booleanp 606 :package-version '(markdown-mode . "2.3")) 607 (make-variable-buffer-local 'markdown-hide-urls) 608 609 (defcustom markdown-translate-filename-function #'identity 610 "Function to use to translate filenames when following links. 611 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] 612 call this function with the filename as only argument whenever 613 they encounter a filename (instead of a URL) to be visited and 614 use its return value instead of the filename in the link. For 615 example, if absolute filenames are actually relative to a server 616 root directory, you can set 617 `markdown-translate-filename-function' to a function that 618 prepends the root directory to the given filename." 619 :group 'markdown 620 :type 'function 621 :risky t 622 :package-version '(markdown-mode . "2.4")) 623 624 (defcustom markdown-max-image-size nil 625 "Maximum width and height for displayed inline images. 626 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). 627 When nil, use the actual size. Otherwise, use ImageMagick to 628 resize larger images to be of the given maximum dimensions. This 629 requires Emacs to be built with ImageMagick support." 630 :group 'markdown 631 :package-version '(markdown-mode . "2.4") 632 :type '(choice 633 (const :tag "Use actual image width" nil) 634 (cons (choice (sexp :tag "Maximum width in pixels") 635 (const :tag "No maximum width" nil)) 636 (choice (sexp :tag "Maximum height in pixels") 637 (const :tag "No maximum height" nil))))) 638 639 (defcustom markdown-mouse-follow-link t 640 "Non-nil means mouse on a link will follow the link. 641 This variable must be set before loading markdown-mode." 642 :group 'markdown 643 :type 'boolean 644 :safe 'booleanp 645 :package-version '(markdown-mode . "2.5")) 646 647 (defcustom markdown-table-align-p t 648 "Non-nil means that table is aligned after table operation." 649 :group 'markdown 650 :type 'boolean 651 :safe 'booleanp 652 :package-version '(markdown-mode . "2.5")) 653 654 (defcustom markdown-fontify-whole-heading-line nil 655 "Non-nil means fontify the whole line for headings. 656 This is useful when setting a background color for the 657 markdown-header-face-* faces." 658 :group 'markdown 659 :type 'boolean 660 :safe 'booleanp 661 :package-version '(markdown-mode . "2.5")) 662 663 (defcustom markdown-special-ctrl-a/e nil 664 "Non-nil means `C-a' and `C-e' behave specially in headlines and items. 665 666 When t, `C-a' will bring back the cursor to the beginning of the 667 headline text. In an item, this will be the position after bullet 668 and check-box, if any. When the cursor is already at that 669 position, another `C-a' will bring it to the beginning of the 670 line. 671 672 `C-e' will jump to the end of the headline, ignoring the presence 673 of closing tags in the headline. A second `C-e' will then jump to 674 the true end of the line, after closing tags. This also means 675 that, when this variable is non-nil, `C-e' also will never jump 676 beyond the end of the heading of a folded section, i.e. not after 677 the ellipses. 678 679 When set to the symbol `reversed', the first `C-a' or `C-e' works 680 normally, going to the true line boundary first. Only a directly 681 following, identical keypress will bring the cursor to the 682 special positions. 683 684 This may also be a cons cell where the behavior for `C-a' and 685 `C-e' is set separately." 686 :group 'markdown 687 :type '(choice 688 (const :tag "off" nil) 689 (const :tag "on: after hashes/bullet and before closing tags first" t) 690 (const :tag "reversed: true line boundary first" reversed) 691 (cons :tag "Set C-a and C-e separately" 692 (choice :tag "Special C-a" 693 (const :tag "off" nil) 694 (const :tag "on: after hashes/bullet first" t) 695 (const :tag "reversed: before hashes/bullet first" reversed)) 696 (choice :tag "Special C-e" 697 (const :tag "off" nil) 698 (const :tag "on: before closing tags first" t) 699 (const :tag "reversed: after closing tags first" reversed)))) 700 :package-version '(markdown-mode . "2.7")) 701 702 ;;; Markdown-Specific `rx' Macro ============================================== 703 704 ;; Based on python-rx from python.el. 705 (defmacro markdown-rx (&rest regexps) 706 "Markdown mode specialized rx macro. 707 This variant of `rx' supports common Markdown named REGEXPS." 708 `(rx-let ((newline "\n") 709 ;; Note: #405 not consider markdown-list-indent-width however this is never used 710 (indent (or (repeat 4 " ") "\t")) 711 (block-end (and (or (one-or-more (zero-or-more blank) "\n") line-end))) 712 (numeral (and (one-or-more (any "0-9#")) ".")) 713 (bullet (any "*+:-")) 714 (list-marker (or (and (one-or-more (any "0-9#")) ".") 715 (any "*+:-"))) 716 (checkbox (seq "[" (any " xX") "]"))) 717 (rx ,@regexps))) 718 719 720 ;;; Regular Expressions ======================================================= 721 722 (defconst markdown-regex-comment-start 723 "<!--" 724 "Regular expression matches HTML comment opening.") 725 726 (defconst markdown-regex-comment-end 727 "--[ \t]*>" 728 "Regular expression matches HTML comment closing.") 729 730 (defconst markdown-regex-link-inline 731 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" 732 "Regular expression for a [text](file) or an image link ![text](file). 733 Group 1 matches the leading exclamation point (optional). 734 Group 2 matches the opening square bracket. 735 Group 3 matches the text inside the square brackets. 736 Group 4 matches the closing square bracket. 737 Group 5 matches the opening parenthesis. 738 Group 6 matches the URL. 739 Group 7 matches the title (optional). 740 Group 8 matches the closing parenthesis.") 741 742 (defconst markdown-regex-link-reference 743 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" 744 "Regular expression for a reference link [text][id]. 745 Group 1 matches the leading exclamation point (optional). 746 Group 2 matches the opening square bracket for the link text. 747 Group 3 matches the text inside the square brackets. 748 Group 4 matches the closing square bracket for the link text. 749 Group 5 matches the opening square bracket for the reference label. 750 Group 6 matches the reference label. 751 Group 7 matches the closing square bracket for the reference label.") 752 753 (defconst markdown-regex-reference-definition 754 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" 755 "Regular expression for a reference definition. 756 Group 1 matches the opening square bracket. 757 Group 2 matches the reference label. 758 Group 3 matches the closing square bracket. 759 Group 4 matches the colon. 760 Group 5 matches the URL. 761 Group 6 matches the title attribute (optional).") 762 763 (defconst markdown-regex-footnote 764 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" 765 "Regular expression for a footnote marker [^fn]. 766 Group 1 matches the opening square bracket and carat. 767 Group 2 matches only the label, without the surrounding markup. 768 Group 3 matches the closing square bracket.") 769 770 (defconst markdown-regex-header 771 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" 772 "Regexp identifying Markdown headings. 773 Group 1 matches the text of a setext heading. 774 Group 2 matches the underline of a level-1 setext heading. 775 Group 3 matches the underline of a level-2 setext heading. 776 Group 4 matches the opening hash marks of an atx heading and whitespace. 777 Group 5 matches the text, without surrounding whitespace, of an atx heading. 778 Group 6 matches the closing whitespace and hash marks of an atx heading.") 779 780 (defconst markdown-regex-header-setext 781 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" 782 "Regular expression for generic setext-style (underline) headers.") 783 784 (defconst markdown-regex-header-atx 785 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" 786 "Regular expression for generic atx-style (hash mark) headers.") 787 788 (defconst markdown-regex-hr 789 (rx line-start 790 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) 791 (and (repeat 3 (and "-" (? " "))) (* (any "- "))) 792 (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) 793 line-end) 794 "Regular expression for matching Markdown horizontal rules.") 795 796 (defconst markdown-regex-code 797 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" 798 "Regular expression for matching inline code fragments. 799 800 Group 1 matches the entire code fragment including the backquotes. 801 Group 2 matches the opening backquotes. 802 Group 3 matches the code fragment itself, without backquotes. 803 Group 4 matches the closing backquotes. 804 805 The leading, unnumbered group ensures that the leading backquote 806 character is not escaped. 807 The last group, also unnumbered, requires that the character 808 following the code fragment is not a backquote. 809 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, 810 but not two newlines in a row.") 811 812 (defconst markdown-regex-kbd 813 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" 814 "Regular expression for matching <kbd> tags. 815 Groups 1 and 3 match the opening and closing tags. 816 Group 2 matches the key sequence.") 817 818 (defconst markdown-regex-gfm-code-block-open 819 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" 820 "Regular expression matching opening of GFM code blocks. 821 Group 1 matches the opening three backquotes and any following whitespace. 822 Group 2 matches the opening brace (optional) and surrounding whitespace. 823 Group 3 matches the language identifier (optional). 824 Group 4 matches the info string (optional). 825 Group 5 matches the closing brace (optional), whitespace, and newline. 826 Groups need to agree with `markdown-regex-tilde-fence-begin'.") 827 828 (defconst markdown-regex-gfm-code-block-close 829 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" 830 "Regular expression matching closing of GFM code blocks. 831 Group 1 matches the closing three backquotes. 832 Group 2 matches any whitespace and the final newline.") 833 834 (defconst markdown-regex-pre 835 "^\\( \\|\t\\).*$" 836 "Regular expression for matching preformatted text sections.") 837 838 (defconst markdown-regex-list 839 (markdown-rx line-start 840 ;; 1. Leading whitespace 841 (group (* blank)) 842 ;; 2. List marker: a numeral, bullet, or colon 843 (group list-marker) 844 ;; 3. Trailing whitespace 845 (group (+ blank)) 846 ;; 4. Optional checkbox for GFM task list items 847 (opt (group (and checkbox (* blank))))) 848 "Regular expression for matching list items.") 849 850 (defconst markdown-regex-bold 851 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" 852 "Regular expression for matching bold text. 853 Group 1 matches the character before the opening asterisk or 854 underscore, if any, ensuring that it is not a backslash escape. 855 Group 2 matches the entire expression, including delimiters. 856 Groups 3 and 5 matches the opening and closing delimiters. 857 Group 4 matches the text inside the delimiters.") 858 859 (defconst markdown-regex-italic 860 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" 861 "Regular expression for matching italic text. 862 The leading unnumbered matches the character before the opening 863 asterisk or underscore, if any, ensuring that it is not a 864 backslash escape. 865 Group 1 matches the entire expression, including delimiters. 866 Groups 2 and 4 matches the opening and closing delimiters. 867 Group 3 matches the text inside the delimiters.") 868 869 (defconst markdown-regex-strike-through 870 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" 871 "Regular expression for matching strike-through text. 872 Group 1 matches the character before the opening tilde, if any, 873 ensuring that it is not a backslash escape. 874 Group 2 matches the entire expression, including delimiters. 875 Groups 3 and 5 matches the opening and closing delimiters. 876 Group 4 matches the text inside the delimiters.") 877 878 (defconst markdown-regex-gfm-italic 879 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" 880 "Regular expression for matching italic text in GitHub Flavored Markdown. 881 Underscores in words are not treated as special. 882 Group 1 matches the entire expression, including delimiters. 883 Groups 2 and 4 matches the opening and closing delimiters. 884 Group 3 matches the text inside the delimiters.") 885 886 (defconst markdown-regex-blockquote 887 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" 888 "Regular expression for matching blockquote lines. 889 Also accounts for a potential capital letter preceding the angle 890 bracket, for use with Leanpub blocks (asides, warnings, info 891 blocks, etc.). 892 Group 1 matches the leading angle bracket. 893 Group 2 matches the separating whitespace. 894 Group 3 matches the text.") 895 896 (defconst markdown-regex-line-break 897 "[^ \n\t][ \t]*\\( \\)\n" 898 "Regular expression for matching line breaks.") 899 900 (defconst markdown-regex-escape 901 "\\(\\\\\\)." 902 "Regular expression for matching escape sequences.") 903 904 (defconst markdown-regex-wiki-link 905 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" 906 "Regular expression for matching wiki links. 907 This matches typical bracketed [[WikiLinks]] as well as \\='aliased 908 wiki links of the form [[PageName|link text]]. 909 The meanings of the first and second components depend 910 on the value of `markdown-wiki-link-alias-first'. 911 912 Group 1 matches the entire link. 913 Group 2 matches the opening square brackets. 914 Group 3 matches the first component of the wiki link. 915 Group 4 matches the pipe separator, when present. 916 Group 5 matches the second component of the wiki link, when present. 917 Group 6 matches the closing square brackets.") 918 919 (defconst markdown-regex-uri 920 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") 921 "Regular expression for matching inline URIs.") 922 923 ;; CommanMark specification says scheme length is 2-32 characters 924 (defconst markdown-regex-angle-uri 925 (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") 926 "Regular expression for matching inline URIs in angle brackets.") 927 928 (defconst markdown-regex-email 929 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" 930 "Regular expression for matching inline email addresses.") 931 932 (defsubst markdown-make-regex-link-generic () 933 "Make regular expression for matching any recognized link." 934 (concat "\\(?:" markdown-regex-link-inline 935 (when markdown-enable-wiki-links 936 (concat "\\|" markdown-regex-wiki-link)) 937 "\\|" markdown-regex-link-reference 938 "\\|" markdown-regex-angle-uri "\\)")) 939 940 (defconst markdown-regex-gfm-checkbox 941 " \\(\\[[ xX]\\]\\) " 942 "Regular expression for matching GFM checkboxes. 943 Group 1 matches the text to become a button.") 944 945 (defconst markdown-regex-blank-line 946 "^[[:blank:]]*$" 947 "Regular expression that matches a blank line.") 948 949 (defconst markdown-regex-block-separator 950 "\n[\n\t\f ]*\n" 951 "Regular expression for matching block boundaries.") 952 953 (defconst markdown-regex-block-separator-noindent 954 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") 955 "Regexp for block separators before lines with no indentation.") 956 957 (defconst markdown-regex-math-inline-single 958 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" 959 "Regular expression for itex $..$ math mode expressions. 960 Groups 1 and 3 match the opening and closing dollar signs. 961 Group 2 matches the mathematical expression contained within.") 962 963 (defconst markdown-regex-math-inline-double 964 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" 965 "Regular expression for itex $$..$$ math mode expressions. 966 Groups 1 and 3 match opening and closing dollar signs. 967 Group 2 matches the mathematical expression contained within.") 968 969 (defconst markdown-regex-math-display 970 (rx line-start (* blank) 971 (group (group (repeat 1 2 "\\")) "[") 972 (group (*? anything)) 973 (group (backref 2) "]") 974 line-end) 975 "Regular expression for \[..\] or \\[..\\] display math. 976 Groups 1 and 4 match the opening and closing markup. 977 Group 3 matches the mathematical expression contained within. 978 Group 2 matches the opening slashes, and is used internally to 979 match the closing slashes.") 980 981 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) 982 "Return regexp matching a tilde code fence at least NUM-TILDES long. 983 END-OF-LINE is the regexp construct to indicate end of line; $ if 984 missing." 985 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" 986 (or end-of-line "$"))) 987 988 (defconst markdown-regex-tilde-fence-begin 989 (markdown-make-tilde-fence-regex 990 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") 991 "Regular expression for matching tilde-fenced code blocks. 992 Group 1 matches the opening tildes. 993 Group 2 matches (optional) opening brace and surrounding whitespace. 994 Group 3 matches the language identifier (optional). 995 Group 4 matches the info string (optional). 996 Group 5 matches the closing brace (optional) and any surrounding whitespace. 997 Groups need to agree with `markdown-regex-gfm-code-block-open'.") 998 999 (defconst markdown-regex-declarative-metadata 1000 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" 1001 "Regular expression for matching declarative metadata statements. 1002 This matches MultiMarkdown metadata as well as YAML and TOML 1003 assignments such as the following: 1004 1005 variable: value 1006 1007 or 1008 1009 variable = value") 1010 1011 (defconst markdown-regex-pandoc-metadata 1012 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" 1013 "Regular expression for matching Pandoc metadata.") 1014 1015 (defconst markdown-regex-yaml-metadata-border 1016 "\\(-\\{3\\}\\)$" 1017 "Regular expression for matching YAML metadata.") 1018 1019 (defconst markdown-regex-yaml-pandoc-metadata-end-border 1020 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" 1021 "Regular expression for matching YAML metadata end borders.") 1022 1023 (defsubst markdown-get-yaml-metadata-start-border () 1024 "Return YAML metadata start border depending upon whether Pandoc is used." 1025 (concat 1026 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") 1027 markdown-regex-yaml-metadata-border)) 1028 1029 (defsubst markdown-get-yaml-metadata-end-border (_) 1030 "Return YAML metadata end border depending upon whether Pandoc is used." 1031 (if markdown-use-pandoc-style-yaml-metadata 1032 markdown-regex-yaml-pandoc-metadata-end-border 1033 markdown-regex-yaml-metadata-border)) 1034 1035 (defconst markdown-regex-inline-attributes 1036 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" 1037 "Regular expression for matching inline identifiers or attribute lists. 1038 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") 1039 1040 (defconst markdown-regex-leanpub-sections 1041 (concat 1042 "^\\({\\)\\(" 1043 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) 1044 "\\)\\(}\\)[ \t]*\n") 1045 "Regular expression for Leanpub section markers and related syntax.") 1046 1047 (defconst markdown-regex-sub-superscript 1048 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" 1049 "The regular expression matching a sub- or superscript. 1050 The leading un-numbered group matches the character before the 1051 opening tilde or carat, if any, ensuring that it is not a 1052 backslash escape, carat, or tilde. 1053 Group 1 matches the entire expression, including markup. 1054 Group 2 matches the opening markup--a tilde or carat. 1055 Group 3 matches the text inside the delimiters. 1056 Group 4 matches the closing markup--a tilde or carat.") 1057 1058 (defconst markdown-regex-include 1059 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" 1060 "Regular expression matching common forms of include syntax. 1061 Marked 2, Leanpub, and other processors support some of these forms: 1062 1063 <<[sections/section1.md] 1064 <<(folder/filename) 1065 <<[Code title](folder/filename) 1066 <<{folder/raw_file.html} 1067 1068 Group 1 matches the opening two angle brackets. 1069 Groups 2-4 match the opening square bracket, the text inside, 1070 and the closing square bracket, respectively. 1071 Groups 5-7 match the opening parenthesis, the text inside, and 1072 the closing parenthesis. 1073 Groups 8-10 match the opening brace, the text inside, and the brace.") 1074 1075 (defconst markdown-regex-pandoc-inline-footnote 1076 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" 1077 "Regular expression for Pandoc inline footnote^[footnote text]. 1078 Group 1 matches the opening caret. 1079 Group 2 matches the opening square bracket. 1080 Group 3 matches the footnote text, without the surrounding markup. 1081 Group 4 matches the closing square bracket.") 1082 1083 (defconst markdown-regex-html-attr 1084 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" 1085 "Regular expression for matching HTML attributes and values. 1086 Group 1 matches the attribute name. 1087 Group 2 matches the following whitespace, equals sign, and value, if any. 1088 Group 3 matches the equals sign, if any. 1089 Group 4 matches single-, double-, or un-quoted attribute values.") 1090 1091 (defconst markdown-regex-html-tag 1092 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr 1093 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") 1094 "Regular expression for matching HTML tags. 1095 Groups 1 and 9 match the beginning and ending angle brackets and slashes. 1096 Group 2 matches the tag name. 1097 Group 3 matches all attributes and whitespace following the tag name.") 1098 1099 (defconst markdown-regex-html-entity 1100 "\\(&#?[[:alnum:]]+;\\)" 1101 "Regular expression for matching HTML entities.") 1102 1103 (defconst markdown-regex-highlighting 1104 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" 1105 "Regular expression for matching highlighting text. 1106 Group 1 matches the character before the opening equal, if any, 1107 ensuring that it is not a backslash escape. 1108 Group 2 matches the entire expression, including delimiters. 1109 Groups 3 and 5 matches the opening and closing delimiters. 1110 Group 4 matches the text inside the delimiters.") 1111 1112 1113 ;;; Syntax ==================================================================== 1114 1115 (defvar markdown--syntax-properties 1116 (list 'markdown-tilde-fence-begin nil 1117 'markdown-tilde-fence-end nil 1118 'markdown-fenced-code nil 1119 'markdown-yaml-metadata-begin nil 1120 'markdown-yaml-metadata-end nil 1121 'markdown-yaml-metadata-section nil 1122 'markdown-gfm-block-begin nil 1123 'markdown-gfm-block-end nil 1124 'markdown-gfm-code nil 1125 'markdown-list-item nil 1126 'markdown-pre nil 1127 'markdown-blockquote nil 1128 'markdown-hr nil 1129 'markdown-comment nil 1130 'markdown-heading nil 1131 'markdown-heading-1-setext nil 1132 'markdown-heading-2-setext nil 1133 'markdown-heading-1-atx nil 1134 'markdown-heading-2-atx nil 1135 'markdown-heading-3-atx nil 1136 'markdown-heading-4-atx nil 1137 'markdown-heading-5-atx nil 1138 'markdown-heading-6-atx nil 1139 'markdown-metadata-key nil 1140 'markdown-metadata-value nil 1141 'markdown-metadata-markup nil) 1142 "Property list of all Markdown syntactic properties.") 1143 1144 (defvar markdown-literal-faces 1145 '(markdown-code-face 1146 markdown-inline-code-face 1147 markdown-pre-face 1148 markdown-math-face 1149 markdown-url-face 1150 markdown-plain-url-face 1151 markdown-language-keyword-face 1152 markdown-language-info-face 1153 markdown-metadata-key-face 1154 markdown-metadata-value-face 1155 markdown-html-entity-face 1156 markdown-html-tag-name-face 1157 markdown-html-tag-delimiter-face 1158 markdown-html-attr-name-face 1159 markdown-html-attr-value-face 1160 markdown-reference-face 1161 markdown-footnote-marker-face 1162 markdown-line-break-face 1163 markdown-comment-face) 1164 "A list of markdown-mode faces that contain literal text. 1165 Literal text treats backslashes literally, rather than as an 1166 escape character (see `markdown-match-escape').") 1167 1168 (defsubst markdown-in-comment-p (&optional pos) 1169 "Return non-nil if POS is in a comment. 1170 If POS is not given, use point instead." 1171 (get-text-property (or pos (point)) 'markdown-comment)) 1172 1173 (defun markdown--face-p (pos faces) 1174 "Return non-nil if face of POS contain FACES." 1175 (let ((face-prop (get-text-property pos 'face))) 1176 (if (listp face-prop) 1177 (cl-loop for face in face-prop 1178 thereis (memq face faces)) 1179 (memq face-prop faces)))) 1180 1181 (defsubst markdown--math-block-p (&optional pos) 1182 (when markdown-enable-math 1183 (markdown--face-p (or pos (point)) '(markdown-math-face)))) 1184 1185 (defun markdown-syntax-propertize-extend-region (start end) 1186 "Extend START to END region to include an entire block of text. 1187 This helps improve syntax analysis for block constructs. 1188 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. 1189 Function is called repeatedly until it returns nil. For details, see 1190 `syntax-propertize-extend-region-functions'." 1191 (save-match-data 1192 (save-excursion 1193 (let* ((new-start (progn (goto-char start) 1194 (skip-chars-forward "\n") 1195 (if (re-search-backward "\n\n" nil t) 1196 (min start (match-end 0)) 1197 (point-min)))) 1198 (new-end (progn (goto-char end) 1199 (skip-chars-backward "\n") 1200 (if (re-search-forward "\n\n" nil t) 1201 (max end (match-beginning 0)) 1202 (point-max)))) 1203 (code-match (markdown-code-block-at-pos new-start)) 1204 ;; FIXME: The `code-match' can return bogus values 1205 ;; when text has been inserted/deleted! 1206 (new-start (min (or (and code-match (cl-first code-match)) 1207 (point-max)) 1208 new-start)) 1209 (code-match (and (< end (point-max)) 1210 (markdown-code-block-at-pos end))) 1211 (new-end (max (or (and code-match (cl-second code-match)) 0) 1212 new-end))) 1213 1214 (unless (and (eq new-start start) (eq new-end end)) 1215 (cons new-start (min new-end (point-max)))))))) 1216 1217 (defun markdown-font-lock-extend-region-function (start end _) 1218 "Used in `jit-lock-after-change-extend-region-functions'. 1219 Delegates to `markdown-syntax-propertize-extend-region'. START 1220 and END are the previous region to refontify." 1221 (let ((res (markdown-syntax-propertize-extend-region start end))) 1222 (when res 1223 ;; syntax-propertize-function is not called when character at 1224 ;; (point-max) is deleted, but font-lock-extend-region-functions 1225 ;; are called. Force a syntax property update in that case. 1226 (when (= end (point-max)) 1227 ;; This function is called in a buffer modification hook. 1228 ;; `markdown-syntax-propertize' doesn't save the match data, 1229 ;; so we have to do it here. 1230 (save-match-data 1231 (markdown-syntax-propertize (car res) (cdr res)))) 1232 (setq jit-lock-start (car res) 1233 jit-lock-end (cdr res))))) 1234 1235 (defun markdown--cur-list-item-bounds () 1236 "Return a list describing the list item at point. 1237 Assumes that match data is set for `markdown-regex-list'. See the 1238 documentation for `markdown-cur-list-item-bounds' for the format of 1239 the returned list." 1240 (save-excursion 1241 (let* ((begin (match-beginning 0)) 1242 (indent (length (match-string-no-properties 1))) 1243 (nonlist-indent (- (match-end 3) (match-beginning 0))) 1244 (marker (buffer-substring-no-properties 1245 (match-beginning 2) (match-end 3))) 1246 (checkbox (match-string-no-properties 4)) 1247 (match (butlast (match-data t))) 1248 (end (markdown-cur-list-item-end nonlist-indent))) 1249 (list begin end indent nonlist-indent marker checkbox match)))) 1250 1251 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) 1252 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. 1253 Here, MARKER is a string representing the type of list and INDENT 1254 is an integer giving the indentation, in spaces, of the current 1255 block. CUR-BOUNDS is a list of the form returned by 1256 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds 1257 values for parent list items. When BOUNDS is nil, it means we are 1258 at baseline (not inside of a nested list)." 1259 (let ((prev-indent (or (cl-third (car bounds)) 0))) 1260 (cond 1261 ;; New list item at baseline. 1262 ((and marker (null bounds)) 1263 (list cur-bounds)) 1264 ;; List item with greater indentation (four or more spaces). 1265 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. 1266 ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) 1267 (cons cur-bounds bounds)) 1268 ;; List item with greater or equal indentation (less than four spaces). 1269 ;; Keep list level the same by replacing the car of BOUNDS. 1270 ((and marker (>= indent prev-indent)) 1271 (cons cur-bounds (cdr bounds))) 1272 ;; Lesser indentation level. 1273 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser 1274 ;; indentation could move back more than one list level). Note 1275 ;; that this block need not be the beginning of list item. 1276 ((< indent prev-indent) 1277 (while (and (> (length bounds) 1) 1278 (setq prev-indent (cl-third (cadr bounds))) 1279 (< indent (+ prev-indent markdown-list-indent-width))) 1280 (setq bounds (cdr bounds))) 1281 (cons cur-bounds bounds)) 1282 ;; Otherwise, do nothing. 1283 (t bounds)))) 1284 1285 (defun markdown-syntax-propertize-list-items (start end) 1286 "Propertize list items from START to END. 1287 Stores nested list item information in the `markdown-list-item' 1288 text property to make later syntax analysis easier. The value of 1289 this property is a list with elements of the form (begin . end) 1290 giving the bounds of the current and parent list items." 1291 (save-excursion 1292 (goto-char start) 1293 (let ((prev-list-line -100) 1294 bounds level pre-regexp) 1295 ;; Find a baseline point with zero list indentation 1296 (markdown-search-backward-baseline) 1297 ;; Search for all list items between baseline and END 1298 (while (and (< (point) end) 1299 (re-search-forward markdown-regex-list end 'limit)) 1300 ;; Level of list nesting 1301 (setq level (length bounds)) 1302 ;; Pre blocks need to be indented one level past the list level 1303 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) 1304 (beginning-of-line) 1305 (cond 1306 ;; Reset at headings, horizontal rules, and top-level blank lines. 1307 ;; Propertize baseline when in range. 1308 ((markdown-new-baseline) 1309 (setq bounds nil)) 1310 ;; Make sure this is not a line from a pre block 1311 ((and (looking-at-p pre-regexp) 1312 ;; too indented line is also treated as list if previous line is list 1313 (>= (- (line-number-at-pos) prev-list-line) 2))) 1314 ;; If not, then update levels and propertize list item when in range. 1315 (t 1316 (let* ((indent (current-indentation)) 1317 (cur-bounds (markdown--cur-list-item-bounds)) 1318 (first (cl-first cur-bounds)) 1319 (last (cl-second cur-bounds)) 1320 (marker (cl-fifth cur-bounds))) 1321 (setq bounds (markdown--append-list-item-bounds 1322 marker indent cur-bounds bounds)) 1323 (when (and (<= start (point)) (<= (point) end)) 1324 (setq prev-list-line (line-number-at-pos first)) 1325 (put-text-property first last 'markdown-list-item bounds))))) 1326 (end-of-line))))) 1327 1328 (defun markdown-syntax-propertize-pre-blocks (start end) 1329 "Match preformatted text blocks from START to END." 1330 (save-excursion 1331 (goto-char start) 1332 (let (finish) 1333 ;; Use loop for avoiding too many recursive calls 1334 ;; https://github.com/jrblevin/markdown-mode/issues/512 1335 (while (not finish) 1336 (let ((levels (markdown-calculate-list-levels)) 1337 indent pre-regexp close-regexp open close) 1338 (while (and (< (point) end) (not close)) 1339 ;; Search for a region with sufficient indentation 1340 (if (null levels) 1341 (setq indent 1) 1342 (setq indent (1+ (length levels)))) 1343 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) 1344 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) 1345 1346 (cond 1347 ;; If not at the beginning of a line, move forward 1348 ((not (bolp)) (forward-line)) 1349 ;; Move past blank lines 1350 ((markdown-cur-line-blank-p) (forward-line)) 1351 ;; At headers and horizontal rules, reset levels 1352 ((markdown-new-baseline) (forward-line) (setq levels nil)) 1353 ;; If the current line has sufficient indentation, mark out pre block 1354 ;; The opening should be preceded by a blank line. 1355 ((and (markdown-prev-line-blank) (looking-at pre-regexp)) 1356 (setq open (match-beginning 0)) 1357 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) 1358 (not (eobp))) 1359 (forward-line)) 1360 (skip-syntax-backward "-") 1361 (forward-line) 1362 (setq close (point))) 1363 ;; If current line has a list marker, update levels, move to end of block 1364 ((looking-at markdown-regex-list) 1365 (setq levels (markdown-update-list-levels 1366 (match-string 2) (current-indentation) levels)) 1367 (markdown-end-of-text-block)) 1368 ;; If this is the end of the indentation level, adjust levels accordingly. 1369 ;; Only match end of indentation level if levels is not the empty list. 1370 ((and (car levels) (looking-at-p close-regexp)) 1371 (setq levels (markdown-update-list-levels 1372 nil (current-indentation) levels)) 1373 (markdown-end-of-text-block)) 1374 (t (markdown-end-of-text-block)))) 1375 1376 (if (and open close) 1377 ;; Set text property data and continue to search 1378 (put-text-property open close 'markdown-pre (list open close)) 1379 (setq finish t)))) 1380 nil))) 1381 1382 (defconst markdown-fenced-block-pairs 1383 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) 1384 (markdown-make-tilde-fence-regex markdown-tilde-fence-end) 1385 markdown-fenced-code) 1386 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) 1387 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) 1388 markdown-yaml-metadata-section) 1389 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) 1390 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) 1391 markdown-gfm-code)) 1392 "Mapping of regular expressions to \"fenced-block\" constructs. 1393 These constructs are distinguished by having a distinctive start 1394 and end pattern, both of which take up an entire line of text, 1395 but no special pattern to identify text within the fenced 1396 blocks (unlike blockquotes and indented-code sections). 1397 1398 Each element within this list takes the form: 1399 1400 ((START-REGEX-OR-FUN START-PROPERTY) 1401 (END-REGEX-OR-FUN END-PROPERTY) 1402 MIDDLE-PROPERTY) 1403 1404 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a 1405 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no 1406 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument 1407 which is the length of the first group of the START-REGEX-OR-FUN match, which 1408 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to 1409 evaluate these into \"real\" regexps. 1410 1411 The *-PROPERTY elements are the text properties applied to each part of the 1412 block construct when it is matched using 1413 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied 1414 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and 1415 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the 1416 `match-data' when the regexp was matched to the text. In the case of 1417 MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with 1418 begin and end set to the edges of the \"middle\" text. This makes fontification 1419 easier.") 1420 1421 (defun markdown-text-property-at-point (prop) 1422 (get-text-property (point) prop)) 1423 1424 (defsubst markdown-maybe-funcall-regexp (object &optional arg) 1425 (cond ((functionp object) 1426 (if arg (funcall object arg) (funcall object))) 1427 ((stringp object) object) 1428 (t (error "Object cannot be turned into regex")))) 1429 1430 (defsubst markdown-get-start-fence-regexp () 1431 "Return regexp to find all \"start\" sections of fenced block constructs. 1432 Which construct is actually contained in the match must be found separately." 1433 (mapconcat 1434 #'identity 1435 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) 1436 markdown-fenced-block-pairs) 1437 "\\|")) 1438 1439 (defun markdown-get-fenced-block-begin-properties () 1440 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) 1441 1442 (defun markdown-get-fenced-block-end-properties () 1443 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) 1444 1445 (defun markdown-get-fenced-block-middle-properties () 1446 (cl-mapcar #'cl-third markdown-fenced-block-pairs)) 1447 1448 (defun markdown-find-previous-prop (prop &optional lim) 1449 "Find previous place where property PROP is non-nil, up to LIM. 1450 Return a cons of (pos . property). pos is point if point contains 1451 non-nil PROP." 1452 (let ((res 1453 (if (get-text-property (point) prop) (point) 1454 (previous-single-property-change 1455 (point) prop nil (or lim (point-min)))))) 1456 (when (and (not (get-text-property res prop)) 1457 (> res (point-min)) 1458 (get-text-property (1- res) prop)) 1459 (cl-decf res)) 1460 (when (and res (get-text-property res prop)) (cons res prop)))) 1461 1462 (defun markdown-find-next-prop (prop &optional lim) 1463 "Find next place where property PROP is non-nil, up to LIM. 1464 Return a cons of (POS . PROPERTY) where POS is point if point 1465 contains non-nil PROP." 1466 (let ((res 1467 (if (get-text-property (point) prop) (point) 1468 (next-single-property-change 1469 (point) prop nil (or lim (point-max)))))) 1470 (when (and res (get-text-property res prop)) (cons res prop)))) 1471 1472 (defun markdown-min-of-seq (map-fn seq) 1473 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." 1474 (cl-loop for el in seq 1475 with min = 1.0e+INF ; infinity 1476 with min-el = nil 1477 do (let ((res (funcall map-fn el))) 1478 (when (< res min) 1479 (setq min res) 1480 (setq min-el el))) 1481 finally return min-el)) 1482 1483 (defun markdown-max-of-seq (map-fn seq) 1484 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." 1485 (cl-loop for el in seq 1486 with max = -1.0e+INF ; negative infinity 1487 with max-el = nil 1488 do (let ((res (funcall map-fn el))) 1489 (when (and res (> res max)) 1490 (setq max res) 1491 (setq max-el el))) 1492 finally return max-el)) 1493 1494 (defun markdown-find-previous-block () 1495 "Find previous block. 1496 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was 1497 unable to propertize the entire block, but was able to propertize the beginning 1498 of the block. If so, return a cons of (pos . property) where the beginning of 1499 the block was propertized." 1500 (let ((start-pt (point)) 1501 (closest-open 1502 (markdown-max-of-seq 1503 #'car 1504 (cl-remove-if 1505 #'null 1506 (cl-mapcar 1507 #'markdown-find-previous-prop 1508 (markdown-get-fenced-block-begin-properties)))))) 1509 (when closest-open 1510 (let* ((length-of-open-match 1511 (let ((match-d 1512 (get-text-property (car closest-open) (cdr closest-open)))) 1513 (- (cl-fourth match-d) (cl-third match-d)))) 1514 (end-regexp 1515 (markdown-maybe-funcall-regexp 1516 (cl-caadr 1517 (cl-find-if 1518 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) 1519 markdown-fenced-block-pairs)) 1520 length-of-open-match)) 1521 (end-prop-loc 1522 (save-excursion 1523 (save-match-data 1524 (goto-char (car closest-open)) 1525 (and (re-search-forward end-regexp start-pt t) 1526 (match-beginning 0)))))) 1527 (and (not end-prop-loc) closest-open))))) 1528 1529 (defun markdown-get-fenced-block-from-start (prop) 1530 "Return limits of an enclosing fenced block from its start, using PROP. 1531 Return value is a list usable as `match-data'." 1532 (catch 'no-rest-of-block 1533 (let* ((correct-entry 1534 (cl-find-if 1535 (lambda (entry) (eq (cl-cadar entry) prop)) 1536 markdown-fenced-block-pairs)) 1537 (begin-of-begin (cl-first (markdown-text-property-at-point prop))) 1538 (middle-prop (cl-third correct-entry)) 1539 (end-prop (cl-cadadr correct-entry)) 1540 (end-of-end 1541 (save-excursion 1542 (goto-char (match-end 0)) ; end of begin 1543 (unless (eobp) (forward-char)) 1544 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1545 (if (not mid-prop-v) ; no middle 1546 (progn 1547 ;; try to find end by advancing one 1548 (let ((end-prop-v 1549 (markdown-text-property-at-point end-prop))) 1550 (if end-prop-v (cl-second end-prop-v) 1551 (throw 'no-rest-of-block nil)))) 1552 (set-match-data mid-prop-v) 1553 (goto-char (match-end 0)) ; end of middle 1554 (beginning-of-line) ; into end 1555 (cl-second (markdown-text-property-at-point end-prop))))))) 1556 (list begin-of-begin end-of-end)))) 1557 1558 (defun markdown-get-fenced-block-from-middle (prop) 1559 "Return limits of an enclosing fenced block from its middle, using PROP. 1560 Return value is a list usable as `match-data'." 1561 (let* ((correct-entry 1562 (cl-find-if 1563 (lambda (entry) (eq (cl-third entry) prop)) 1564 markdown-fenced-block-pairs)) 1565 (begin-prop (cl-cadar correct-entry)) 1566 (begin-of-begin 1567 (save-excursion 1568 (goto-char (match-beginning 0)) 1569 (unless (bobp) (forward-line -1)) 1570 (beginning-of-line) 1571 (cl-first (markdown-text-property-at-point begin-prop)))) 1572 (end-prop (cl-cadadr correct-entry)) 1573 (end-of-end 1574 (save-excursion 1575 (goto-char (match-end 0)) 1576 (beginning-of-line) 1577 (cl-second (markdown-text-property-at-point end-prop))))) 1578 (list begin-of-begin end-of-end))) 1579 1580 (defun markdown-get-fenced-block-from-end (prop) 1581 "Return limits of an enclosing fenced block from its end, using PROP. 1582 Return value is a list usable as `match-data'." 1583 (let* ((correct-entry 1584 (cl-find-if 1585 (lambda (entry) (eq (cl-cadadr entry) prop)) 1586 markdown-fenced-block-pairs)) 1587 (end-of-end (cl-second (markdown-text-property-at-point prop))) 1588 (middle-prop (cl-third correct-entry)) 1589 (begin-prop (cl-cadar correct-entry)) 1590 (begin-of-begin 1591 (save-excursion 1592 (goto-char (match-beginning 0)) ; beginning of end 1593 (unless (bobp) (backward-char)) ; into middle 1594 (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) 1595 (if (not mid-prop-v) 1596 (progn 1597 (beginning-of-line) 1598 (cl-first (markdown-text-property-at-point begin-prop))) 1599 (set-match-data mid-prop-v) 1600 (goto-char (match-beginning 0)) ; beginning of middle 1601 (unless (bobp) (forward-line -1)) ; into beginning 1602 (beginning-of-line) 1603 (cl-first (markdown-text-property-at-point begin-prop))))))) 1604 (list begin-of-begin end-of-end))) 1605 1606 (defun markdown-get-enclosing-fenced-block-construct (&optional pos) 1607 "Get \"fake\" match data for block enclosing POS. 1608 Returns fake match data which encloses the start, middle, and end 1609 of the block construct enclosing POS, if it exists. Used in 1610 `markdown-code-block-at-pos'." 1611 (save-excursion 1612 (when pos (goto-char pos)) 1613 (beginning-of-line) 1614 (car 1615 (cl-remove-if 1616 #'null 1617 (cl-mapcar 1618 (lambda (fun-and-prop) 1619 (cl-destructuring-bind (fun prop) fun-and-prop 1620 (when prop 1621 (save-match-data 1622 (set-match-data (markdown-text-property-at-point prop)) 1623 (funcall fun prop))))) 1624 `((markdown-get-fenced-block-from-start 1625 ,(cl-find-if 1626 #'markdown-text-property-at-point 1627 (markdown-get-fenced-block-begin-properties))) 1628 (markdown-get-fenced-block-from-middle 1629 ,(cl-find-if 1630 #'markdown-text-property-at-point 1631 (markdown-get-fenced-block-middle-properties))) 1632 (markdown-get-fenced-block-from-end 1633 ,(cl-find-if 1634 #'markdown-text-property-at-point 1635 (markdown-get-fenced-block-end-properties))))))))) 1636 1637 (defun markdown-propertize-end-match (reg end fence-spec middle-begin) 1638 "Get match for REG up to END, if exists, and propertize appropriately. 1639 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and 1640 MIDDLE-BEGIN is the start of the \"middle\" section of the block." 1641 (when (re-search-forward reg end t) 1642 (let ((close-begin (match-beginning 0)) ; Start of closing line. 1643 (close-end (match-end 0)) ; End of closing line. 1644 (close-data (match-data t))) ; Match data for closing line. 1645 ;; Propertize middle section of fenced block. 1646 (put-text-property middle-begin close-begin 1647 (cl-third fence-spec) 1648 (list middle-begin close-begin)) 1649 ;; If the block is a YAML block, propertize the declarations inside 1650 (when (< middle-begin close-begin) ;; workaround #634 1651 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) 1652 ;; Propertize closing line of fenced block. 1653 (put-text-property close-begin close-end 1654 (cl-cadadr fence-spec) close-data)))) 1655 1656 (defun markdown--triple-quote-single-line-p (begin) 1657 (save-excursion 1658 (goto-char begin) 1659 (save-match-data 1660 (and (search-forward "```" nil t) 1661 (search-forward "```" (line-end-position) t))))) 1662 1663 (defun markdown-syntax-propertize-fenced-block-constructs (start end) 1664 "Propertize according to `markdown-fenced-block-pairs' from START to END. 1665 If unable to propertize an entire block (if the start of a block is within START 1666 and END, but the end of the block is not), propertize the start section of a 1667 block, then in a subsequent call propertize both middle and end by finding the 1668 start which was previously propertized." 1669 (let ((start-reg (markdown-get-start-fence-regexp))) 1670 (save-excursion 1671 (goto-char start) 1672 ;; start from previous unclosed block, if exists 1673 (let ((prev-begin-block (markdown-find-previous-block))) 1674 (when prev-begin-block 1675 (let* ((correct-entry 1676 (cl-find-if (lambda (entry) 1677 (eq (cdr prev-begin-block) (cl-cadar entry))) 1678 markdown-fenced-block-pairs)) 1679 (enclosed-text-start (1+ (car prev-begin-block))) 1680 (start-length 1681 (save-excursion 1682 (goto-char (car prev-begin-block)) 1683 (string-match 1684 (markdown-maybe-funcall-regexp 1685 (caar correct-entry)) 1686 (buffer-substring 1687 (line-beginning-position) (line-end-position))) 1688 (- (match-end 1) (match-beginning 1)))) 1689 (end-reg (markdown-maybe-funcall-regexp 1690 (cl-caadr correct-entry) start-length))) 1691 (markdown-propertize-end-match 1692 end-reg end correct-entry enclosed-text-start)))) 1693 ;; find all new blocks within region 1694 (while (re-search-forward start-reg end t) 1695 ;; we assume the opening constructs take up (only) an entire line, 1696 ;; so we re-check the current line 1697 (let* ((block-start (match-beginning 0)) 1698 (cur-line (buffer-substring (line-beginning-position) (line-end-position))) 1699 ;; find entry in `markdown-fenced-block-pairs' corresponding 1700 ;; to regex which was matched 1701 (correct-entry 1702 (cl-find-if 1703 (lambda (fenced-pair) 1704 (string-match-p 1705 (markdown-maybe-funcall-regexp (caar fenced-pair)) 1706 cur-line)) 1707 markdown-fenced-block-pairs)) 1708 (enclosed-text-start 1709 (save-excursion (1+ (line-end-position)))) 1710 (end-reg 1711 (markdown-maybe-funcall-regexp 1712 (cl-caadr correct-entry) 1713 (if (and (match-beginning 1) (match-end 1)) 1714 (- (match-end 1) (match-beginning 1)) 1715 0))) 1716 (prop (cl-cadar correct-entry))) 1717 (when (or (not (eq prop 'markdown-gfm-block-begin)) 1718 (not (markdown--triple-quote-single-line-p block-start))) 1719 ;; get correct match data 1720 (save-excursion 1721 (beginning-of-line) 1722 (re-search-forward 1723 (markdown-maybe-funcall-regexp (caar correct-entry)) 1724 (line-end-position))) 1725 ;; mark starting, even if ending is outside of region 1726 (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) 1727 (markdown-propertize-end-match 1728 end-reg end correct-entry enclosed-text-start))))))) 1729 1730 (defun markdown-syntax-propertize-blockquotes (start end) 1731 "Match blockquotes from START to END." 1732 (save-excursion 1733 (goto-char start) 1734 (while (and (re-search-forward markdown-regex-blockquote end t) 1735 (not (markdown-code-block-at-pos (match-beginning 0)))) 1736 (put-text-property (match-beginning 0) (match-end 0) 1737 'markdown-blockquote 1738 (match-data t))))) 1739 1740 (defun markdown-syntax-propertize-hrs (start end) 1741 "Match horizontal rules from START to END." 1742 (save-excursion 1743 (goto-char start) 1744 (while (re-search-forward markdown-regex-hr end t) 1745 (let ((beg (match-beginning 0)) 1746 (end (match-end 0))) 1747 (goto-char beg) 1748 (unless (or (markdown-on-heading-p) 1749 (markdown-code-block-at-point-p)) 1750 (put-text-property beg end 'markdown-hr (match-data t))) 1751 (goto-char end))))) 1752 1753 (defun markdown-syntax-propertize-yaml-metadata (start end) 1754 "Propertize elements inside YAML metadata blocks from START to END. 1755 Assumes region from START and END is already known to be the interior 1756 region of a YAML metadata block as propertized by 1757 `markdown-syntax-propertize-fenced-block-constructs'." 1758 (save-excursion 1759 (goto-char start) 1760 (cl-loop 1761 while (re-search-forward markdown-regex-declarative-metadata end t) 1762 do (progn 1763 (put-text-property (match-beginning 1) (match-end 1) 1764 'markdown-metadata-key (match-data t)) 1765 (put-text-property (match-beginning 2) (match-end 2) 1766 'markdown-metadata-markup (match-data t)) 1767 (put-text-property (match-beginning 3) (match-end 3) 1768 'markdown-metadata-value (match-data t)))))) 1769 1770 (defun markdown-syntax-propertize-headings (start end) 1771 "Match headings of type SYMBOL with REGEX from START to END." 1772 (goto-char start) 1773 (while (re-search-forward markdown-regex-header end t) 1774 (unless (markdown-code-block-at-pos (match-beginning 0)) 1775 (put-text-property 1776 (match-beginning 0) (match-end 0) 'markdown-heading 1777 (match-data t)) 1778 (put-text-property 1779 (match-beginning 0) (match-end 0) 1780 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) 1781 ((match-string-no-properties 3) 'markdown-heading-2-setext) 1782 (t (let ((atx-level (length (markdown-trim-whitespace 1783 (match-string-no-properties 4))))) 1784 (intern (format "markdown-heading-%d-atx" atx-level))))) 1785 (match-data t))))) 1786 1787 (defun markdown-syntax-propertize-comments (start end) 1788 "Match HTML comments from the START to END." 1789 ;; Implement by loop instead of recursive call for avoiding 1790 ;; exceed max-lisp-eval-depth issue 1791 ;; https://github.com/jrblevin/markdown-mode/issues/536 1792 (let (finish) 1793 (goto-char start) 1794 (while (not finish) 1795 (let* ((in-comment (nth 4 (syntax-ppss))) 1796 (comment-begin (nth 8 (syntax-ppss)))) 1797 (cond 1798 ;; Comment start 1799 ((and (not in-comment) 1800 (re-search-forward markdown-regex-comment-start end t) 1801 (not (markdown-inline-code-at-point-p)) 1802 (not (markdown-code-block-at-point-p))) 1803 (let ((open-beg (match-beginning 0))) 1804 (put-text-property open-beg (1+ open-beg) 1805 'syntax-table (string-to-syntax "<")) 1806 (goto-char (min (1+ (match-end 0)) end (point-max))))) 1807 ;; Comment end 1808 ((and in-comment comment-begin 1809 (re-search-forward markdown-regex-comment-end end t)) 1810 (let ((comment-end (match-end 0))) 1811 (put-text-property (1- comment-end) comment-end 1812 'syntax-table (string-to-syntax ">")) 1813 ;; Remove any other text properties inside the comment 1814 (remove-text-properties comment-begin comment-end 1815 markdown--syntax-properties) 1816 (put-text-property comment-begin comment-end 1817 'markdown-comment (list comment-begin comment-end)) 1818 (goto-char (min comment-end end (point-max))))) 1819 ;; Nothing found 1820 (t (setq finish t))))) 1821 nil)) 1822 1823 (defun markdown-syntax-propertize (start end) 1824 "Function used as `syntax-propertize-function'. 1825 START and END delimit region to propertize." 1826 (with-silent-modifications 1827 (save-excursion 1828 (remove-text-properties start end markdown--syntax-properties) 1829 (markdown-syntax-propertize-fenced-block-constructs start end) 1830 (markdown-syntax-propertize-list-items start end) 1831 (markdown-syntax-propertize-pre-blocks start end) 1832 (markdown-syntax-propertize-blockquotes start end) 1833 (markdown-syntax-propertize-headings start end) 1834 (markdown-syntax-propertize-hrs start end) 1835 (markdown-syntax-propertize-comments start end)))) 1836 1837 1838 ;;; Markup Hiding ============================================================= 1839 1840 (defconst markdown-markup-properties 1841 '(face markdown-markup-face invisible markdown-markup) 1842 "List of properties and values to apply to markup.") 1843 1844 (defconst markdown-line-break-properties 1845 '(face markdown-line-break-face invisible markdown-markup) 1846 "List of properties and values to apply to line break markup.") 1847 1848 (defconst markdown-language-keyword-properties 1849 '(face markdown-language-keyword-face invisible markdown-markup) 1850 "List of properties and values to apply to code block language names.") 1851 1852 (defconst markdown-language-info-properties 1853 '(face markdown-language-info-face invisible markdown-markup) 1854 "List of properties and values to apply to code block language info strings.") 1855 1856 (defconst markdown-include-title-properties 1857 '(face markdown-link-title-face invisible markdown-markup) 1858 "List of properties and values to apply to included code titles.") 1859 1860 (defcustom markdown-hide-markup nil 1861 "Determines whether markup in the buffer will be hidden. 1862 When set to nil, all markup is displayed in the buffer as it 1863 appears in the file. An exception is when `markdown-hide-urls' 1864 is non-nil. 1865 Set this to a non-nil value to turn this feature on by default. 1866 You can interactively toggle the value of this variable with 1867 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], 1868 or from the Markdown > Show & Hide menu. 1869 1870 Markup hiding works by adding text properties to positions in the 1871 buffer---either the `invisible' property or the `display' property 1872 in cases where alternative glyphs are used (e.g., list bullets). 1873 This does not, however, affect printing or other output. 1874 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will 1875 not honor these text properties. For printing, it would be better 1876 to first convert to HTML or PDF (e.g,. using Pandoc)." 1877 :group 'markdown 1878 :type 'boolean 1879 :safe 'booleanp 1880 :package-version '(markdown-mode . "2.3")) 1881 (make-variable-buffer-local 'markdown-hide-markup) 1882 1883 (defun markdown-toggle-markup-hiding (&optional arg) 1884 "Toggle the display or hiding of markup. 1885 With a prefix argument ARG, enable markup hiding if ARG is positive, 1886 and disable it otherwise. 1887 See `markdown-hide-markup' for additional details." 1888 (interactive (list (or current-prefix-arg 'toggle))) 1889 (setq markdown-hide-markup 1890 (if (eq arg 'toggle) 1891 (not markdown-hide-markup) 1892 (> (prefix-numeric-value arg) 0))) 1893 (if markdown-hide-markup 1894 (add-to-invisibility-spec 'markdown-markup) 1895 (remove-from-invisibility-spec 'markdown-markup)) 1896 (when (called-interactively-p 'interactive) 1897 (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) 1898 (markdown-reload-extensions)) 1899 1900 1901 ;;; Font Lock ================================================================= 1902 1903 (require 'font-lock) 1904 1905 (defgroup markdown-faces nil 1906 "Faces used in Markdown Mode." 1907 :group 'markdown 1908 :group 'faces) 1909 1910 (defface markdown-italic-face 1911 '((t (:inherit italic))) 1912 "Face for italic text." 1913 :group 'markdown-faces) 1914 1915 (defface markdown-bold-face 1916 '((t (:inherit bold))) 1917 "Face for bold text." 1918 :group 'markdown-faces) 1919 1920 (defface markdown-strike-through-face 1921 '((t (:strike-through t))) 1922 "Face for strike-through text." 1923 :group 'markdown-faces) 1924 1925 (defface markdown-markup-face 1926 '((t (:inherit shadow :slant normal :weight normal))) 1927 "Face for markup elements." 1928 :group 'markdown-faces) 1929 1930 (defface markdown-header-rule-face 1931 '((t (:inherit markdown-markup-face))) 1932 "Base face for headers rules." 1933 :group 'markdown-faces) 1934 1935 (defface markdown-header-delimiter-face 1936 '((t (:inherit markdown-markup-face))) 1937 "Base face for headers hash delimiter." 1938 :group 'markdown-faces) 1939 1940 (defface markdown-list-face 1941 '((t (:inherit markdown-markup-face))) 1942 "Face for list item markers." 1943 :group 'markdown-faces) 1944 1945 (defface markdown-blockquote-face 1946 '((t (:inherit font-lock-doc-face))) 1947 "Face for blockquote sections." 1948 :group 'markdown-faces) 1949 1950 (defface markdown-code-face 1951 '((t (:inherit fixed-pitch))) 1952 "Face for inline code, pre blocks, and fenced code blocks. 1953 This may be used, for example, to add a contrasting background to 1954 inline code fragments and code blocks." 1955 :group 'markdown-faces) 1956 1957 (defface markdown-inline-code-face 1958 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1959 "Face for inline code." 1960 :group 'markdown-faces) 1961 1962 (defface markdown-pre-face 1963 '((t (:inherit (markdown-code-face font-lock-constant-face)))) 1964 "Face for preformatted text." 1965 :group 'markdown-faces) 1966 1967 (defface markdown-table-face 1968 '((t (:inherit (markdown-code-face)))) 1969 "Face for tables." 1970 :group 'markdown-faces) 1971 1972 (defface markdown-language-keyword-face 1973 '((t (:inherit font-lock-type-face))) 1974 "Face for programming language identifiers." 1975 :group 'markdown-faces) 1976 1977 (defface markdown-language-info-face 1978 '((t (:inherit font-lock-string-face))) 1979 "Face for programming language info strings." 1980 :group 'markdown-faces) 1981 1982 (defface markdown-link-face 1983 '((t (:inherit link))) 1984 "Face for links." 1985 :group 'markdown-faces) 1986 1987 (defface markdown-missing-link-face 1988 '((t (:inherit font-lock-warning-face))) 1989 "Face for missing links." 1990 :group 'markdown-faces) 1991 1992 (defface markdown-reference-face 1993 '((t (:inherit markdown-markup-face))) 1994 "Face for link references." 1995 :group 'markdown-faces) 1996 1997 (defface markdown-footnote-marker-face 1998 '((t (:inherit markdown-markup-face))) 1999 "Face for footnote markers." 2000 :group 'markdown-faces) 2001 2002 (defface markdown-footnote-text-face 2003 '((t (:inherit font-lock-comment-face))) 2004 "Face for footnote text." 2005 :group 'markdown-faces) 2006 2007 (defface markdown-url-face 2008 '((t (:inherit font-lock-string-face))) 2009 "Face for URLs that are part of markup. 2010 For example, this applies to URLs in inline links: 2011 [link text](http://example.com/)." 2012 :group 'markdown-faces) 2013 2014 (defface markdown-plain-url-face 2015 '((t (:inherit markdown-link-face))) 2016 "Face for URLs that are also links. 2017 For example, this applies to plain angle bracket URLs: 2018 <http://example.com/>." 2019 :group 'markdown-faces) 2020 2021 (defface markdown-link-title-face 2022 '((t (:inherit font-lock-comment-face))) 2023 "Face for reference link titles." 2024 :group 'markdown-faces) 2025 2026 (defface markdown-line-break-face 2027 '((t (:inherit font-lock-constant-face :underline t))) 2028 "Face for hard line breaks." 2029 :group 'markdown-faces) 2030 2031 (defface markdown-comment-face 2032 '((t (:inherit font-lock-comment-face))) 2033 "Face for HTML comments." 2034 :group 'markdown-faces) 2035 2036 (defface markdown-math-face 2037 '((t (:inherit font-lock-string-face))) 2038 "Face for LaTeX expressions." 2039 :group 'markdown-faces) 2040 2041 (defface markdown-metadata-key-face 2042 '((t (:inherit font-lock-variable-name-face))) 2043 "Face for metadata keys." 2044 :group 'markdown-faces) 2045 2046 (defface markdown-metadata-value-face 2047 '((t (:inherit font-lock-string-face))) 2048 "Face for metadata values." 2049 :group 'markdown-faces) 2050 2051 (defface markdown-gfm-checkbox-face 2052 '((t (:inherit font-lock-builtin-face))) 2053 "Face for GFM checkboxes." 2054 :group 'markdown-faces) 2055 2056 (defface markdown-highlight-face 2057 '((t (:inherit highlight))) 2058 "Face for mouse highlighting." 2059 :group 'markdown-faces) 2060 2061 (defface markdown-hr-face 2062 '((t (:inherit markdown-markup-face))) 2063 "Face for horizontal rules." 2064 :group 'markdown-faces) 2065 2066 (defface markdown-html-tag-name-face 2067 '((t (:inherit font-lock-type-face))) 2068 "Face for HTML tag names." 2069 :group 'markdown-faces) 2070 2071 (defface markdown-html-tag-delimiter-face 2072 '((t (:inherit markdown-markup-face))) 2073 "Face for HTML tag delimiters." 2074 :group 'markdown-faces) 2075 2076 (defface markdown-html-attr-name-face 2077 '((t (:inherit font-lock-variable-name-face))) 2078 "Face for HTML attribute names." 2079 :group 'markdown-faces) 2080 2081 (defface markdown-html-attr-value-face 2082 '((t (:inherit font-lock-string-face))) 2083 "Face for HTML attribute values." 2084 :group 'markdown-faces) 2085 2086 (defface markdown-html-entity-face 2087 '((t (:inherit font-lock-variable-name-face))) 2088 "Face for HTML entities." 2089 :group 'markdown-faces) 2090 2091 (defface markdown-highlighting-face 2092 '((t (:background "yellow" :foreground "black"))) 2093 "Face for highlighting." 2094 :group 'markdown-faces) 2095 2096 (defcustom markdown-header-scaling nil 2097 "Whether to use variable-height faces for headers. 2098 When non-nil, `markdown-header-face' will inherit from 2099 `variable-pitch' and the scaling values in 2100 `markdown-header-scaling-values' will be applied to 2101 headers of levels one through six respectively." 2102 :type 'boolean 2103 :initialize #'custom-initialize-default 2104 :set (lambda (symbol value) 2105 (set-default symbol value) 2106 (markdown-update-header-faces value)) 2107 :group 'markdown-faces 2108 :package-version '(markdown-mode . "2.2")) 2109 2110 (defcustom markdown-header-scaling-values 2111 '(2.0 1.7 1.4 1.1 1.0 1.0) 2112 "List of scaling values for headers of level one through six. 2113 Used when `markdown-header-scaling' is non-nil." 2114 :type '(repeat float) 2115 :initialize #'custom-initialize-default 2116 :set (lambda (symbol value) 2117 (set-default symbol value) 2118 (markdown-update-header-faces markdown-header-scaling value))) 2119 2120 (defmacro markdown--dotimes-when-compile (i-n body) 2121 (declare (indent 1) (debug ((symbolp form) form))) 2122 (let ((var (car i-n)) 2123 (n (cadr i-n)) 2124 (code ())) 2125 (dotimes (i (eval n t)) 2126 (push (eval body `((,var . ,i))) code)) 2127 `(progn ,@(nreverse code)))) 2128 2129 (defface markdown-header-face 2130 `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) 2131 font-lock-function-name-face) 2132 :weight bold))) 2133 "Base face for headers.") 2134 2135 (markdown--dotimes-when-compile (num 6) 2136 (let* ((num1 (1+ num)) 2137 (face-name (intern (format "markdown-header-face-%s" num1)))) 2138 `(defface ,face-name 2139 (,'\` ((t (:inherit markdown-header-face 2140 :height 2141 (,'\, (if markdown-header-scaling 2142 (float (nth ,num markdown-header-scaling-values)) 2143 1.0)))))) 2144 (format "Face for level %s headers. 2145 You probably don't want to customize this face directly. Instead 2146 you can customize the base face `markdown-header-face' or the 2147 variable-height variable `markdown-header-scaling'." ,num1)))) 2148 2149 (defun markdown-update-header-faces (&optional scaling scaling-values) 2150 "Update header faces, depending on if header SCALING is desired. 2151 If so, use given list of SCALING-VALUES relative to the baseline 2152 size of `markdown-header-face'." 2153 (dotimes (num 6) 2154 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) 2155 (scale (cond ((not scaling) 1.0) 2156 (scaling-values (float (nth num scaling-values))) 2157 (t (float (nth num markdown-header-scaling-values)))))) 2158 (unless (get face-name 'saved-face) ; Don't update customized faces 2159 (set-face-attribute face-name nil :height scale))))) 2160 2161 (defun markdown-syntactic-face (state) 2162 "Return font-lock face for characters with given STATE. 2163 See `font-lock-syntactic-face-function' for details." 2164 (let ((in-comment (nth 4 state))) 2165 (cond 2166 (in-comment 'markdown-comment-face) 2167 (t nil)))) 2168 2169 (defcustom markdown-list-item-bullets 2170 '("●" "◎" "○" "◆" "◇" "►" "•") 2171 "List of bullets to use for unordered lists. 2172 It can contain any number of symbols, which will be repeated. 2173 Depending on your font, some reasonable choices are: 2174 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." 2175 :group 'markdown 2176 :type '(repeat (string :tag "Bullet character")) 2177 :package-version '(markdown-mode . "2.3")) 2178 2179 (defun markdown--footnote-marker-properties () 2180 "Return a font-lock facespec expression for footnote marker text." 2181 `(face markdown-footnote-marker-face 2182 ,@(when markdown-hide-markup 2183 `(display ,markdown-footnote-display)))) 2184 2185 (defun markdown--pandoc-inline-footnote-properties () 2186 "Return a font-lock facespec expression for Pandoc inline footnote text." 2187 `(face markdown-footnote-text-face 2188 ,@(when markdown-hide-markup 2189 `(display ,markdown-footnote-display)))) 2190 2191 (defvar markdown-mode-font-lock-keywords 2192 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) 2193 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) 2194 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) 2195 (2 'markdown-markup-face) 2196 (3 'markdown-metadata-value-face))) 2197 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) 2198 (2 markdown-markup-properties nil t) 2199 (3 markdown-language-keyword-properties nil t) 2200 (4 markdown-language-info-properties nil t) 2201 (5 markdown-markup-properties nil t))) 2202 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) 2203 (markdown-fontify-gfm-code-blocks) 2204 (markdown-fontify-tables) 2205 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) 2206 (2 markdown-markup-properties nil t) 2207 (3 markdown-language-keyword-properties nil t) 2208 (4 markdown-language-info-properties nil t) 2209 (5 markdown-markup-properties nil t))) 2210 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) 2211 (markdown-fontify-fenced-code-blocks) 2212 (markdown-match-pre-blocks . ((0 'markdown-pre-face))) 2213 (markdown-fontify-headings) 2214 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) 2215 (2 'markdown-markup-face) 2216 (3 'markdown-metadata-value-face))) 2217 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) 2218 (2 'markdown-markup-face) 2219 (3 'markdown-metadata-value-face))) 2220 (markdown-fontify-hrs) 2221 (markdown-match-code . ((1 markdown-markup-properties prepend) 2222 (2 'markdown-inline-code-face prepend) 2223 (3 markdown-markup-properties prepend))) 2224 (,markdown-regex-kbd . ((1 markdown-markup-properties) 2225 (2 'markdown-inline-code-face) 2226 (3 markdown-markup-properties))) 2227 (markdown-fontify-angle-uris) 2228 (,markdown-regex-email . 'markdown-plain-url-face) 2229 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) 2230 (2 'markdown-html-tag-name-face t) 2231 (3 'markdown-html-tag-delimiter-face t) 2232 ;; Anchored matcher for HTML tag attributes 2233 (,markdown-regex-html-attr 2234 ;; Before searching, move past tag 2235 ;; name; set limit at tag close. 2236 (progn 2237 (goto-char (match-end 2)) (match-end 3)) 2238 nil 2239 . ((1 'markdown-html-attr-name-face) 2240 (3 'markdown-html-tag-delimiter-face nil t) 2241 (4 'markdown-html-attr-value-face nil t))))) 2242 (,markdown-regex-html-entity . 'markdown-html-entity-face) 2243 (markdown-fontify-list-items) 2244 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ 2245 (2 (markdown--footnote-marker-properties)) ; label 2246 (3 markdown-markup-properties))) ; ] 2247 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ 2248 (2 markdown-markup-properties) ; [ 2249 (3 (markdown--pandoc-inline-footnote-properties)) ; text 2250 (4 markdown-markup-properties))) ; ] 2251 (markdown-match-includes . ((1 markdown-markup-properties) 2252 (2 markdown-markup-properties nil t) 2253 (3 markdown-include-title-properties nil t) 2254 (4 markdown-markup-properties nil t) 2255 (5 markdown-markup-properties) 2256 (6 'markdown-url-face) 2257 (7 markdown-markup-properties))) 2258 (markdown-fontify-inline-links) 2259 (markdown-fontify-reference-links) 2260 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ 2261 (2 'markdown-reference-face) ; label 2262 (3 'markdown-markup-face) ; ] 2263 (4 'markdown-markup-face) ; : 2264 (5 'markdown-url-face) ; url 2265 (6 'markdown-link-title-face))) ; "title" (optional) 2266 (markdown-fontify-plain-uris) 2267 ;; Math mode $..$ 2268 (markdown-match-math-single . ((1 'markdown-markup-face prepend) 2269 (2 'markdown-math-face append) 2270 (3 'markdown-markup-face prepend))) 2271 ;; Math mode $$..$$ 2272 (markdown-match-math-double . ((1 'markdown-markup-face prepend) 2273 (2 'markdown-math-face append) 2274 (3 'markdown-markup-face prepend))) 2275 ;; Math mode \[..\] and \\[..\\] 2276 (markdown-match-math-display . ((1 'markdown-markup-face prepend) 2277 (3 'markdown-math-face append) 2278 (4 'markdown-markup-face prepend))) 2279 (markdown-match-bold . ((1 markdown-markup-properties prepend) 2280 (2 'markdown-bold-face append) 2281 (3 markdown-markup-properties prepend))) 2282 (markdown-match-italic . ((1 markdown-markup-properties prepend) 2283 (2 'markdown-italic-face append) 2284 (3 markdown-markup-properties prepend))) 2285 (,markdown-regex-strike-through . ((3 markdown-markup-properties) 2286 (4 'markdown-strike-through-face) 2287 (5 markdown-markup-properties))) 2288 (markdown--match-highlighting . ((3 markdown-markup-properties) 2289 (4 'markdown-highlighting-face) 2290 (5 markdown-markup-properties))) 2291 (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) 2292 (markdown-match-escape . ((1 markdown-markup-properties prepend))) 2293 (markdown-fontify-sub-superscripts) 2294 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) 2295 (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) 2296 (markdown-fontify-blockquotes) 2297 (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) 2298 "Syntax highlighting for Markdown files.") 2299 2300 ;; Footnotes 2301 (defvar-local markdown-footnote-counter 0 2302 "Counter for footnote numbers.") 2303 2304 (defconst markdown-footnote-chars 2305 "[[:alnum:]-]" 2306 "Regular expression matching any character for a footnote identifier.") 2307 2308 (defconst markdown-regex-footnote-definition 2309 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") 2310 "Regular expression matching a footnote definition, capturing the label.") 2311 2312 2313 ;;; Compatibility ============================================================= 2314 2315 (defun markdown--pandoc-reference-p () 2316 (let ((bounds (bounds-of-thing-at-point 'word))) 2317 (when (and bounds (char-before (car bounds))) 2318 (= (char-before (car bounds)) ?@)))) 2319 2320 (defun markdown-flyspell-check-word-p () 2321 "Return t if `flyspell' should check word just before point. 2322 Used for `flyspell-generic-check-word-predicate'." 2323 (save-excursion 2324 (goto-char (1- (point))) 2325 ;; https://github.com/jrblevin/markdown-mode/issues/560 2326 ;; enable spell check YAML meta data 2327 (if (or (and (markdown-code-block-at-point-p) 2328 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) 2329 (markdown-inline-code-at-point-p) 2330 (markdown-in-comment-p) 2331 (markdown--face-p (point) '(markdown-reference-face 2332 markdown-markup-face 2333 markdown-plain-url-face 2334 markdown-inline-code-face 2335 markdown-url-face)) 2336 (markdown--pandoc-reference-p)) 2337 (prog1 nil 2338 ;; If flyspell overlay is put, then remove it 2339 (let ((bounds (bounds-of-thing-at-point 'word))) 2340 (when bounds 2341 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) 2342 when (overlay-get ov 'flyspell-overlay) 2343 do 2344 (delete-overlay ov))))) 2345 t))) 2346 2347 2348 ;;; Markdown Parsing Functions ================================================ 2349 2350 (defun markdown-cur-line-blank-p () 2351 "Return t if the current line is blank and nil otherwise." 2352 (save-excursion 2353 (beginning-of-line) 2354 (looking-at-p markdown-regex-blank-line))) 2355 2356 (defun markdown-prev-line-blank () 2357 "Return t if the previous line is blank and nil otherwise. 2358 If we are at the first line, then consider the previous line to be blank." 2359 (or (= (line-beginning-position) (point-min)) 2360 (save-excursion 2361 (forward-line -1) 2362 (looking-at markdown-regex-blank-line)))) 2363 2364 (defun markdown-prev-line-blank-p () 2365 "Like `markdown-prev-line-blank', but preserve `match-data'." 2366 (save-match-data (markdown-prev-line-blank))) 2367 2368 (defun markdown-next-line-blank-p () 2369 "Return t if the next line is blank and nil otherwise. 2370 If we are at the last line, then consider the next line to be blank." 2371 (or (= (line-end-position) (point-max)) 2372 (save-excursion 2373 (forward-line 1) 2374 (markdown-cur-line-blank-p)))) 2375 2376 (defun markdown-prev-line-indent () 2377 "Return the number of leading whitespace characters in the previous line. 2378 Return 0 if the current line is the first line in the buffer." 2379 (save-excursion 2380 (if (= (line-beginning-position) (point-min)) 2381 0 2382 (forward-line -1) 2383 (current-indentation)))) 2384 2385 (defun markdown-next-line-indent () 2386 "Return the number of leading whitespace characters in the next line. 2387 Return 0 if line is the last line in the buffer." 2388 (save-excursion 2389 (if (= (line-end-position) (point-max)) 2390 0 2391 (forward-line 1) 2392 (current-indentation)))) 2393 2394 (defun markdown-new-baseline () 2395 "Determine if the current line begins a new baseline level. 2396 Assume point is positioned at beginning of line." 2397 (or (looking-at markdown-regex-header) 2398 (looking-at markdown-regex-hr) 2399 (and (= (current-indentation) 0) 2400 (not (looking-at markdown-regex-list)) 2401 (markdown-prev-line-blank)))) 2402 2403 (defun markdown-search-backward-baseline () 2404 "Search backward baseline point with no indentation and not a list item." 2405 (end-of-line) 2406 (let (stop) 2407 (while (not (or stop (bobp))) 2408 (re-search-backward markdown-regex-block-separator-noindent nil t) 2409 (when (match-end 2) 2410 (goto-char (match-end 2)) 2411 (cond 2412 ((markdown-new-baseline) 2413 (setq stop t)) 2414 ((looking-at-p markdown-regex-list) 2415 (setq stop nil)) 2416 (t (setq stop t))))))) 2417 2418 (defun markdown-update-list-levels (marker indent levels) 2419 "Update list levels given list MARKER, block INDENT, and current LEVELS. 2420 Here, MARKER is a string representing the type of list, INDENT is an integer 2421 giving the indentation, in spaces, of the current block, and LEVELS is a 2422 list of the indentation levels of parent list items. When LEVELS is nil, 2423 it means we are at baseline (not inside of a nested list)." 2424 (cond 2425 ;; New list item at baseline. 2426 ((and marker (null levels)) 2427 (setq levels (list indent))) 2428 ;; List item with greater indentation (four or more spaces). 2429 ;; Increase list level. 2430 ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) 2431 (setq levels (cons indent levels))) 2432 ;; List item with greater or equal indentation (less than four spaces). 2433 ;; Do not increase list level. 2434 ((and marker (>= indent (car levels))) 2435 levels) 2436 ;; Lesser indentation level. 2437 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser 2438 ;; indentation could move back more than one list level). Note 2439 ;; that this block need not be the beginning of list item. 2440 ((< indent (car levels)) 2441 (while (and (> (length levels) 1) 2442 (< indent (+ (cadr levels) markdown-list-indent-width))) 2443 (setq levels (cdr levels))) 2444 levels) 2445 ;; Otherwise, do nothing. 2446 (t levels))) 2447 2448 (defun markdown-calculate-list-levels () 2449 "Calculate list levels at point. 2450 Return a list of the form (n1 n2 n3 ...) where n1 is the 2451 indentation of the deepest nested list item in the branch of 2452 the list at the point, n2 is the indentation of the parent 2453 list item, and so on. The depth of the list item is therefore 2454 the length of the returned list. If the point is not at or 2455 immediately after a list item, return nil." 2456 (save-excursion 2457 (let ((first (point)) levels indent pre-regexp) 2458 ;; Find a baseline point with zero list indentation 2459 (markdown-search-backward-baseline) 2460 ;; Search for all list items between baseline and LOC 2461 (while (and (< (point) first) 2462 (re-search-forward markdown-regex-list first t)) 2463 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) 2464 (beginning-of-line) 2465 (cond 2466 ;; Make sure this is not a header or hr 2467 ((markdown-new-baseline) (setq levels nil)) 2468 ;; Make sure this is not a line from a pre block 2469 ((looking-at-p pre-regexp)) 2470 ;; If not, then update levels 2471 (t 2472 (setq indent (current-indentation)) 2473 (setq levels (markdown-update-list-levels (match-string 2) 2474 indent levels)))) 2475 (end-of-line)) 2476 levels))) 2477 2478 (defun markdown-prev-list-item (level) 2479 "Search backward from point for a list item with indentation LEVEL. 2480 Set point to the beginning of the item, and return point, or nil 2481 upon failure." 2482 (let (bounds indent prev) 2483 (setq prev (point)) 2484 (forward-line -1) 2485 (setq indent (current-indentation)) 2486 (while 2487 (cond 2488 ;; List item 2489 ((and (looking-at-p markdown-regex-list) 2490 (setq bounds (markdown-cur-list-item-bounds))) 2491 (cond 2492 ;; Stop and return point at item of equal indentation 2493 ((= (nth 3 bounds) level) 2494 (setq prev (point)) 2495 nil) 2496 ;; Stop and return nil at item with lesser indentation 2497 ((< (nth 3 bounds) level) 2498 (setq prev nil) 2499 nil) 2500 ;; Stop at beginning of buffer 2501 ((bobp) (setq prev nil)) 2502 ;; Continue at item with greater indentation 2503 ((> (nth 3 bounds) level) t))) 2504 ;; Stop at beginning of buffer 2505 ((bobp) (setq prev nil)) 2506 ;; Continue if current line is blank 2507 ((markdown-cur-line-blank-p) t) 2508 ;; Continue while indentation is the same or greater 2509 ((>= indent level) t) 2510 ;; Stop if current indentation is less than list item 2511 ;; and the next is blank 2512 ((and (< indent level) 2513 (markdown-next-line-blank-p)) 2514 (setq prev nil)) 2515 ;; Stop at a header 2516 ((looking-at-p markdown-regex-header) (setq prev nil)) 2517 ;; Stop at a horizontal rule 2518 ((looking-at-p markdown-regex-hr) (setq prev nil)) 2519 ;; Otherwise, continue. 2520 (t t)) 2521 (forward-line -1) 2522 (setq indent (current-indentation))) 2523 prev)) 2524 2525 (defun markdown-next-list-item (level) 2526 "Search forward from point for the next list item with indentation LEVEL. 2527 Set point to the beginning of the item, and return point, or nil 2528 upon failure." 2529 (let (bounds indent next) 2530 (setq next (point)) 2531 (if (looking-at markdown-regex-header-setext) 2532 (goto-char (match-end 0))) 2533 (forward-line) 2534 (setq indent (current-indentation)) 2535 (while 2536 (cond 2537 ;; Stop at end of the buffer. 2538 ((eobp) nil) 2539 ;; Continue if the current line is blank 2540 ((markdown-cur-line-blank-p) t) 2541 ;; List item 2542 ((and (looking-at-p markdown-regex-list) 2543 (setq bounds (markdown-cur-list-item-bounds))) 2544 (cond 2545 ;; Continue at item with greater indentation 2546 ((> (nth 3 bounds) level) t) 2547 ;; Stop and return point at item of equal indentation 2548 ((= (nth 3 bounds) level) 2549 (setq next (point)) 2550 nil) 2551 ;; Stop and return nil at item with lesser indentation 2552 ((< (nth 3 bounds) level) 2553 (setq next nil) 2554 nil))) 2555 ;; Continue while indentation is the same or greater 2556 ((>= indent level) t) 2557 ;; Stop if current indentation is less than list item 2558 ;; and the previous line was blank. 2559 ((and (< indent level) 2560 (markdown-prev-line-blank-p)) 2561 (setq next nil)) 2562 ;; Stop at a header 2563 ((looking-at-p markdown-regex-header) (setq next nil)) 2564 ;; Stop at a horizontal rule 2565 ((looking-at-p markdown-regex-hr) (setq next nil)) 2566 ;; Otherwise, continue. 2567 (t t)) 2568 (forward-line) 2569 (setq indent (current-indentation))) 2570 next)) 2571 2572 (defun markdown-cur-list-item-end (level) 2573 "Move to end of list item with pre-marker indentation LEVEL. 2574 Return the point at the end when a list item was found at the 2575 original point. If the point is not in a list item, do nothing." 2576 (let (indent) 2577 (forward-line) 2578 (setq indent (current-indentation)) 2579 (while 2580 (cond 2581 ;; Stop at end of the buffer. 2582 ((eobp) nil) 2583 ;; Continue while indentation is the same or greater 2584 ((>= indent level) t) 2585 ;; Continue if the current line is blank 2586 ((looking-at markdown-regex-blank-line) t) 2587 ;; Stop if current indentation is less than list item 2588 ;; and the previous line was blank. 2589 ((and (< indent level) 2590 (markdown-prev-line-blank)) 2591 nil) 2592 ;; Stop at a new list items of the same or lesser 2593 ;; indentation, headings, and horizontal rules. 2594 ((looking-at (concat "\\(?:" markdown-regex-list 2595 "\\|" markdown-regex-header 2596 "\\|" markdown-regex-hr "\\)")) 2597 nil) 2598 ;; Otherwise, continue. 2599 (t t)) 2600 (forward-line) 2601 (setq indent (current-indentation))) 2602 ;; Don't skip over whitespace for empty list items (marker and 2603 ;; whitespace only), just move to end of whitespace. 2604 (if (save-excursion 2605 (beginning-of-line) 2606 (looking-at (concat markdown-regex-list "[ \t]*$"))) 2607 (goto-char (match-end 3)) 2608 (skip-chars-backward " \t\n")) 2609 (end-of-line) 2610 (point))) 2611 2612 (defun markdown-cur-list-item-bounds () 2613 "Return bounds for list item at point. 2614 Return a list of the following form: 2615 2616 (begin end indent nonlist-indent marker checkbox match) 2617 2618 The named components are: 2619 2620 - begin: Position of beginning of list item, including leading indentation. 2621 - end: Position of the end of the list item, including list item text. 2622 - indent: Number of characters of indentation before list marker (an integer). 2623 - nonlist-indent: Number characters of indentation, list 2624 marker, and whitespace following list marker (an integer). 2625 - marker: String containing the list marker and following whitespace 2626 (e.g., \"- \" or \"* \"). 2627 - checkbox: String containing the GFM checkbox portion, if any, 2628 including any trailing whitespace before the text 2629 begins (e.g., \"[x] \"). 2630 - match: match data for markdown-regex-list 2631 2632 As an example, for the following unordered list item 2633 2634 - item 2635 2636 the returned list would be 2637 2638 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) 2639 2640 If the point is not inside a list item, return nil." 2641 (car (get-text-property (line-beginning-position) 'markdown-list-item))) 2642 2643 (defun markdown-list-item-at-point-p () 2644 "Return t if there is a list item at the point and nil otherwise." 2645 (save-match-data (markdown-cur-list-item-bounds))) 2646 2647 (defun markdown-prev-list-item-bounds () 2648 "Return bounds of previous item in the same list of any level. 2649 The return value has the same form as that of 2650 `markdown-cur-list-item-bounds'." 2651 (save-excursion 2652 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2653 (beginning-of-list (save-excursion (markdown-beginning-of-list))) 2654 stop) 2655 (when cur-bounds 2656 (goto-char (nth 0 cur-bounds)) 2657 (while (and (not stop) (not (bobp)) 2658 (re-search-backward markdown-regex-list 2659 beginning-of-list t)) 2660 (unless (or (looking-at markdown-regex-hr) 2661 (markdown-code-block-at-point-p)) 2662 (setq stop (point)))) 2663 (markdown-cur-list-item-bounds))))) 2664 2665 (defun markdown-next-list-item-bounds () 2666 "Return bounds of next item in the same list of any level. 2667 The return value has the same form as that of 2668 `markdown-cur-list-item-bounds'." 2669 (save-excursion 2670 (let ((cur-bounds (markdown-cur-list-item-bounds)) 2671 (end-of-list (save-excursion (markdown-end-of-list))) 2672 stop) 2673 (when cur-bounds 2674 (goto-char (nth 0 cur-bounds)) 2675 (end-of-line) 2676 (while (and (not stop) (not (eobp)) 2677 (re-search-forward markdown-regex-list 2678 end-of-list t)) 2679 (unless (or (looking-at markdown-regex-hr) 2680 (markdown-code-block-at-point-p)) 2681 (setq stop (point)))) 2682 (when stop 2683 (markdown-cur-list-item-bounds)))))) 2684 2685 (defun markdown-beginning-of-list () 2686 "Move point to beginning of list at point, if any." 2687 (interactive) 2688 (let ((orig-point (point)) 2689 (list-begin (save-excursion 2690 (markdown-search-backward-baseline) 2691 ;; Stop at next list item, regardless of the indentation. 2692 (markdown-next-list-item (point-max)) 2693 (when (looking-at markdown-regex-list) 2694 (point))))) 2695 (when (and list-begin (<= list-begin orig-point)) 2696 (goto-char list-begin)))) 2697 2698 (defun markdown-end-of-list () 2699 "Move point to end of list at point, if any." 2700 (interactive) 2701 (let ((start (point)) 2702 (end (save-excursion 2703 (when (markdown-beginning-of-list) 2704 ;; Items can't have nonlist-indent <= 1, so this 2705 ;; moves past all list items. 2706 (markdown-next-list-item 1) 2707 (skip-syntax-backward "-") 2708 (unless (eobp) (forward-char 1)) 2709 (point))))) 2710 (when (and end (>= end start)) 2711 (goto-char end)))) 2712 2713 (defun markdown-up-list () 2714 "Move point to beginning of parent list item." 2715 (interactive) 2716 (let ((cur-bounds (markdown-cur-list-item-bounds))) 2717 (when cur-bounds 2718 (markdown-prev-list-item (1- (nth 3 cur-bounds))) 2719 (let ((up-bounds (markdown-cur-list-item-bounds))) 2720 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) 2721 (point)))))) 2722 2723 (defun markdown-bounds-of-thing-at-point (thing) 2724 "Call `bounds-of-thing-at-point' for THING with slight modifications. 2725 Does not include trailing newlines when THING is \\='line. Handles the 2726 end of buffer case by setting both endpoints equal to the value of 2727 `point-max', since an empty region will trigger empty markup insertion. 2728 Return bounds of form (beg . end) if THING is found, or nil otherwise." 2729 (let* ((bounds (bounds-of-thing-at-point thing)) 2730 (a (car bounds)) 2731 (b (cdr bounds))) 2732 (when bounds 2733 (when (eq thing 'line) 2734 (cond ((and (eobp) (markdown-cur-line-blank-p)) 2735 (setq a b)) 2736 ((char-equal (char-before b) ?\^J) 2737 (setq b (1- b))))) 2738 (cons a b)))) 2739 2740 (defun markdown-reference-definition (reference) 2741 "Find out whether Markdown REFERENCE is defined. 2742 REFERENCE should not include the square brackets. 2743 When REFERENCE is defined, return a list of the form (text start end) 2744 containing the definition text itself followed by the start and end 2745 locations of the text. Otherwise, return nil. 2746 Leave match data for `markdown-regex-reference-definition' 2747 intact additional processing." 2748 (let ((reference (downcase reference))) 2749 (save-excursion 2750 (goto-char (point-min)) 2751 (catch 'found 2752 (while (re-search-forward markdown-regex-reference-definition nil t) 2753 (when (string= reference (downcase (match-string-no-properties 2))) 2754 (throw 'found 2755 (list (match-string-no-properties 5) 2756 (match-beginning 5) (match-end 5))))))))) 2757 2758 (defun markdown-get-defined-references () 2759 "Return all defined reference labels and their line numbers. 2760 They does not include square brackets)." 2761 (save-excursion 2762 (goto-char (point-min)) 2763 (let (refs) 2764 (while (re-search-forward markdown-regex-reference-definition nil t) 2765 (let ((target (match-string-no-properties 2))) 2766 (cl-pushnew 2767 (cons (downcase target) 2768 (markdown-line-number-at-pos (match-beginning 2))) 2769 refs :test #'equal :key #'car))) 2770 (reverse refs)))) 2771 2772 (defun markdown-get-used-uris () 2773 "Return a list of all used URIs in the buffer." 2774 (save-excursion 2775 (goto-char (point-min)) 2776 (let (uris) 2777 (while (re-search-forward 2778 (concat "\\(?:" markdown-regex-link-inline 2779 "\\|" markdown-regex-angle-uri 2780 "\\|" markdown-regex-uri 2781 "\\|" markdown-regex-email 2782 "\\)") 2783 nil t) 2784 (unless (or (markdown-inline-code-at-point-p) 2785 (markdown-code-block-at-point-p)) 2786 (cl-pushnew (or (match-string-no-properties 6) 2787 (match-string-no-properties 10) 2788 (match-string-no-properties 12) 2789 (match-string-no-properties 13)) 2790 uris :test #'equal))) 2791 (reverse uris)))) 2792 2793 (defun markdown-inline-code-at-pos (pos &optional from) 2794 "Return non-nil if there is an inline code fragment at POS starting at FROM. 2795 Uses the beginning of the block if FROM is nil. 2796 Return nil otherwise. Set match data according to 2797 `markdown-match-code' upon success. 2798 This function searches the block for a code fragment that 2799 contains the point using `markdown-match-code'. We do this 2800 because `thing-at-point-looking-at' does not work reliably with 2801 `markdown-regex-code'. 2802 2803 The match data is set as follows: 2804 Group 1 matches the opening backquotes. 2805 Group 2 matches the code fragment itself, without backquotes. 2806 Group 3 matches the closing backquotes." 2807 (save-excursion 2808 (goto-char pos) 2809 (let ((old-point (point)) 2810 (end-of-block (progn (markdown-end-of-text-block) (point))) 2811 found) 2812 (if from 2813 (goto-char from) 2814 (markdown-beginning-of-text-block)) 2815 (while (and (markdown-match-code end-of-block) 2816 (setq found t) 2817 (< (match-end 0) old-point))) 2818 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) 2819 (and found ; matched something 2820 (<= (match-beginning match-group) old-point) ; match contains old-point 2821 (> (match-end 0) old-point)))))) 2822 2823 (defun markdown-inline-code-at-pos-p (pos) 2824 "Return non-nil if there is an inline code fragment at POS. 2825 Like `markdown-inline-code-at-pos`, but preserves match data." 2826 (save-match-data (markdown-inline-code-at-pos pos))) 2827 2828 (defun markdown-inline-code-at-point () 2829 "Return non-nil if the point is at an inline code fragment. 2830 See `markdown-inline-code-at-pos' for details." 2831 (markdown-inline-code-at-pos (point))) 2832 2833 (defun markdown-inline-code-at-point-p (&optional pos) 2834 "Return non-nil if there is inline code at the POS. 2835 This is a predicate function counterpart to 2836 `markdown-inline-code-at-point' which does not modify the match 2837 data. See `markdown-code-block-at-point-p' for code blocks." 2838 (save-match-data (markdown-inline-code-at-pos (or pos (point))))) 2839 2840 (defun markdown-code-block-at-pos (pos) 2841 "Return match data list if there is a code block at POS. 2842 Uses text properties at the beginning of the line position. 2843 This includes pre blocks, tilde-fenced code blocks, and GFM 2844 quoted code blocks. Return nil otherwise." 2845 (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) 2846 (or (get-text-property bol 'markdown-pre) 2847 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) 2848 (second (cl-second bounds))) 2849 (if second 2850 ;; chunks are right open 2851 (when (< pos second) 2852 bounds) 2853 bounds))))) 2854 2855 ;; Function was renamed to emphasize that it does not modify match-data. 2856 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) 2857 2858 (defun markdown-code-block-at-point-p (&optional pos) 2859 "Return non-nil if there is a code block at the POS. 2860 This includes pre blocks, tilde-fenced code blocks, and GFM 2861 quoted code blocks. This function does not modify the match 2862 data. See `markdown-inline-code-at-point-p' for inline code." 2863 (save-match-data (markdown-code-block-at-pos (or pos (point))))) 2864 2865 (defun markdown-heading-at-point (&optional pos) 2866 "Return non-nil if there is a heading at the POS. 2867 Set match data for `markdown-regex-header'." 2868 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) 2869 (when match-data 2870 (set-match-data match-data) 2871 t))) 2872 2873 (defun markdown-pipe-at-bol-p () 2874 "Return non-nil if the line begins with a pipe symbol. 2875 This may be useful for tables and Pandoc's line_blocks extension." 2876 (char-equal (char-after (line-beginning-position)) ?|)) 2877 2878 2879 ;;; Markdown Font Lock Matching Functions ===================================== 2880 2881 (defun markdown-range-property-any (begin end prop prop-values) 2882 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. 2883 Also returns t if PROP is a list containing one of the PROP-VALUES. 2884 Return nil otherwise." 2885 (let (props) 2886 (catch 'found 2887 (dolist (loc (number-sequence begin end)) 2888 (when (setq props (get-text-property loc prop)) 2889 (cond ((listp props) 2890 ;; props is a list, check for membership 2891 (dolist (val prop-values) 2892 (when (memq val props) (throw 'found loc)))) 2893 (t 2894 ;; props is a scalar, check for equality 2895 (dolist (val prop-values) 2896 (when (eq val props) (throw 'found loc)))))))))) 2897 2898 (defun markdown-range-properties-exist (begin end props) 2899 (cl-loop 2900 for loc in (number-sequence begin end) 2901 with result = nil 2902 while (not 2903 (setq result 2904 (cl-some (lambda (prop) (get-text-property loc prop)) props))) 2905 finally return result)) 2906 2907 (defun markdown-match-inline-generic (regex last &optional faceless) 2908 "Match inline REGEX from the point to LAST. 2909 When FACELESS is non-nil, do not return matches where faces have been applied." 2910 (when (re-search-forward regex last t) 2911 (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) 2912 (face (and faceless (text-property-not-all 2913 (match-beginning 0) (match-end 0) 'face nil)))) 2914 (cond 2915 ;; In code block: move past it and recursively search again 2916 (bounds 2917 (when (< (goto-char (cl-second bounds)) last) 2918 (markdown-match-inline-generic regex last faceless))) 2919 ;; When faces are found in the match range, skip over the match and 2920 ;; recursively search again. 2921 (face 2922 (when (< (goto-char (match-end 0)) last) 2923 (markdown-match-inline-generic regex last faceless))) 2924 ;; Keep match data and return t when in bounds. 2925 (t 2926 (<= (match-end 0) last)))))) 2927 2928 (defun markdown-match-code (last) 2929 "Match inline code fragments from point to LAST." 2930 (unless (bobp) 2931 (backward-char 1)) 2932 (when (markdown-search-until-condition 2933 (lambda () 2934 (and 2935 ;; Advance point in case of failure, but without exceeding last. 2936 (goto-char (min (1+ (match-beginning 1)) last)) 2937 (not (markdown-in-comment-p (match-beginning 1))) 2938 (not (markdown-in-comment-p (match-end 1))) 2939 (not (markdown-code-block-at-pos (match-beginning 1))))) 2940 markdown-regex-code last t) 2941 (set-match-data (list (match-beginning 1) (match-end 1) 2942 (match-beginning 2) (match-end 2) 2943 (match-beginning 3) (match-end 3) 2944 (match-beginning 4) (match-end 4))) 2945 (goto-char (min (1+ (match-end 0)) last (point-max))) 2946 t)) 2947 2948 (defun markdown--gfm-markup-underscore-p (begin end) 2949 (let ((is-underscore (eql (char-after begin) ?_))) 2950 (if (not is-underscore) 2951 t 2952 (save-excursion 2953 (save-match-data 2954 (goto-char begin) 2955 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) 2956 (progn 2957 (goto-char end) 2958 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) 2959 2960 (defun markdown-match-bold (last) 2961 "Match inline bold from the point to LAST." 2962 (let (done 2963 retval 2964 last-inline-code) 2965 (while (not done) 2966 (if (markdown-match-inline-generic markdown-regex-bold last) 2967 (let ((is-gfm (derived-mode-p 'gfm-mode)) 2968 (begin (match-beginning 2)) 2969 (end (match-end 2))) 2970 (if (or 2971 (and last-inline-code 2972 (>= begin (car last-inline-code)) 2973 (< begin (cdr last-inline-code))) 2974 (save-match-data 2975 (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) 2976 (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) 2977 (markdown-inline-code-at-pos-p end) 2978 (markdown-in-comment-p) 2979 (markdown-range-property-any 2980 begin begin 'face '(markdown-url-face 2981 markdown-plain-url-face)) 2982 (markdown-range-property-any 2983 begin end 'face '(markdown-hr-face 2984 markdown-math-face)) 2985 (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) 2986 (progn (goto-char (min (1+ begin) last)) 2987 (unless (< (point) last) 2988 (setq 2989 done t))) 2990 (set-match-data (list (match-beginning 2) (match-end 2) 2991 (match-beginning 3) (match-end 3) 2992 (match-beginning 4) (match-end 4) 2993 (match-beginning 5) (match-end 5))) 2994 (setq done t 2995 retval t))) 2996 (setq done t))) 2997 retval)) 2998 2999 (defun markdown-match-italic (last) 3000 "Match inline italics from the point to LAST." 3001 (let* ((is-gfm (derived-mode-p 'gfm-mode)) 3002 (regex (if is-gfm 3003 markdown-regex-gfm-italic 3004 markdown-regex-italic))) 3005 (let (done 3006 retval 3007 last-inline-code) 3008 (while (not done) 3009 (if (and (markdown-match-inline-generic regex last) 3010 (not (markdown--face-p 3011 (match-beginning 1) 3012 '(markdown-html-attr-name-face markdown-html-attr-value-face)))) 3013 (let ((begin (match-beginning 1)) 3014 (end (match-end 1)) 3015 (close-end (match-end 4))) 3016 (if (or (eql (char-before begin) (char-after begin)) 3017 (and last-inline-code 3018 (>= begin (car last-inline-code)) 3019 (< begin (cdr last-inline-code))) 3020 (save-match-data 3021 (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) 3022 (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) 3023 3024 (markdown-inline-code-at-pos-p (1- end)) 3025 (markdown-in-comment-p) 3026 (markdown-range-property-any 3027 begin begin 'face '(markdown-url-face 3028 markdown-plain-url-face 3029 markdown-markup-face)) 3030 (markdown-range-property-any 3031 begin end 'face '(markdown-bold-face 3032 markdown-list-face 3033 markdown-hr-face 3034 markdown-math-face)) 3035 (and is-gfm 3036 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case 3037 (not (markdown--gfm-markup-underscore-p begin close-end))))) 3038 (progn (goto-char (min (1+ begin) last)) 3039 (unless (< (point) last) 3040 (setq 3041 done t))) 3042 (set-match-data (list (match-beginning 1) (match-end 1) 3043 (match-beginning 2) (match-end 2) 3044 (match-beginning 3) (match-end 3) 3045 (match-beginning 4) (match-end 4))) 3046 (setq done t 3047 retval t))) 3048 (setq done t))) 3049 retval))) 3050 3051 (defun markdown--match-highlighting (last) 3052 (when markdown-enable-highlighting-syntax 3053 (re-search-forward markdown-regex-highlighting last t))) 3054 3055 (defun markdown-match-escape (last) 3056 "Match escape characters (backslashes) from point to LAST. 3057 Backlashes only count as escape characters outside of literal 3058 regions (e.g. code blocks). See `markdown-literal-faces'." 3059 (catch 'found 3060 (while (search-forward-regexp markdown-regex-escape last t) 3061 (let* ((face (get-text-property (match-beginning 1) 'face)) 3062 (face-list (if (listp face) face (list face)))) 3063 ;; Ignore any backslashes with a literal face. 3064 (unless (cl-intersection face-list markdown-literal-faces) 3065 (throw 'found t)))))) 3066 3067 (defun markdown-match-math-generic (regex last) 3068 "Match REGEX from point to LAST. 3069 REGEX is either `markdown-regex-math-inline-single' for matching 3070 $..$ or `markdown-regex-math-inline-double' for matching $$..$$." 3071 (when (markdown-match-inline-generic regex last) 3072 (let ((begin (match-beginning 1)) (end (match-end 1))) 3073 (prog1 3074 (if (or (markdown-range-property-any 3075 begin end 'face 3076 '(markdown-inline-code-face markdown-bold-face)) 3077 (markdown-range-properties-exist 3078 begin end 3079 (markdown-get-fenced-block-middle-properties))) 3080 (markdown-match-math-generic regex last) 3081 t) 3082 (goto-char (1+ (match-end 0))))))) 3083 3084 (defun markdown-match-list-items (last) 3085 "Match list items from point to LAST." 3086 (let* ((first (point)) 3087 (pos first) 3088 (prop 'markdown-list-item) 3089 (bounds (car (get-text-property pos prop)))) 3090 (while 3091 (and (or (null (setq bounds (car (get-text-property pos prop)))) 3092 (< (cl-first bounds) pos)) 3093 (< (point) last) 3094 (setq pos (next-single-property-change pos prop nil last)) 3095 (goto-char pos))) 3096 (when bounds 3097 (set-match-data (cl-seventh bounds)) 3098 ;; Step at least one character beyond point. Otherwise 3099 ;; `font-lock-fontify-keywords-region' infloops. 3100 (goto-char (min (1+ (max (line-end-position) first)) 3101 (point-max))) 3102 t))) 3103 3104 (defun markdown-match-math-single (last) 3105 "Match single quoted $..$ math from point to LAST." 3106 (when markdown-enable-math 3107 (when (and (char-equal (char-after) ?$) 3108 (not (bolp)) 3109 (not (char-equal (char-before) ?\\)) 3110 (not (char-equal (char-before) ?$))) 3111 (forward-char -1)) 3112 (markdown-match-math-generic markdown-regex-math-inline-single last))) 3113 3114 (defun markdown-match-math-double (last) 3115 "Match double quoted $$..$$ math from point to LAST." 3116 (when markdown-enable-math 3117 (when (and (< (1+ (point)) (point-max)) 3118 (char-equal (char-after) ?$) 3119 (char-equal (char-after (1+ (point))) ?$) 3120 (not (bolp)) 3121 (not (char-equal (char-before) ?\\)) 3122 (not (char-equal (char-before) ?$))) 3123 (forward-char -1)) 3124 (markdown-match-math-generic markdown-regex-math-inline-double last))) 3125 3126 (defun markdown-match-math-display (last) 3127 "Match bracketed display math \[..\] and \\[..\\] from point to LAST." 3128 (when markdown-enable-math 3129 (markdown-match-math-generic markdown-regex-math-display last))) 3130 3131 (defun markdown-match-propertized-text (property last) 3132 "Match text with PROPERTY from point to LAST. 3133 Restore match data previously stored in PROPERTY." 3134 (let ((saved (get-text-property (point) property)) 3135 pos) 3136 (unless saved 3137 (setq pos (next-single-property-change (point) property nil last)) 3138 (unless (= pos last) 3139 (setq saved (get-text-property pos property)))) 3140 (when saved 3141 (set-match-data saved) 3142 ;; Step at least one character beyond point. Otherwise 3143 ;; `font-lock-fontify-keywords-region' infloops. 3144 (goto-char (min (1+ (max (match-end 0) (point))) 3145 (point-max))) 3146 saved))) 3147 3148 (defun markdown-match-pre-blocks (last) 3149 "Match preformatted blocks from point to LAST. 3150 Use data stored in \\='markdown-pre text property during syntax 3151 analysis." 3152 (markdown-match-propertized-text 'markdown-pre last)) 3153 3154 (defun markdown-match-gfm-code-blocks (last) 3155 "Match GFM quoted code blocks from point to LAST. 3156 Use data stored in \\='markdown-gfm-code text property during syntax 3157 analysis." 3158 (markdown-match-propertized-text 'markdown-gfm-code last)) 3159 3160 (defun markdown-match-gfm-open-code-blocks (last) 3161 (markdown-match-propertized-text 'markdown-gfm-block-begin last)) 3162 3163 (defun markdown-match-gfm-close-code-blocks (last) 3164 (markdown-match-propertized-text 'markdown-gfm-block-end last)) 3165 3166 (defun markdown-match-fenced-code-blocks (last) 3167 "Match fenced code blocks from the point to LAST." 3168 (markdown-match-propertized-text 'markdown-fenced-code last)) 3169 3170 (defun markdown-match-fenced-start-code-block (last) 3171 (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) 3172 3173 (defun markdown-match-fenced-end-code-block (last) 3174 (markdown-match-propertized-text 'markdown-tilde-fence-end last)) 3175 3176 (defun markdown-match-blockquotes (last) 3177 "Match blockquotes from point to LAST. 3178 Use data stored in \\='markdown-blockquote text property during syntax 3179 analysis." 3180 (markdown-match-propertized-text 'markdown-blockquote last)) 3181 3182 (defun markdown-match-hr (last) 3183 "Match horizontal rules comments from the point to LAST." 3184 (markdown-match-propertized-text 'markdown-hr last)) 3185 3186 (defun markdown-match-comments (last) 3187 "Match HTML comments from the point to LAST." 3188 (when (and (skip-syntax-forward "^<" last)) 3189 (let ((beg (point))) 3190 (when (and (skip-syntax-forward "^>" last) (< (point) last)) 3191 (forward-char) 3192 (set-match-data (list beg (point))) 3193 t)))) 3194 3195 (defun markdown-match-generic-links (last ref) 3196 "Match inline links from point to LAST. 3197 When REF is non-nil, match reference links instead of standard 3198 links with URLs. 3199 This function should only be used during font-lock, as it 3200 determines syntax based on the presence of faces for previously 3201 processed elements." 3202 ;; Search for the next potential link (not in a code block). 3203 (let ((prohibited-faces '(markdown-pre-face 3204 markdown-code-face 3205 markdown-inline-code-face 3206 markdown-comment-face)) 3207 found) 3208 (while 3209 (and (not found) (< (point) last) 3210 (progn 3211 ;; Clear match data to test for a match after functions returns. 3212 (set-match-data nil) 3213 ;; Preliminary regular expression search so we can return 3214 ;; quickly upon failure. This doesn't handle malformed links 3215 ;; or nested square brackets well, so if it passes we back up 3216 ;; continue with a more precise search. 3217 (re-search-forward 3218 (if ref 3219 markdown-regex-link-reference 3220 markdown-regex-link-inline) 3221 last 'limit))) 3222 ;; Keep searching if this is in a code block, inline code, or a 3223 ;; comment, or if it is include syntax. The link text portion 3224 ;; (group 3) may contain inline code or comments, but the 3225 ;; markup, URL, and title should not be part of such elements. 3226 (if (or (markdown-range-property-any 3227 (match-beginning 0) (match-end 2) 'face prohibited-faces) 3228 (markdown-range-property-any 3229 (match-beginning 4) (match-end 0) 'face prohibited-faces) 3230 (and (char-equal (char-after (line-beginning-position)) ?<) 3231 (char-equal (char-after (1+ (line-beginning-position))) ?<))) 3232 (set-match-data nil) 3233 (setq found t)))) 3234 ;; Match opening exclamation point (optional) and left bracket. 3235 (when (match-beginning 2) 3236 (let* ((bang (match-beginning 1)) 3237 (first-begin (match-beginning 2)) 3238 ;; Find end of block to prevent matching across blocks. 3239 (end-of-block (save-excursion 3240 (progn 3241 (goto-char (match-beginning 2)) 3242 (markdown-end-of-text-block) 3243 (point)))) 3244 ;; Move over balanced expressions to closing right bracket. 3245 ;; Catch unbalanced expression errors and return nil. 3246 (first-end (condition-case nil 3247 (and (goto-char first-begin) 3248 (scan-sexps (point) 1)) 3249 (error nil))) 3250 ;; Continue with point at CONT-POINT upon failure. 3251 (cont-point (min (1+ first-begin) last)) 3252 second-begin second-end url-begin url-end 3253 title-begin title-end) 3254 ;; When bracket found, in range, and followed by a left paren/bracket... 3255 (when (and first-end (< first-end end-of-block) (goto-char first-end) 3256 (char-equal (char-after (point)) (if ref ?\[ ?\())) 3257 ;; Scan across balanced expressions for closing parenthesis/bracket. 3258 (setq second-begin (point) 3259 second-end (condition-case nil 3260 (scan-sexps (point) 1) 3261 (error nil))) 3262 ;; Check that closing parenthesis/bracket is in range. 3263 (if (and second-end (<= second-end end-of-block) (<= second-end last)) 3264 (progn 3265 ;; Search for (optional) title inside closing parenthesis 3266 (when (and (not ref) (search-forward "\"" second-end t)) 3267 (setq title-begin (1- (point)) 3268 title-end (and (goto-char second-end) 3269 (search-backward "\"" (1+ title-begin) t)) 3270 title-end (and title-end (1+ title-end)))) 3271 ;; Store URL/reference range 3272 (setq url-begin (1+ second-begin) 3273 url-end (1- (or title-begin second-end))) 3274 ;; Set match data, move point beyond link, and return 3275 (set-match-data 3276 (list (or bang first-begin) second-end ; 0 - all 3277 bang (and bang (1+ bang)) ; 1 - bang 3278 first-begin (1+ first-begin) ; 2 - markup 3279 (1+ first-begin) (1- first-end) ; 3 - link text 3280 (1- first-end) first-end ; 4 - markup 3281 second-begin (1+ second-begin) ; 5 - markup 3282 url-begin url-end ; 6 - url/reference 3283 title-begin title-end ; 7 - title 3284 (1- second-end) second-end)) ; 8 - markup 3285 ;; Nullify cont-point and leave point at end and 3286 (setq cont-point nil) 3287 (goto-char second-end)) 3288 ;; If no closing parenthesis in range, update continuation point 3289 (setq cont-point (min end-of-block second-begin)))) 3290 (cond 3291 ;; On failure, continue searching at cont-point 3292 ((and cont-point (< cont-point last)) 3293 (goto-char cont-point) 3294 (markdown-match-generic-links last ref)) 3295 ;; No more text, return nil 3296 ((and cont-point (= cont-point last)) 3297 nil) 3298 ;; Return t if a match occurred 3299 (t t))))) 3300 3301 (defun markdown-match-angle-uris (last) 3302 "Match angle bracket URIs from point to LAST." 3303 (when (markdown-match-inline-generic markdown-regex-angle-uri last) 3304 (goto-char (1+ (match-end 0))))) 3305 3306 (defun markdown-match-plain-uris (last) 3307 "Match plain URIs from point to LAST." 3308 (when (markdown-match-inline-generic markdown-regex-uri last t) 3309 (goto-char (1+ (match-end 0))))) 3310 3311 (defvar markdown-conditional-search-function #'re-search-forward 3312 "Conditional search function used in `markdown-search-until-condition'. 3313 Made into a variable to allow for dynamic let-binding.") 3314 3315 (defun markdown-search-until-condition (condition &rest args) 3316 (let (ret) 3317 (while (and (not ret) (apply markdown-conditional-search-function args)) 3318 (setq ret (funcall condition))) 3319 ret)) 3320 3321 (defun markdown-metadata-line-p (pos regexp) 3322 (save-excursion 3323 (or (= (line-number-at-pos pos) 1) 3324 (progn 3325 (forward-line -1) 3326 ;; skip multi-line metadata 3327 (while (and (looking-at-p "^\\s-+[[:alpha:]]") 3328 (> (line-number-at-pos (point)) 1)) 3329 (forward-line -1)) 3330 (looking-at-p regexp))))) 3331 3332 (defun markdown-match-generic-metadata (regexp last) 3333 "Match metadata declarations specified by REGEXP from point to LAST. 3334 These declarations must appear inside a metadata block that begins at 3335 the beginning of the buffer and ends with a blank line (or the end of 3336 the buffer)." 3337 (let* ((first (point)) 3338 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") 3339 (block-begin (goto-char 1)) 3340 (block-end (re-search-forward end-re nil t))) 3341 (if (and block-end (> first block-end)) 3342 ;; Don't match declarations if there is no metadata block or if 3343 ;; the point is beyond the block. Move point to point-max to 3344 ;; prevent additional searches and return return nil since nothing 3345 ;; was found. 3346 (progn (goto-char (point-max)) nil) 3347 ;; If a block was found that begins before LAST and ends after 3348 ;; point, search for declarations inside it. If the starting is 3349 ;; before the beginning of the block, start there. Otherwise, 3350 ;; move back to FIRST. 3351 (goto-char (if (< first block-begin) block-begin first)) 3352 (if (and (re-search-forward regexp (min last block-end) t) 3353 (markdown-metadata-line-p (point) regexp)) 3354 ;; If a metadata declaration is found, set match-data and return t. 3355 (let ((key-beginning (match-beginning 1)) 3356 (key-end (match-end 1)) 3357 (markup-begin (match-beginning 2)) 3358 (markup-end (match-end 2)) 3359 (value-beginning (match-beginning 3))) 3360 (set-match-data (list key-beginning (point) ; complete metadata 3361 key-beginning key-end ; key 3362 markup-begin markup-end ; markup 3363 value-beginning (point))) ; value 3364 t) 3365 ;; Otherwise, move the point to last and return nil 3366 (goto-char last) 3367 nil)))) 3368 3369 (defun markdown-match-declarative-metadata (last) 3370 "Match declarative metadata from the point to LAST." 3371 (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) 3372 3373 (defun markdown-match-pandoc-metadata (last) 3374 "Match Pandoc metadata from the point to LAST." 3375 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) 3376 3377 (defun markdown-match-yaml-metadata-begin (last) 3378 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) 3379 3380 (defun markdown-match-yaml-metadata-end (last) 3381 (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) 3382 3383 (defun markdown-match-yaml-metadata-key (last) 3384 (markdown-match-propertized-text 'markdown-metadata-key last)) 3385 3386 (defun markdown-match-wiki-link (last) 3387 "Match wiki links from point to LAST." 3388 (when (and markdown-enable-wiki-links 3389 (not markdown-wiki-link-fontify-missing) 3390 (markdown-match-inline-generic markdown-regex-wiki-link last)) 3391 (let ((begin (match-beginning 1)) (end (match-end 1))) 3392 (if (or (markdown-in-comment-p begin) 3393 (markdown-in-comment-p end) 3394 (markdown-inline-code-at-pos-p begin) 3395 (markdown-inline-code-at-pos-p end) 3396 (markdown-code-block-at-pos begin)) 3397 (progn (goto-char (min (1+ begin) last)) 3398 (when (< (point) last) 3399 (markdown-match-wiki-link last))) 3400 (set-match-data (list begin end)) 3401 t)))) 3402 3403 (defun markdown-match-inline-attributes (last) 3404 "Match inline attributes from point to LAST." 3405 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. 3406 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes 3407 ;; against matched string. 3408 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) 3409 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) 3410 (markdown-match-inline-attributes last) 3411 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3412 (markdown-inline-code-at-pos-p (match-end 0)) 3413 (markdown-in-comment-p)) 3414 t)))) 3415 3416 (defun markdown-match-leanpub-sections (last) 3417 "Match Leanpub section markers from point to LAST." 3418 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) 3419 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) 3420 (markdown-inline-code-at-pos-p (match-end 0)) 3421 (markdown-in-comment-p)) 3422 t))) 3423 3424 (defun markdown-match-includes (last) 3425 "Match include statements from point to LAST. 3426 Sets match data for the following seven groups: 3427 Group 1: opening two angle brackets 3428 Group 2: opening title delimiter (optional) 3429 Group 3: title text (optional) 3430 Group 4: closing title delimiter (optional) 3431 Group 5: opening filename delimiter 3432 Group 6: filename 3433 Group 7: closing filename delimiter" 3434 (when (markdown-match-inline-generic markdown-regex-include last) 3435 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) 3436 (markdown-in-comment-p (match-end 0)) 3437 (markdown-code-block-at-pos (match-beginning 0)))))) 3438 (cond 3439 ;; Parentheses and maybe square brackets, but no curly braces: 3440 ;; match optional title in square brackets and file in parentheses. 3441 ((and valid (match-beginning 5) 3442 (not (match-beginning 8))) 3443 (set-match-data (list (match-beginning 1) (match-end 7) 3444 (match-beginning 1) (match-end 1) 3445 (match-beginning 2) (match-end 2) 3446 (match-beginning 3) (match-end 3) 3447 (match-beginning 4) (match-end 4) 3448 (match-beginning 5) (match-end 5) 3449 (match-beginning 6) (match-end 6) 3450 (match-beginning 7) (match-end 7)))) 3451 ;; Only square brackets present: match file in square brackets. 3452 ((and valid (match-beginning 2) 3453 (not (match-beginning 5)) 3454 (not (match-beginning 7))) 3455 (set-match-data (list (match-beginning 1) (match-end 4) 3456 (match-beginning 1) (match-end 1) 3457 nil nil 3458 nil nil 3459 nil nil 3460 (match-beginning 2) (match-end 2) 3461 (match-beginning 3) (match-end 3) 3462 (match-beginning 4) (match-end 4)))) 3463 ;; Only curly braces present: match file in curly braces. 3464 ((and valid (match-beginning 8) 3465 (not (match-beginning 2)) 3466 (not (match-beginning 5))) 3467 (set-match-data (list (match-beginning 1) (match-end 10) 3468 (match-beginning 1) (match-end 1) 3469 nil nil 3470 nil nil 3471 nil nil 3472 (match-beginning 8) (match-end 8) 3473 (match-beginning 9) (match-end 9) 3474 (match-beginning 10) (match-end 10)))) 3475 (t 3476 ;; Not a valid match, move to next line and search again. 3477 (forward-line) 3478 (when (< (point) last) 3479 (setq valid (markdown-match-includes last))))) 3480 valid))) 3481 3482 (defun markdown-match-html-tag (last) 3483 "Match HTML tags from point to LAST." 3484 (when (and markdown-enable-html 3485 (markdown-match-inline-generic markdown-regex-html-tag last t)) 3486 (set-match-data (list (match-beginning 0) (match-end 0) 3487 (match-beginning 1) (match-end 1) 3488 (match-beginning 2) (match-end 2) 3489 (match-beginning 9) (match-end 9))) 3490 t)) 3491 3492 3493 ;;; Markdown Font Fontification Functions ===================================== 3494 3495 (defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) 3496 3497 (defun markdown--first-displayable (seq) 3498 "Return the first displayable character or string in SEQ. 3499 SEQ may be an atom or a sequence." 3500 (let ((c (gethash seq markdown--first-displayable-cache t))) 3501 (if (not (eq c t)) 3502 c 3503 (puthash seq 3504 (let ((seq (if (listp seq) seq (list seq)))) 3505 (cond ((stringp (car seq)) 3506 (cl-find-if 3507 (lambda (str) 3508 (and (mapcar #'char-displayable-p (string-to-list str)))) 3509 seq)) 3510 ((characterp (car seq)) 3511 (cl-find-if #'char-displayable-p seq)))) 3512 markdown--first-displayable-cache)))) 3513 3514 (defun markdown--marginalize-string (level) 3515 "Generate atx markup string of given LEVEL for left margin." 3516 (let ((margin-left-space-count 3517 (- markdown-marginalize-headers-margin-width level))) 3518 (concat (make-string margin-left-space-count ? ) 3519 (make-string level ?#)))) 3520 3521 (defun markdown-marginalize-update-current () 3522 "Update the window configuration to create a left margin." 3523 (if window-system 3524 (let* ((header-delimiter-font-width 3525 (window-font-width nil 'markdown-header-delimiter-face)) 3526 (margin-pixel-width (* markdown-marginalize-headers-margin-width 3527 header-delimiter-font-width)) 3528 (margin-char-width (/ margin-pixel-width (default-font-width)))) 3529 (set-window-margins nil margin-char-width)) 3530 ;; As a fallback, simply set margin based on character count. 3531 (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) 3532 3533 (defun markdown-fontify-headings (last) 3534 "Add text properties to headings from point to LAST." 3535 (when (markdown-match-propertized-text 'markdown-heading last) 3536 (let* ((level (markdown-outline-level)) 3537 (heading-face 3538 (intern (format "markdown-header-face-%d" level))) 3539 (heading-props `(face ,heading-face)) 3540 (left-markup-props 3541 `(face markdown-header-delimiter-face 3542 ,@(cond 3543 (markdown-hide-markup 3544 `(display "")) 3545 (markdown-marginalize-headers 3546 `(display ((margin left-margin) 3547 ,(markdown--marginalize-string level))))))) 3548 (right-markup-props 3549 `(face markdown-header-delimiter-face 3550 ,@(when markdown-hide-markup `(display "")))) 3551 (rule-props `(face markdown-header-rule-face 3552 ,@(when markdown-hide-markup `(display ""))))) 3553 (if (match-end 1) 3554 ;; Setext heading 3555 (progn (add-text-properties 3556 (match-beginning 1) (match-end 1) heading-props) 3557 (if (= level 1) 3558 (add-text-properties 3559 (match-beginning 2) (match-end 2) rule-props) 3560 (add-text-properties 3561 (match-beginning 3) (match-end 3) rule-props))) 3562 ;; atx heading 3563 (let ((fontified-start 3564 (if (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) 3565 (match-beginning 5) 3566 (match-beginning 0))) 3567 (fontified-end 3568 (if markdown-fontify-whole-heading-line 3569 (min (point-max) (1+ (match-end 0))) 3570 (match-end 5)))) 3571 (add-text-properties 3572 (match-beginning 4) (match-end 4) left-markup-props) 3573 3574 ;; If closing tag is present 3575 (if (match-end 6) 3576 (progn 3577 (add-text-properties fontified-start fontified-end heading-props) 3578 (when (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) 3579 (add-text-properties (match-beginning 6) (match-end 6) right-markup-props))) 3580 ;; If closing tag is not present 3581 (add-text-properties fontified-start fontified-end heading-props))))) 3582 t)) 3583 3584 (defun markdown-fontify-tables (last) 3585 (when (re-search-forward "|" last t) 3586 (when (markdown-table-at-point-p) 3587 (font-lock-append-text-property 3588 (line-beginning-position) (min (1+ (line-end-position)) (point-max)) 3589 'face 'markdown-table-face)) 3590 (forward-line 1) 3591 t)) 3592 3593 (defun markdown-fontify-blockquotes (last) 3594 "Apply font-lock properties to blockquotes from point to LAST." 3595 (when (markdown-match-blockquotes last) 3596 (let ((display-string 3597 (markdown--first-displayable markdown-blockquote-display-char))) 3598 (add-text-properties 3599 (match-beginning 1) (match-end 1) 3600 (if markdown-hide-markup 3601 `(face markdown-blockquote-face display ,display-string) 3602 `(face markdown-markup-face))) 3603 (font-lock-append-text-property 3604 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) 3605 t))) 3606 3607 (defun markdown-fontify-list-items (last) 3608 "Apply font-lock properties to list markers from point to LAST." 3609 (when (markdown-match-list-items last) 3610 (when (not (markdown-code-block-at-point-p (match-beginning 2))) 3611 (let* ((indent (length (match-string-no-properties 1))) 3612 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... 3613 (bullet (nth (mod level (length markdown-list-item-bullets)) 3614 markdown-list-item-bullets))) 3615 (add-text-properties 3616 (match-beginning 2) (match-end 2) '(face markdown-list-face)) 3617 (when markdown-hide-markup 3618 (cond 3619 ;; Unordered lists 3620 ((string-match-p "[\\*\\+-]" (match-string 2)) 3621 (add-text-properties 3622 (match-beginning 2) (match-end 2) `(display ,bullet))) 3623 ;; Definition lists 3624 ((string-equal ":" (match-string 2)) 3625 (let ((display-string 3626 (char-to-string (markdown--first-displayable 3627 markdown-definition-display-char)))) 3628 (add-text-properties (match-beginning 2) (match-end 2) 3629 `(display ,display-string)))))))) 3630 t)) 3631 3632 (defun markdown--fontify-hrs-view-mode (hr-char) 3633 (if (and hr-char (display-supports-face-attributes-p '(:extend t))) 3634 (add-text-properties 3635 (match-beginning 0) (match-end 0) 3636 `(face 3637 (:inherit markdown-hr-face :underline t :extend t) 3638 font-lock-multiline t 3639 display "\n")) 3640 (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) 3641 (add-text-properties 3642 (match-beginning 0) (match-end 0) 3643 `(face 3644 markdown-hr-face font-lock-multiline t 3645 display ,(make-string hr-len hr-char)))))) 3646 3647 (defun markdown-fontify-hrs (last) 3648 "Add text properties to horizontal rules from point to LAST." 3649 (when (markdown-match-hr last) 3650 (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) 3651 (if (and markdown-hide-markup hr-char) 3652 (markdown--fontify-hrs-view-mode hr-char) 3653 (add-text-properties 3654 (match-beginning 0) (match-end 0) 3655 `(face markdown-hr-face font-lock-multiline t))) 3656 t))) 3657 3658 (defun markdown-fontify-sub-superscripts (last) 3659 "Apply text properties to sub- and superscripts from point to LAST." 3660 (when (markdown-search-until-condition 3661 (lambda () (and (not (markdown-code-block-at-point-p)) 3662 (not (markdown-inline-code-at-point-p)) 3663 (not (markdown-in-comment-p)) 3664 (not (markdown--math-block-p)))) 3665 markdown-regex-sub-superscript last t) 3666 (let* ((subscript-p (string= (match-string 2) "~")) 3667 (props 3668 (if subscript-p 3669 (car markdown-sub-superscript-display) 3670 (cdr markdown-sub-superscript-display))) 3671 (mp (list 'face 'markdown-markup-face 3672 'invisible 'markdown-markup))) 3673 (when markdown-hide-markup 3674 (put-text-property (match-beginning 3) (match-end 3) 3675 'display props)) 3676 (add-text-properties (match-beginning 2) (match-end 2) mp) 3677 (add-text-properties (match-beginning 4) (match-end 4) mp) 3678 t))) 3679 3680 3681 ;;; Syntax Table ============================================================== 3682 3683 (defvar markdown-mode-syntax-table 3684 (let ((tab (make-syntax-table text-mode-syntax-table))) 3685 (modify-syntax-entry ?\" "." tab) 3686 tab) 3687 "Syntax table for `markdown-mode'.") 3688 3689 3690 ;;; Element Insertion ========================================================= 3691 3692 (defun markdown-ensure-blank-line-before () 3693 "If previous line is not already blank, insert a blank line before point." 3694 (unless (bolp) (insert "\n")) 3695 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) 3696 3697 (defun markdown-ensure-blank-line-after () 3698 "If following line is not already blank, insert a blank line after point. 3699 Return the point where it was originally." 3700 (save-excursion 3701 (unless (eolp) (insert "\n")) 3702 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) 3703 3704 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) 3705 "Insert the strings S1 and S2, wrapping around region or THING. 3706 If a region is specified by the optional BEG and END arguments, 3707 wrap the strings S1 and S2 around that region. 3708 If there is an active region, wrap the strings S1 and S2 around 3709 the region. If there is not an active region but the point is at 3710 THING, wrap that thing (which defaults to word). Otherwise, just 3711 insert S1 and S2 and place the point in between. Return the 3712 bounds of the entire wrapped string, or nil if nothing was wrapped 3713 and S1 and S2 were only inserted." 3714 (let (a b bounds new-point) 3715 (cond 3716 ;; Given region 3717 ((and beg end) 3718 (setq a beg 3719 b end 3720 new-point (+ (point) (length s1)))) 3721 ;; Active region 3722 ((use-region-p) 3723 (setq a (region-beginning) 3724 b (region-end) 3725 new-point (+ (point) (length s1)))) 3726 ;; Thing (word) at point 3727 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) 3728 (setq a (car bounds) 3729 b (cdr bounds) 3730 new-point (+ (point) (length s1)))) 3731 ;; No active region and no word 3732 (t 3733 (setq a (point) 3734 b (point)))) 3735 (goto-char b) 3736 (insert s2) 3737 (goto-char a) 3738 (insert s1) 3739 (when new-point (goto-char new-point)) 3740 (if (= a b) 3741 nil 3742 (setq b (+ b (length s1) (length s2))) 3743 (cons a b)))) 3744 3745 (defun markdown-point-after-unwrap (cur prefix suffix) 3746 "Return desired position of point after an unwrapping operation. 3747 CUR gives the position of the point before the operation. 3748 Additionally, two cons cells must be provided. PREFIX gives the 3749 bounds of the prefix string and SUFFIX gives the bounds of the 3750 suffix string." 3751 (cond ((< cur (cdr prefix)) (car prefix)) 3752 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) 3753 ((<= cur (cdr suffix)) 3754 (- cur (+ (- (cdr prefix) (car prefix)) 3755 (- cur (car suffix))))) 3756 (t cur))) 3757 3758 (defun markdown-unwrap-thing-at-point (regexp all text) 3759 "Remove prefix and suffix of thing at point and reposition the point. 3760 When the thing at point matches REGEXP, replace the subexpression 3761 ALL with the string in subexpression TEXT. Reposition the point 3762 in an appropriate location accounting for the removal of prefix 3763 and suffix strings. Return new bounds of string from group TEXT. 3764 When REGEXP is nil, assumes match data is already set." 3765 (when (or (null regexp) 3766 (thing-at-point-looking-at regexp)) 3767 (let ((cur (point)) 3768 (prefix (cons (match-beginning all) (match-beginning text))) 3769 (suffix (cons (match-end text) (match-end all))) 3770 (bounds (cons (match-beginning text) (match-end text)))) 3771 ;; Replace the thing at point 3772 (replace-match (match-string text) t t nil all) 3773 ;; Reposition the point 3774 (goto-char (markdown-point-after-unwrap cur prefix suffix)) 3775 ;; Adjust bounds 3776 (setq bounds (cons (car prefix) 3777 (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) 3778 3779 (defun markdown-unwrap-things-in-region (beg end regexp all text) 3780 "Remove prefix and suffix of all things in region from BEG to END. 3781 When a thing in the region matches REGEXP, replace the 3782 subexpression ALL with the string in subexpression TEXT. 3783 Return a cons cell containing updated bounds for the region." 3784 (save-excursion 3785 (goto-char beg) 3786 (let ((removed 0) len-all len-text) 3787 (while (re-search-forward regexp (- end removed) t) 3788 (setq len-all (length (match-string-no-properties all))) 3789 (setq len-text (length (match-string-no-properties text))) 3790 (setq removed (+ removed (- len-all len-text))) 3791 (replace-match (match-string text) t t nil all)) 3792 (cons beg (- end removed))))) 3793 3794 (defun markdown-insert-hr (arg) 3795 "Insert or replace a horizontal rule. 3796 By default, use the first element of `markdown-hr-strings'. When 3797 ARG is non-nil, as when given a prefix, select a different 3798 element as follows. When prefixed with \\[universal-argument], 3799 use the last element of `markdown-hr-strings' instead. When 3800 prefixed with an integer from 1 to the length of 3801 `markdown-hr-strings', use the element in that position instead." 3802 (interactive "*P") 3803 (when (thing-at-point-looking-at markdown-regex-hr) 3804 (delete-region (match-beginning 0) (match-end 0))) 3805 (markdown-ensure-blank-line-before) 3806 (cond ((equal arg '(4)) 3807 (insert (car (reverse markdown-hr-strings)))) 3808 ((and (integerp arg) (> arg 0) 3809 (<= arg (length markdown-hr-strings))) 3810 (insert (nth (1- arg) markdown-hr-strings))) 3811 (t 3812 (insert (car markdown-hr-strings)))) 3813 (markdown-ensure-blank-line-after)) 3814 3815 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face 3816 &optional skip-space) 3817 (if (use-region-p) 3818 ;; Active region 3819 (let* ((bounds (markdown-unwrap-things-in-region 3820 (region-beginning) (region-end) 3821 regex start-group end-group)) 3822 (beg (car bounds)) 3823 (end (cdr bounds))) 3824 (when (and beg skip-space) 3825 (save-excursion 3826 (goto-char beg) 3827 (skip-chars-forward " \t") 3828 (setq beg (point)))) 3829 (when (and end skip-space) 3830 (save-excursion 3831 (goto-char end) 3832 (skip-chars-backward " \t") 3833 (setq end (point)))) 3834 (markdown-wrap-or-insert start-delim end-delim nil beg end)) 3835 (if (markdown--face-p (point) (list face)) 3836 (save-excursion 3837 (while (and (markdown--face-p (point) (list face)) (not (bobp))) 3838 (forward-char -1)) 3839 (forward-char (- (1- (length start-delim)))) ;; for delimiter 3840 (unless (bolp) 3841 (forward-char -1)) 3842 (when (looking-at regex) 3843 (markdown-unwrap-thing-at-point nil start-group end-group))) 3844 (if (thing-at-point-looking-at regex) 3845 (markdown-unwrap-thing-at-point nil start-group end-group) 3846 (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) 3847 3848 (defun markdown-insert-bold () 3849 "Insert markup to make a region or word bold. 3850 If there is an active region, make the region bold. If the point 3851 is at a non-bold word, make the word bold. If the point is at a 3852 bold word or phrase, remove the bold markup. Otherwise, simply 3853 insert bold delimiters and place the point in between them." 3854 (interactive) 3855 (let ((delim (if markdown-bold-underscore "__" "**"))) 3856 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) 3857 3858 (defun markdown-insert-italic () 3859 "Insert markup to make a region or word italic. 3860 If there is an active region, make the region italic. If the point 3861 is at a non-italic word, make the word italic. If the point is at an 3862 italic word or phrase, remove the italic markup. Otherwise, simply 3863 insert italic delimiters and place the point in between them." 3864 (interactive) 3865 (let ((delim (if markdown-italic-underscore "_" "*"))) 3866 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) 3867 3868 (defun markdown-insert-strike-through () 3869 "Insert markup to make a region or word strikethrough. 3870 If there is an active region, make the region strikethrough. If the point 3871 is at a non-bold word, make the word strikethrough. If the point is at a 3872 strikethrough word or phrase, remove the strikethrough markup. Otherwise, 3873 simply insert bold delimiters and place the point in between them." 3874 (interactive) 3875 (markdown--insert-common 3876 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) 3877 3878 (defun markdown-insert-code () 3879 "Insert markup to make a region or word an inline code fragment. 3880 If there is an active region, make the region an inline code 3881 fragment. If the point is at a word, make the word an inline 3882 code fragment. Otherwise, simply insert code delimiters and 3883 place the point in between them." 3884 (interactive) 3885 (if (use-region-p) 3886 ;; Active region 3887 (let ((bounds (markdown-unwrap-things-in-region 3888 (region-beginning) (region-end) 3889 markdown-regex-code 1 3))) 3890 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) 3891 ;; Code markup removal, code markup for word, or empty markup insertion 3892 (if (markdown-inline-code-at-point) 3893 (markdown-unwrap-thing-at-point nil 0 2) 3894 (markdown-wrap-or-insert "`" "`" 'word nil nil)))) 3895 3896 (defun markdown-insert-kbd () 3897 "Insert markup to wrap region or word in <kbd> tags. 3898 If there is an active region, use the region. If the point is at 3899 a word, use the word. Otherwise, simply insert <kbd> tags and 3900 place the point in between them." 3901 (interactive) 3902 (if (use-region-p) 3903 ;; Active region 3904 (let ((bounds (markdown-unwrap-things-in-region 3905 (region-beginning) (region-end) 3906 markdown-regex-kbd 0 2))) 3907 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) 3908 ;; Markup removal, markup for word, or empty markup insertion 3909 (if (thing-at-point-looking-at markdown-regex-kbd) 3910 (markdown-unwrap-thing-at-point nil 0 2) 3911 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) 3912 3913 (defun markdown-insert-inline-link (text url &optional title) 3914 "Insert an inline link with TEXT pointing to URL. 3915 Optionally, the user can provide a TITLE." 3916 (let ((cur (point))) 3917 (setq title (and title (concat " \"" title "\""))) 3918 (insert (concat "[" text "](" url title ")")) 3919 (cond ((not text) (goto-char (+ 1 cur))) 3920 ((not url) (goto-char (+ 3 (length text) cur)))))) 3921 3922 (defun markdown-insert-inline-image (text url &optional title) 3923 "Insert an inline link with alt TEXT pointing to URL. 3924 Optionally, also provide a TITLE." 3925 (let ((cur (point))) 3926 (setq title (and title (concat " \"" title "\""))) 3927 (insert (concat "![" text "](" url title ")")) 3928 (cond ((not text) (goto-char (+ 2 cur))) 3929 ((not url) (goto-char (+ 4 (length text) cur)))))) 3930 3931 (defun markdown-insert-reference-link (text label &optional url title) 3932 "Insert a reference link and, optionally, a reference definition. 3933 The link TEXT will be inserted followed by the optional LABEL. 3934 If a URL is given, also insert a definition for the reference 3935 LABEL according to `markdown-reference-location'. If a TITLE is 3936 given, it will be added to the end of the reference definition 3937 and will be used to populate the title attribute when converted 3938 to XHTML. If URL is nil, insert only the link portion (for 3939 example, when a reference label is already defined)." 3940 (insert (concat "[" text "][" label "]")) 3941 (when url 3942 (markdown-insert-reference-definition 3943 (if (string-equal label "") text label) 3944 url title))) 3945 3946 (defun markdown-insert-reference-image (text label &optional url title) 3947 "Insert a reference image and, optionally, a reference definition. 3948 The alt TEXT will be inserted followed by the optional LABEL. 3949 If a URL is given, also insert a definition for the reference 3950 LABEL according to `markdown-reference-location'. If a TITLE is 3951 given, it will be added to the end of the reference definition 3952 and will be used to populate the title attribute when converted 3953 to XHTML. If URL is nil, insert only the link portion (for 3954 example, when a reference label is already defined)." 3955 (insert (concat "![" text "][" label "]")) 3956 (when url 3957 (markdown-insert-reference-definition 3958 (if (string-equal label "") text label) 3959 url title))) 3960 3961 (defun markdown-insert-reference-definition (label &optional url title) 3962 "Add definition for reference LABEL with URL and TITLE. 3963 LABEL is a Markdown reference label without square brackets. 3964 URL and TITLE are optional. When given, the TITLE will 3965 be used to populate the title attribute when converted to XHTML." 3966 ;; END specifies where to leave the point upon return 3967 (let ((end (point))) 3968 (cl-case markdown-reference-location 3969 (end (goto-char (point-max))) 3970 (immediately (markdown-end-of-text-block)) 3971 (subtree (markdown-end-of-subtree)) 3972 (header (markdown-end-of-defun))) 3973 ;; Skip backwards over local variables. This logic is similar to the one 3974 ;; used in ‘hack-local-variables’. 3975 (when (and enable-local-variables (eobp)) 3976 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) 3977 (when (let ((case-fold-search t)) 3978 (search-forward "Local Variables:" nil :move)) 3979 (beginning-of-line 0) 3980 (when (eq (char-before) ?\n) (backward-char)))) 3981 (unless (or (markdown-cur-line-blank-p) 3982 (thing-at-point-looking-at markdown-regex-reference-definition)) 3983 (insert "\n")) 3984 (insert "\n[" label "]: ") 3985 (if url 3986 (insert url) 3987 ;; When no URL is given, leave point at END following the colon 3988 (setq end (point))) 3989 (when (> (length title) 0) 3990 (insert " \"" title "\"")) 3991 (unless (looking-at-p "\n") 3992 (insert "\n")) 3993 (goto-char end) 3994 (when url 3995 (message 3996 (markdown--substitute-command-keys 3997 "Reference [%s] was defined, press \\[markdown-do] to jump there") 3998 label)))) 3999 4000 (defcustom markdown-link-make-text-function nil 4001 "Function that automatically generates a link text for a URL. 4002 4003 If non-nil, this function will be called by 4004 `markdown--insert-link-or-image' and the result will be the 4005 default link text. The function should receive exactly one 4006 argument that corresponds to the link URL." 4007 :group 'markdown 4008 :type 'function 4009 :package-version '(markdown-mode . "2.5")) 4010 4011 (defcustom markdown-disable-tooltip-prompt nil 4012 "Disable prompt for tooltip when inserting a link or image. 4013 4014 If non-nil, `markdown-insert-link' and `markdown-insert-link' 4015 will not prompt the user to insert a tooltip text for the given 4016 link or image." 4017 :group 'markdown 4018 :type 'boolean 4019 :safe 'booleanp 4020 :package-version '(markdown-mode . "2.5")) 4021 4022 (defun markdown--insert-link-or-image (image) 4023 "Interactively insert new or update an existing link or image. 4024 When IMAGE is non-nil, insert an image. Otherwise, insert a link. 4025 This is an internal function called by 4026 `markdown-insert-link' and `markdown-insert-image'." 4027 (cl-multiple-value-bind (begin end text uri ref title) 4028 (if (use-region-p) 4029 ;; Use region as either link text or URL as appropriate. 4030 (let ((region (buffer-substring-no-properties 4031 (region-beginning) (region-end)))) 4032 (if (string-match markdown-regex-uri region) 4033 ;; Region contains a URL; use it as such. 4034 (list (region-beginning) (region-end) 4035 nil (match-string 0 region) nil nil) 4036 ;; Region doesn't contain a URL, so use it as text. 4037 (list (region-beginning) (region-end) 4038 region nil nil nil))) 4039 ;; Extract and use properties of existing link, if any. 4040 (markdown-link-at-pos (point))) 4041 (let* ((ref (when ref (concat "[" ref "]"))) 4042 (defined-refs (mapcar #'car (markdown-get-defined-references))) 4043 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) 4044 (used-uris (markdown-get-used-uris)) 4045 (uri-or-ref (completing-read 4046 "URL or [reference]: " 4047 (append defined-ref-cands used-uris) 4048 nil nil (or uri ref))) 4049 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) 4050 (match-string 1 uri-or-ref)) 4051 ((string-equal "" uri-or-ref) 4052 ""))) 4053 (uri (unless ref uri-or-ref)) 4054 (text-prompt (if image 4055 "Alt text: " 4056 (if ref 4057 "Link text: " 4058 "Link text (blank for plain URL): "))) 4059 (text (or text (and markdown-link-make-text-function uri 4060 (funcall markdown-link-make-text-function uri)))) 4061 (text (completing-read text-prompt defined-refs nil nil text)) 4062 (text (if (= (length text) 0) nil text)) 4063 (plainp (and uri (not text))) 4064 (implicitp (string-equal ref "")) 4065 (ref (if implicitp text ref)) 4066 (definedp (and ref (markdown-reference-definition ref))) 4067 (ref-url (unless (or uri definedp) 4068 (completing-read "Reference URL: " used-uris))) 4069 (title (unless (or plainp definedp markdown-disable-tooltip-prompt) 4070 (read-string "Title (tooltip text, optional): " title))) 4071 (title (if (= (length title) 0) nil title))) 4072 (when (and image implicitp) 4073 (user-error "Reference required: implicit image references are invalid")) 4074 (when (and begin end) 4075 (delete-region begin end)) 4076 (cond 4077 ((and (not image) uri text) 4078 (markdown-insert-inline-link text uri title)) 4079 ((and image uri text) 4080 (markdown-insert-inline-image text uri title)) 4081 ((and ref text) 4082 (if image 4083 (markdown-insert-reference-image text (unless implicitp ref) nil title) 4084 (markdown-insert-reference-link text (unless implicitp ref) nil title)) 4085 (unless definedp 4086 (markdown-insert-reference-definition ref ref-url title))) 4087 ((and (not image) uri) 4088 (markdown-insert-uri uri)))))) 4089 4090 (defun markdown-insert-link () 4091 "Insert new or update an existing link, with interactive prompt. 4092 If the point is at an existing link or URL, update the link text, 4093 URL, reference label, and/or title. Otherwise, insert a new link. 4094 The type of link inserted (inline, reference, or plain URL) 4095 depends on which values are provided: 4096 4097 * If a URL and TEXT are given, insert an inline link: [TEXT](URL). 4098 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. 4099 * If only TEXT is given, insert an implicit reference link: [TEXT][]. 4100 * If only a URL is given, insert a plain link: <URL>. 4101 4102 In other words, to create an implicit reference link, leave the 4103 URL prompt empty and to create a plain URL link, leave the link 4104 text empty. 4105 4106 If there is an active region, use the text as the default URL, if 4107 it seems to be a URL, or link text value otherwise. 4108 4109 If a given reference is not defined, this function will 4110 additionally prompt for the URL and optional title. In this case, 4111 the reference definition is placed at the location determined by 4112 `markdown-reference-location'. In addition, it is possible to 4113 have the `markdown-link-make-text-function' function, if non-nil, 4114 define the default link text before prompting the user for it. 4115 4116 If `markdown-disable-tooltip-prompt' is non-nil, the user will 4117 not be prompted to add or modify a tooltip text. 4118 4119 Through updating the link, this function can be used to convert a 4120 link of one type (inline, reference, or plain) to another type by 4121 selectively adding or removing information via the prompts." 4122 (interactive) 4123 (markdown--insert-link-or-image nil)) 4124 4125 (defun markdown-insert-image () 4126 "Insert new or update an existing image, with interactive prompt. 4127 If the point is at an existing image, update the alt text, URL, 4128 reference label, and/or title. Otherwise, insert a new image. 4129 The type of image inserted (inline or reference) depends on which 4130 values are provided: 4131 4132 * If a URL and ALT-TEXT are given, insert an inline image: 4133 ![ALT-TEXT](URL). 4134 * If [REF] and ALT-TEXT are given, insert a reference image: 4135 ![ALT-TEXT][REF]. 4136 4137 If there is an active region, use the text as the default URL, if 4138 it seems to be a URL, or alt text value otherwise. 4139 4140 If a given reference is not defined, this function will 4141 additionally prompt for the URL and optional title. In this case, 4142 the reference definition is placed at the location determined by 4143 `markdown-reference-location'. 4144 4145 Through updating the image, this function can be used to convert an 4146 image of one type (inline or reference) to another type by 4147 selectively adding or removing information via the prompts." 4148 (interactive) 4149 (markdown--insert-link-or-image t)) 4150 4151 (defun markdown-insert-uri (&optional uri) 4152 "Insert markup for an inline URI. 4153 If there is an active region, use it as the URI. If the point is 4154 at a URI, wrap it with angle brackets. If the point is at an 4155 inline URI, remove the angle brackets. Otherwise, simply insert 4156 angle brackets place the point between them." 4157 (interactive) 4158 (if (use-region-p) 4159 ;; Active region 4160 (let ((bounds (markdown-unwrap-things-in-region 4161 (region-beginning) (region-end) 4162 markdown-regex-angle-uri 0 2))) 4163 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) 4164 ;; Markup removal, URI at point, new URI, or empty markup insertion 4165 (if (thing-at-point-looking-at markdown-regex-angle-uri) 4166 (markdown-unwrap-thing-at-point nil 0 2) 4167 (if uri 4168 (insert "<" uri ">") 4169 (markdown-wrap-or-insert "<" ">" 'url nil nil))))) 4170 4171 (defun markdown-insert-wiki-link () 4172 "Insert a wiki link of the form [[WikiLink]]. 4173 If there is an active region, use the region as the link text. 4174 If the point is at a word, use the word as the link text. If 4175 there is no active region and the point is not at word, simply 4176 insert link markup." 4177 (interactive) 4178 (if (use-region-p) 4179 ;; Active region 4180 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) 4181 ;; Markup removal, wiki link at at point, or empty markup insertion 4182 (if (thing-at-point-looking-at markdown-regex-wiki-link) 4183 (if (or markdown-wiki-link-alias-first 4184 (null (match-string 5))) 4185 (markdown-unwrap-thing-at-point nil 1 3) 4186 (markdown-unwrap-thing-at-point nil 1 5)) 4187 (markdown-wrap-or-insert "[[" "]]")))) 4188 4189 (defun markdown-remove-header () 4190 "Remove header markup if point is at a header. 4191 Return bounds of remaining header text if a header was removed 4192 and nil otherwise." 4193 (interactive "*") 4194 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) 4195 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) 4196 4197 (defun markdown-insert-header (&optional level text setext) 4198 "Insert or replace header markup. 4199 The level of the header is specified by LEVEL and header text is 4200 given by TEXT. LEVEL must be an integer from 1 and 6, and the 4201 default value is 1. 4202 When TEXT is nil, the header text is obtained as follows. 4203 If there is an active region, it is used as the header text. 4204 Otherwise, the current line will be used as the header text. 4205 If there is not an active region and the point is at a header, 4206 remove the header markup and replace with level N header. 4207 Otherwise, insert empty header markup and place the point in 4208 between. 4209 The style of the header will be atx (hash marks) unless 4210 SETEXT is non-nil, in which case a setext-style (underlined) 4211 header will be inserted." 4212 (interactive "p\nsHeader text: ") 4213 (setq level (min (max (or level 1) 1) (if setext 2 6))) 4214 ;; Determine header text if not given 4215 (when (null text) 4216 (if (use-region-p) 4217 ;; Active region 4218 (setq text (delete-and-extract-region (region-beginning) (region-end))) 4219 ;; No active region 4220 (markdown-remove-header) 4221 (setq text (delete-and-extract-region 4222 (line-beginning-position) (line-end-position))) 4223 (when (and setext (string-match-p "^[ \t]*$" text)) 4224 (setq text (read-string "Header text: ")))) 4225 (setq text (markdown-compress-whitespace-string text))) 4226 ;; Insertion with given text 4227 (markdown-ensure-blank-line-before) 4228 (let (hdr) 4229 (cond (setext 4230 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) 4231 (insert text "\n" hdr)) 4232 (t 4233 (setq hdr (make-string level ?#)) 4234 (insert hdr " " text) 4235 (when (null markdown-asymmetric-header) (insert " " hdr))))) 4236 (markdown-ensure-blank-line-after) 4237 ;; Leave point at end of text 4238 (cond (setext 4239 (backward-char (1+ (string-width text)))) 4240 ((null markdown-asymmetric-header) 4241 (backward-char (1+ level))))) 4242 4243 (defun markdown-insert-header-dwim (&optional arg setext) 4244 "Insert or replace header markup. 4245 The level and type of the header are determined automatically by 4246 the type and level of the previous header, unless a prefix 4247 argument is given via ARG. 4248 With a numeric prefix valued 1 to 6, insert a header of the given 4249 level, with the type being determined automatically (note that 4250 only level 1 or 2 setext headers are possible). 4251 4252 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 4253 promote the heading by one level. 4254 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 4255 demote the heading by one level. 4256 When SETEXT is non-nil, prefer setext-style headers when 4257 possible (levels one and two). 4258 4259 When there is an active region, use it for the header text. When 4260 the point is at an existing header, change the type and level 4261 according to the rules above. 4262 Otherwise, if the line is not empty, create a header using the 4263 text on the current line as the header text. 4264 Finally, if the point is on a blank line, insert empty header 4265 markup (atx) or prompt for text (setext). 4266 See `markdown-insert-header' for more details about how the 4267 header text is determined." 4268 (interactive "*P") 4269 (let (level) 4270 (save-excursion 4271 (when (or (thing-at-point-looking-at markdown-regex-header) 4272 (re-search-backward markdown-regex-header nil t)) 4273 ;; level of current or previous header 4274 (setq level (markdown-outline-level)) 4275 ;; match group 1 indicates a setext header 4276 (setq setext (match-end 1)))) 4277 ;; check prefix argument 4278 (cond 4279 ((and (equal arg '(4)) level (> level 1)) ;; C-u 4280 (cl-decf level)) 4281 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u 4282 (cl-incf level)) 4283 (arg ;; numeric prefix 4284 (setq level (prefix-numeric-value arg)))) 4285 ;; setext headers must be level one or two 4286 (and level (setq setext (and setext (<= level 2)))) 4287 ;; insert the heading 4288 (markdown-insert-header level nil setext))) 4289 4290 (defun markdown-insert-header-setext-dwim (&optional arg) 4291 "Insert or replace header markup, with preference for setext. 4292 See `markdown-insert-header-dwim' for details, including how ARG is handled." 4293 (interactive "*P") 4294 (markdown-insert-header-dwim arg t)) 4295 4296 (defun markdown-insert-header-atx-1 () 4297 "Insert a first level atx-style (hash mark) header. 4298 See `markdown-insert-header'." 4299 (interactive "*") 4300 (markdown-insert-header 1 nil nil)) 4301 4302 (defun markdown-insert-header-atx-2 () 4303 "Insert a level two atx-style (hash mark) header. 4304 See `markdown-insert-header'." 4305 (interactive "*") 4306 (markdown-insert-header 2 nil nil)) 4307 4308 (defun markdown-insert-header-atx-3 () 4309 "Insert a level three atx-style (hash mark) header. 4310 See `markdown-insert-header'." 4311 (interactive "*") 4312 (markdown-insert-header 3 nil nil)) 4313 4314 (defun markdown-insert-header-atx-4 () 4315 "Insert a level four atx-style (hash mark) header. 4316 See `markdown-insert-header'." 4317 (interactive "*") 4318 (markdown-insert-header 4 nil nil)) 4319 4320 (defun markdown-insert-header-atx-5 () 4321 "Insert a level five atx-style (hash mark) header. 4322 See `markdown-insert-header'." 4323 (interactive "*") 4324 (markdown-insert-header 5 nil nil)) 4325 4326 (defun markdown-insert-header-atx-6 () 4327 "Insert a sixth level atx-style (hash mark) header. 4328 See `markdown-insert-header'." 4329 (interactive "*") 4330 (markdown-insert-header 6 nil nil)) 4331 4332 (defun markdown-insert-header-setext-1 () 4333 "Insert a setext-style (underlined) first-level header. 4334 See `markdown-insert-header'." 4335 (interactive "*") 4336 (markdown-insert-header 1 nil t)) 4337 4338 (defun markdown-insert-header-setext-2 () 4339 "Insert a setext-style (underlined) second-level header. 4340 See `markdown-insert-header'." 4341 (interactive "*") 4342 (markdown-insert-header 2 nil t)) 4343 4344 (defun markdown-blockquote-indentation (loc) 4345 "Return string containing necessary indentation for a blockquote at LOC. 4346 Also see `markdown-pre-indentation'." 4347 (save-excursion 4348 (goto-char loc) 4349 (let* ((list-level (length (markdown-calculate-list-levels))) 4350 (indent "")) 4351 (dotimes (_ list-level indent) 4352 (setq indent (concat indent " ")))))) 4353 4354 (defun markdown-insert-blockquote () 4355 "Start a blockquote section (or blockquote the region). 4356 If Transient Mark mode is on and a region is active, it is used as 4357 the blockquote text." 4358 (interactive) 4359 (if (use-region-p) 4360 (markdown-blockquote-region (region-beginning) (region-end)) 4361 (markdown-ensure-blank-line-before) 4362 (insert (markdown-blockquote-indentation (point)) "> ") 4363 (markdown-ensure-blank-line-after))) 4364 4365 (defun markdown-block-region (beg end prefix) 4366 "Format the region using a block prefix. 4367 Arguments BEG and END specify the beginning and end of the 4368 region. The characters PREFIX will appear at the beginning 4369 of each line." 4370 (save-excursion 4371 (let* ((end-marker (make-marker)) 4372 (beg-marker (make-marker)) 4373 (prefix-without-trailing-whitespace 4374 (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) 4375 ;; Ensure blank line after and remove extra whitespace 4376 (goto-char end) 4377 (skip-syntax-backward "-") 4378 (set-marker end-marker (point)) 4379 (delete-horizontal-space) 4380 (markdown-ensure-blank-line-after) 4381 ;; Ensure blank line before and remove extra whitespace 4382 (goto-char beg) 4383 (skip-syntax-forward "-") 4384 (delete-horizontal-space) 4385 (markdown-ensure-blank-line-before) 4386 (set-marker beg-marker (point)) 4387 ;; Insert PREFIX before each line 4388 (goto-char beg-marker) 4389 (while (and (< (line-beginning-position) end-marker) 4390 (not (eobp))) 4391 ;; Don’t insert trailing whitespace. 4392 (insert (if (eolp) prefix-without-trailing-whitespace prefix)) 4393 (forward-line))))) 4394 4395 (defun markdown-blockquote-region (beg end) 4396 "Blockquote the region. 4397 Arguments BEG and END specify the beginning and end of the region." 4398 (interactive "*r") 4399 (markdown-block-region 4400 beg end (concat (markdown-blockquote-indentation 4401 (max (point-min) (1- beg))) "> "))) 4402 4403 (defun markdown-pre-indentation (loc) 4404 "Return string containing necessary whitespace for a pre block at LOC. 4405 Also see `markdown-blockquote-indentation'." 4406 (save-excursion 4407 (goto-char loc) 4408 (let* ((list-level (length (markdown-calculate-list-levels))) 4409 indent) 4410 (dotimes (_ (1+ list-level) indent) 4411 (setq indent (concat indent " ")))))) 4412 4413 (defun markdown-insert-pre () 4414 "Start a preformatted section (or apply to the region). 4415 If Transient Mark mode is on and a region is active, it is marked 4416 as preformatted text." 4417 (interactive) 4418 (if (use-region-p) 4419 (markdown-pre-region (region-beginning) (region-end)) 4420 (markdown-ensure-blank-line-before) 4421 (insert (markdown-pre-indentation (point))) 4422 (markdown-ensure-blank-line-after))) 4423 4424 (defun markdown-pre-region (beg end) 4425 "Format the region as preformatted text. 4426 Arguments BEG and END specify the beginning and end of the region." 4427 (interactive "*r") 4428 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) 4429 (markdown-block-region beg end indent))) 4430 4431 (defun markdown-electric-backquote (arg) 4432 "Insert a backquote. 4433 The numeric prefix argument ARG says how many times to repeat the insertion. 4434 Call `markdown-insert-gfm-code-block' interactively 4435 if three backquotes inserted at the beginning of line." 4436 (interactive "*P") 4437 (self-insert-command (prefix-numeric-value arg)) 4438 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) 4439 (replace-match "") 4440 (call-interactively #'markdown-insert-gfm-code-block))) 4441 4442 (defconst markdown-gfm-recognized-languages 4443 ;; To reproduce/update, evaluate the let-form in 4444 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, 4445 ;; but with appropriate use of a keyboard macro, indenting and filling it 4446 ;; properly is pretty fast. 4447 '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" 4448 "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" 4449 "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" 4450 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" 4451 "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" 4452 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" 4453 "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" 4454 "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" 4455 "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" 4456 "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" 4457 "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" 4458 "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" 4459 "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" 4460 "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" 4461 "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" 4462 "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" 4463 "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" 4464 "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" 4465 "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" 4466 "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" 4467 "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" 4468 "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" 4469 "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" 4470 "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" 4471 "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" 4472 "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" 4473 "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" 4474 "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" 4475 "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" 4476 "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" 4477 "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" 4478 "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" 4479 "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" 4480 "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" 4481 "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" 4482 "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" 4483 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" 4484 "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" 4485 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" 4486 "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" 4487 "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" 4488 "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" 4489 "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" 4490 "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" 4491 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" 4492 "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" 4493 "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" 4494 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" 4495 "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" 4496 "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" 4497 "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" 4498 "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" 4499 "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" 4500 "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" 4501 "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" 4502 "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" 4503 "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" 4504 "Linux-Kernel-Module" "Liquid" "Literate-Agda" 4505 "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" 4506 "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" 4507 "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" 4508 "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" 4509 "Max" "Mercury" "Mermaid" "Meson" "Metal" 4510 "Microsoft-Developer-Studio-Project" 4511 "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" 4512 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" 4513 "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" 4514 "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" 4515 "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" 4516 "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" 4517 "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" 4518 "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" 4519 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" 4520 "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" 4521 "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" 4522 "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" 4523 "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" 4524 "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" 4525 "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" 4526 "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" 4527 "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" 4528 "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" 4529 "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" 4530 "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" 4531 "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" 4532 "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" 4533 "PureBasic" "PureScript" "Pyret" "Python" "Python-console" 4534 "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" 4535 "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" 4536 "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" 4537 "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" 4538 "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" 4539 "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" 4540 "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" 4541 "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" 4542 "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" 4543 "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" 4544 "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" 4545 "ShellCheck-Config" "ShellSession" "Shen" "Sieve" 4546 "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" 4547 "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" 4548 "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" 4549 "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" 4550 "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" 4551 "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" 4552 "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" 4553 "Terraform-Template" "Texinfo" "Text" "TextGrid" 4554 "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" 4555 "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" 4556 "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" 4557 "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" 4558 "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" 4559 "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" 4560 "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" 4561 "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" 4562 "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" 4563 "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" 4564 "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" 4565 "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" 4566 "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" 4567 "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" 4568 "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" 4569 "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" 4570 "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" 4571 "reStructuredText" "robots.txt" "sed" "wisp" "xBase") 4572 "Language specifiers recognized by GitHub's syntax highlighting features.") 4573 4574 (defvar-local markdown-gfm-used-languages nil 4575 "Language names used in GFM code blocks.") 4576 4577 (defun markdown-trim-whitespace (str) 4578 (replace-regexp-in-string 4579 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) 4580 4581 (defun markdown-clean-language-string (str) 4582 (replace-regexp-in-string 4583 "{\\.?\\|}" "" (markdown-trim-whitespace str))) 4584 4585 (defun markdown-validate-language-string (widget) 4586 (let ((str (widget-value widget))) 4587 (unless (string= str (markdown-clean-language-string str)) 4588 (widget-put widget :error (format "Invalid language spec: '%s'" str)) 4589 widget))) 4590 4591 (defun markdown-gfm-get-corpus () 4592 "Create corpus of recognized GFM code block languages for the given buffer." 4593 (let ((given-corpus (append markdown-gfm-additional-languages 4594 markdown-gfm-recognized-languages))) 4595 (append 4596 markdown-gfm-used-languages 4597 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) 4598 given-corpus)))) 4599 4600 (defun markdown-gfm-add-used-language (lang) 4601 "Clean LANG and add to list of used languages." 4602 (setq markdown-gfm-used-languages 4603 (cons lang (remove lang markdown-gfm-used-languages)))) 4604 4605 (defcustom markdown-spaces-after-code-fence 1 4606 "Number of space characters to insert after a code fence. 4607 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an 4608 opening code fence and an info string." 4609 :group 'markdown 4610 :type 'integer 4611 :safe #'natnump 4612 :package-version '(markdown-mode . "2.3")) 4613 4614 (defcustom markdown-code-block-braces nil 4615 "When non-nil, automatically insert braces for GFM code blocks." 4616 :group 'markdown 4617 :type 'boolean) 4618 4619 (defun markdown-insert-gfm-code-block (&optional lang edit) 4620 "Insert GFM code block for language LANG. 4621 If LANG is nil, the language will be queried from user. If a 4622 region is active, wrap this region with the markup instead. If 4623 the region boundaries are not on empty lines, these are added 4624 automatically in order to have the correct markup. When EDIT is 4625 non-nil (e.g., when \\[universal-argument] is given), edit the 4626 code block in an indirect buffer after insertion." 4627 (interactive 4628 (list (let ((completion-ignore-case nil)) 4629 (condition-case nil 4630 (markdown-clean-language-string 4631 (completing-read 4632 "Programming language: " 4633 (markdown-gfm-get-corpus) 4634 nil 'confirm (car markdown-gfm-used-languages) 4635 'markdown-gfm-language-history)) 4636 (quit ""))) 4637 current-prefix-arg)) 4638 (unless (string= lang "") (markdown-gfm-add-used-language lang)) 4639 (when (and (> (length lang) 0) 4640 (not markdown-code-block-braces)) 4641 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) 4642 lang))) 4643 (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) 4644 (gfm-close-brace (if markdown-code-block-braces "}" ""))) 4645 (if (use-region-p) 4646 (let* ((b (region-beginning)) (e (region-end)) end 4647 (indent (progn (goto-char b) (current-indentation)))) 4648 (goto-char e) 4649 ;; if we're on a blank line, don't newline, otherwise the ``` 4650 ;; should go on its own line 4651 (unless (looking-back "\n" nil) 4652 (newline)) 4653 (indent-to indent) 4654 (insert "```") 4655 (markdown-ensure-blank-line-after) 4656 (setq end (point)) 4657 (goto-char b) 4658 ;; if we're on a blank line, insert the quotes here, otherwise 4659 ;; add a new line first 4660 (unless (looking-at-p "\n") 4661 (newline) 4662 (forward-line -1)) 4663 (markdown-ensure-blank-line-before) 4664 (indent-to indent) 4665 (insert "```" gfm-open-brace lang gfm-close-brace) 4666 (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) 4667 (let ((indent (current-indentation)) 4668 start-bol) 4669 (delete-horizontal-space :backward-only) 4670 (markdown-ensure-blank-line-before) 4671 (indent-to indent) 4672 (setq start-bol (line-beginning-position)) 4673 (insert "```" gfm-open-brace lang gfm-close-brace "\n") 4674 (indent-to indent) 4675 (unless edit (insert ?\n)) 4676 (indent-to indent) 4677 (insert "```") 4678 (markdown-ensure-blank-line-after) 4679 (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) 4680 (end-of-line 0) 4681 (when edit (markdown-edit-code-block))))) 4682 4683 (defun markdown-code-block-lang (&optional pos-prop) 4684 "Return the language name for a GFM or tilde fenced code block. 4685 The beginning of the block may be described by POS-PROP, 4686 a cons of (pos . prop) giving the position and property 4687 at the beginning of the block." 4688 (or pos-prop 4689 (setq pos-prop 4690 (markdown-max-of-seq 4691 #'car 4692 (cl-remove-if 4693 #'null 4694 (cl-mapcar 4695 #'markdown-find-previous-prop 4696 (markdown-get-fenced-block-begin-properties)))))) 4697 (when pos-prop 4698 (goto-char (car pos-prop)) 4699 (set-match-data (get-text-property (point) (cdr pos-prop))) 4700 ;; Note: Hard-coded group number assumes tilde 4701 ;; and GFM fenced code regexp groups agree. 4702 (let ((begin (match-beginning 3)) 4703 (end (match-end 3))) 4704 (when (and begin end) 4705 ;; Fix language strings beginning with periods, like ".ruby". 4706 (when (eq (char-after begin) ?.) 4707 (setq begin (1+ begin))) 4708 (buffer-substring-no-properties begin end))))) 4709 4710 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer) 4711 (with-current-buffer (or buffer (current-buffer)) 4712 (save-excursion 4713 (goto-char (point-min)) 4714 (cl-loop 4715 with prop = 'markdown-gfm-block-begin 4716 for pos-prop = (markdown-find-next-prop prop) 4717 while pos-prop 4718 for lang = (markdown-code-block-lang pos-prop) 4719 do (progn (when lang (markdown-gfm-add-used-language lang)) 4720 (goto-char (next-single-property-change (point) prop))))))) 4721 4722 (defun markdown-insert-foldable-block () 4723 "Insert details disclosure element to make content foldable. 4724 If a region is active, wrap this region with the disclosure 4725 element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." 4726 (interactive) 4727 (let ((details-open-tag "<details>") 4728 (details-close-tag "</details>") 4729 (summary-open-tag "<summary>") 4730 (summary-close-tag " </summary>")) 4731 (if (use-region-p) 4732 (let* ((b (region-beginning)) 4733 (e (region-end)) 4734 (indent (progn (goto-char b) (current-indentation)))) 4735 (goto-char e) 4736 ;; if we're on a blank line, don't newline, otherwise the tags 4737 ;; should go on its own line 4738 (unless (looking-back "\n" nil) 4739 (newline)) 4740 (indent-to indent) 4741 (insert details-close-tag) 4742 (markdown-ensure-blank-line-after) 4743 (goto-char b) 4744 ;; if we're on a blank line, insert the quotes here, otherwise 4745 ;; add a new line first 4746 (unless (looking-at-p "\n") 4747 (newline) 4748 (forward-line -1)) 4749 (markdown-ensure-blank-line-before) 4750 (indent-to indent) 4751 (insert details-open-tag "\n") 4752 (insert summary-open-tag summary-close-tag) 4753 (search-backward summary-close-tag)) 4754 (let ((indent (current-indentation))) 4755 (delete-horizontal-space :backward-only) 4756 (markdown-ensure-blank-line-before) 4757 (indent-to indent) 4758 (insert details-open-tag "\n") 4759 (insert summary-open-tag summary-close-tag "\n") 4760 (insert details-close-tag) 4761 (indent-to indent) 4762 (markdown-ensure-blank-line-after) 4763 (search-backward summary-close-tag))))) 4764 4765 4766 ;;; Footnotes ================================================================= 4767 4768 (defun markdown-footnote-counter-inc () 4769 "Increment `markdown-footnote-counter' and return the new value." 4770 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. 4771 (save-excursion 4772 (goto-char (point-min)) 4773 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") 4774 (point-max) t) 4775 (let ((fn (string-to-number (match-string 1)))) 4776 (when (> fn markdown-footnote-counter) 4777 (setq markdown-footnote-counter fn)))))) 4778 (cl-incf markdown-footnote-counter)) 4779 4780 (defun markdown-insert-footnote () 4781 "Insert footnote with a new number and move point to footnote definition." 4782 (interactive) 4783 (let ((fn (markdown-footnote-counter-inc))) 4784 (insert (format "[^%d]" fn)) 4785 (push-mark (point) t) 4786 (markdown-footnote-text-find-new-location) 4787 (markdown-ensure-blank-line-before) 4788 (unless (markdown-cur-line-blank-p) 4789 (insert "\n")) 4790 (insert (format "[^%d]: " fn)) 4791 (markdown-ensure-blank-line-after))) 4792 4793 (defun markdown-footnote-text-find-new-location () 4794 "Position the point at the proper location for a new footnote text." 4795 (cond 4796 ((eq markdown-footnote-location 'end) (goto-char (point-max))) 4797 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) 4798 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) 4799 ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) 4800 4801 (defun markdown-footnote-kill () 4802 "Kill the footnote at point. 4803 The footnote text is killed (and added to the kill ring), the 4804 footnote marker is deleted. Point has to be either at the 4805 footnote marker or in the footnote text." 4806 (interactive) 4807 (let ((marker-pos nil) 4808 (skip-deleting-marker nil) 4809 (starting-footnote-text-positions 4810 (markdown-footnote-text-positions))) 4811 (when starting-footnote-text-positions 4812 ;; We're starting in footnote text, so mark our return position and jump 4813 ;; to the marker if possible. 4814 (let ((marker-pos (markdown-footnote-find-marker 4815 (cl-first starting-footnote-text-positions)))) 4816 (if marker-pos 4817 (goto-char (1- marker-pos)) 4818 ;; If there isn't a marker, we still want to kill the text. 4819 (setq skip-deleting-marker t)))) 4820 ;; Either we didn't start in the text, or we started in the text and jumped 4821 ;; to the marker. We want to assume we're at the marker now and error if 4822 ;; we're not. 4823 (unless skip-deleting-marker 4824 (let ((marker (markdown-footnote-delete-marker))) 4825 (unless marker 4826 (error "Not at a footnote")) 4827 ;; Even if we knew the text position before, it changed when we deleted 4828 ;; the label. 4829 (setq marker-pos (cl-second marker)) 4830 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) 4831 (unless new-text-pos 4832 (error "No text for footnote `%s'" (cl-first marker))) 4833 (goto-char new-text-pos)))) 4834 (let ((pos (markdown-footnote-kill-text))) 4835 (goto-char (if starting-footnote-text-positions 4836 pos 4837 marker-pos))))) 4838 4839 (defun markdown-footnote-delete-marker () 4840 "Delete a footnote marker at point. 4841 Returns a list (ID START) containing the footnote ID and the 4842 start position of the marker before deletion. If no footnote 4843 marker was deleted, this function returns NIL." 4844 (let ((marker (markdown-footnote-marker-positions))) 4845 (when marker 4846 (delete-region (cl-second marker) (cl-third marker)) 4847 (butlast marker)))) 4848 4849 (defun markdown-footnote-kill-text () 4850 "Kill footnote text at point. 4851 Returns the start position of the footnote text before deletion, 4852 or NIL if point was not inside a footnote text. 4853 4854 The killed text is placed in the kill ring (without the footnote 4855 number)." 4856 (let ((fn (markdown-footnote-text-positions))) 4857 (when fn 4858 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) 4859 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) 4860 (kill-new (match-string 1 text)) 4861 (when (and (markdown-cur-line-blank-p) 4862 (markdown-prev-line-blank-p) 4863 (not (bobp))) 4864 (delete-region (1- (point)) (point))) 4865 (cl-second fn))))) 4866 4867 (defun markdown-footnote-goto-text () 4868 "Jump to the text of the footnote at point." 4869 (interactive) 4870 (let ((fn (car (markdown-footnote-marker-positions)))) 4871 (unless fn 4872 (user-error "Not at a footnote marker")) 4873 (let ((new-pos (markdown-footnote-find-text fn))) 4874 (unless new-pos 4875 (error "No definition found for footnote `%s'" fn)) 4876 (goto-char new-pos)))) 4877 4878 (defun markdown-footnote-return () 4879 "Return from a footnote to its footnote number in the main text." 4880 (interactive) 4881 (let ((fn (save-excursion 4882 (car (markdown-footnote-text-positions))))) 4883 (unless fn 4884 (user-error "Not in a footnote")) 4885 (let ((new-pos (markdown-footnote-find-marker fn))) 4886 (unless new-pos 4887 (error "Footnote marker `%s' not found" fn)) 4888 (goto-char new-pos)))) 4889 4890 (defun markdown-footnote-find-marker (id) 4891 "Find the location of the footnote marker with ID. 4892 The actual buffer position returned is the position directly 4893 following the marker's closing bracket. If no marker is found, 4894 NIL is returned." 4895 (save-excursion 4896 (goto-char (point-min)) 4897 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) 4898 (skip-chars-backward "^]") 4899 (point)))) 4900 4901 (defun markdown-footnote-find-text (id) 4902 "Find the location of the text of footnote ID. 4903 The actual buffer position returned is the position of the first 4904 character of the text, after the footnote's identifier. If no 4905 footnote text is found, NIL is returned." 4906 (save-excursion 4907 (goto-char (point-min)) 4908 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) 4909 (skip-chars-forward " \t") 4910 (point)))) 4911 4912 (defun markdown-footnote-marker-positions () 4913 "Return the position and ID of the footnote marker point is on. 4914 The return value is a list (ID START END). If point is not on a 4915 footnote, NIL is returned." 4916 ;; first make sure we're at a footnote marker 4917 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) 4918 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) 4919 (save-excursion 4920 ;; move point between [ and ^: 4921 (if (looking-at-p "\\[") 4922 (forward-char 1) 4923 (skip-chars-backward "^[")) 4924 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) 4925 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) 4926 4927 (defun markdown-footnote-text-positions () 4928 "Return the start and end positions of the footnote text point is in. 4929 The exact return value is a list of three elements: (ID START END). 4930 The start position is the position of the opening bracket 4931 of the footnote id. The end position is directly after the 4932 newline that ends the footnote. If point is not in a footnote, 4933 NIL is returned instead." 4934 (save-excursion 4935 (let (result) 4936 (move-beginning-of-line 1) 4937 ;; Try to find the label. If we haven't found the label and we're at a blank 4938 ;; or indented line, back up if possible. 4939 (while (and 4940 (not (and (looking-at markdown-regex-footnote-definition) 4941 (setq result (list (match-string 1) (point))))) 4942 (and (not (bobp)) 4943 (or (markdown-cur-line-blank-p) 4944 (>= (current-indentation) 4)))) 4945 (forward-line -1)) 4946 (when result 4947 ;; Advance if there is a next line that is either blank or indented. 4948 ;; (Need to check if we're on the last line, because 4949 ;; markdown-next-line-blank-p returns true for last line in buffer.) 4950 (while (and (/= (line-end-position) (point-max)) 4951 (or (markdown-next-line-blank-p) 4952 (>= (markdown-next-line-indent) 4))) 4953 (forward-line)) 4954 ;; Move back while the current line is blank. 4955 (while (markdown-cur-line-blank-p) 4956 (forward-line -1)) 4957 ;; Advance to capture this line and a single trailing newline (if there 4958 ;; is one). 4959 (forward-line) 4960 (append result (list (point))))))) 4961 4962 (defun markdown-get-defined-footnotes () 4963 "Return a list of all defined footnotes. 4964 Result is an alist of pairs (MARKER . LINE), where MARKER is the 4965 footnote marker, a string, and LINE is the line number containing 4966 the footnote definition. 4967 4968 For example, suppose the following footnotes are defined at positions 4969 448 and 475: 4970 4971 \[^1]: First footnote here. 4972 \[^marker]: Second footnote. 4973 4974 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" 4975 (save-excursion 4976 (goto-char (point-min)) 4977 (let (footnotes) 4978 (while (markdown-search-until-condition 4979 (lambda () (and (not (markdown-code-block-at-point-p)) 4980 (not (markdown-inline-code-at-point-p)) 4981 (not (markdown-in-comment-p)))) 4982 markdown-regex-footnote-definition nil t) 4983 (let ((marker (match-string-no-properties 1)) 4984 (pos (match-beginning 0))) 4985 (unless (zerop (length marker)) 4986 (cl-pushnew (cons marker pos) footnotes :test #'equal)))) 4987 (reverse footnotes)))) 4988 4989 4990 ;;; Element Removal =========================================================== 4991 4992 (defun markdown-kill-thing-at-point () 4993 "Kill thing at point and add important text, without markup, to kill ring. 4994 Possible things to kill include (roughly in order of precedence): 4995 inline code, headers, horizontal rules, links (add link text to 4996 kill ring), images (add alt text to kill ring), angle uri, email 4997 addresses, bold, italics, reference definition (add URI to kill 4998 ring), footnote markers and text (kill both marker and text, add 4999 text to kill ring), and list items." 5000 (interactive "*") 5001 (let (val) 5002 (cond 5003 ;; Inline code 5004 ((markdown-inline-code-at-point) 5005 (kill-new (match-string 2)) 5006 (delete-region (match-beginning 0) (match-end 0))) 5007 ;; ATX header 5008 ((thing-at-point-looking-at markdown-regex-header-atx) 5009 (kill-new (match-string 2)) 5010 (delete-region (match-beginning 0) (match-end 0))) 5011 ;; Setext header 5012 ((thing-at-point-looking-at markdown-regex-header-setext) 5013 (kill-new (match-string 1)) 5014 (delete-region (match-beginning 0) (match-end 0))) 5015 ;; Horizontal rule 5016 ((thing-at-point-looking-at markdown-regex-hr) 5017 (kill-new (match-string 0)) 5018 (delete-region (match-beginning 0) (match-end 0))) 5019 ;; Inline link or image (add link or alt text to kill ring) 5020 ((thing-at-point-looking-at markdown-regex-link-inline) 5021 (kill-new (match-string 3)) 5022 (delete-region (match-beginning 0) (match-end 0))) 5023 ;; Reference link or image (add link or alt text to kill ring) 5024 ((thing-at-point-looking-at markdown-regex-link-reference) 5025 (kill-new (match-string 3)) 5026 (delete-region (match-beginning 0) (match-end 0))) 5027 ;; Angle URI (add URL to kill ring) 5028 ((thing-at-point-looking-at markdown-regex-angle-uri) 5029 (kill-new (match-string 2)) 5030 (delete-region (match-beginning 0) (match-end 0))) 5031 ;; Email address in angle brackets (add email address to kill ring) 5032 ((thing-at-point-looking-at markdown-regex-email) 5033 (kill-new (match-string 1)) 5034 (delete-region (match-beginning 0) (match-end 0))) 5035 ;; Wiki link (add alias text to kill ring) 5036 ((and markdown-enable-wiki-links 5037 (thing-at-point-looking-at markdown-regex-wiki-link)) 5038 (kill-new (markdown-wiki-link-alias)) 5039 (delete-region (match-beginning 1) (match-end 1))) 5040 ;; Bold 5041 ((thing-at-point-looking-at markdown-regex-bold) 5042 (kill-new (match-string 4)) 5043 (delete-region (match-beginning 2) (match-end 2))) 5044 ;; Italics 5045 ((thing-at-point-looking-at markdown-regex-italic) 5046 (kill-new (match-string 3)) 5047 (delete-region (match-beginning 1) (match-end 1))) 5048 ;; Strikethrough 5049 ((thing-at-point-looking-at markdown-regex-strike-through) 5050 (kill-new (match-string 4)) 5051 (delete-region (match-beginning 2) (match-end 2))) 5052 ;; Footnote marker (add footnote text to kill ring) 5053 ((thing-at-point-looking-at markdown-regex-footnote) 5054 (markdown-footnote-kill)) 5055 ;; Footnote text (add footnote text to kill ring) 5056 ((setq val (markdown-footnote-text-positions)) 5057 (markdown-footnote-kill)) 5058 ;; Reference definition (add URL to kill ring) 5059 ((thing-at-point-looking-at markdown-regex-reference-definition) 5060 (kill-new (match-string 5)) 5061 (delete-region (match-beginning 0) (match-end 0))) 5062 ;; List item 5063 ((setq val (markdown-cur-list-item-bounds)) 5064 (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) 5065 (t 5066 (user-error "Nothing found at point to kill"))))) 5067 5068 (defun markdown-kill-outline () 5069 "Kill visible heading and add it to `kill-ring'." 5070 (interactive) 5071 (save-excursion 5072 (markdown-outline-previous) 5073 (kill-region (point) (progn (markdown-outline-next) (point))))) 5074 5075 (defun markdown-kill-block () 5076 "Kill visible code block, list item, or blockquote and add it to `kill-ring'." 5077 (interactive) 5078 (save-excursion 5079 (markdown-backward-block) 5080 (kill-region (point) (progn (markdown-forward-block) (point))))) 5081 5082 5083 ;;; Indentation =============================================================== 5084 5085 (defun markdown-indent-find-next-position (cur-pos positions) 5086 "Return the position after the index of CUR-POS in POSITIONS. 5087 Positions are calculated by `markdown-calc-indents'." 5088 (while (and positions 5089 (not (equal cur-pos (car positions)))) 5090 (setq positions (cdr positions))) 5091 (or (cadr positions) 0)) 5092 5093 (defun markdown-outdent-find-next-position (cur-pos positions) 5094 "Return the maximal element that precedes CUR-POS from POSITIONS. 5095 Positions are calculated by `markdown-calc-indents'." 5096 (let ((result 0)) 5097 (dolist (i positions) 5098 (when (< i cur-pos) 5099 (setq result (max result i)))) 5100 result)) 5101 5102 (defun markdown-indent-line () 5103 "Indent the current line using some heuristics. 5104 If the _previous_ command was either `markdown-enter-key' or 5105 `markdown-cycle', then we should cycle to the next 5106 reasonable indentation position. Otherwise, we could have been 5107 called directly by `markdown-enter-key', by an initial call of 5108 `markdown-cycle', or indirectly by `auto-fill-mode'. In 5109 these cases, indent to the default position. 5110 Positions are calculated by `markdown-calc-indents'." 5111 (interactive) 5112 (let ((positions (markdown-calc-indents)) 5113 (point-pos (current-column)) 5114 (_ (back-to-indentation)) 5115 (cur-pos (current-column))) 5116 (if (not (equal this-command 'markdown-cycle)) 5117 (indent-line-to (car positions)) 5118 (setq positions (sort (delete-dups positions) '<)) 5119 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) 5120 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) 5121 (indent-line-to next-pos) 5122 (move-to-column new-point-pos))))) 5123 5124 (defun markdown-calc-indents () 5125 "Return a list of indentation columns to cycle through. 5126 The first element in the returned list should be considered the 5127 default indentation level. This function does not worry about 5128 duplicate positions, which are handled up by calling functions." 5129 (let (pos prev-line-pos positions) 5130 5131 ;; Indentation of previous line 5132 (setq prev-line-pos (markdown-prev-line-indent)) 5133 (setq positions (cons prev-line-pos positions)) 5134 5135 ;; Indentation of previous non-list-marker text 5136 (when (setq pos (save-excursion 5137 (forward-line -1) 5138 (when (looking-at markdown-regex-list) 5139 (- (match-end 3) (match-beginning 0))))) 5140 (setq positions (cons pos positions))) 5141 5142 ;; Indentation required for a pre block in current context 5143 (setq pos (length (markdown-pre-indentation (point)))) 5144 (setq positions (cons pos positions)) 5145 5146 ;; Indentation of the previous line + tab-width 5147 (if prev-line-pos 5148 (setq positions (cons (+ prev-line-pos tab-width) positions)) 5149 (setq positions (cons tab-width positions))) 5150 5151 ;; Indentation of the previous line - tab-width 5152 (if (and prev-line-pos (> prev-line-pos tab-width)) 5153 (setq positions (cons (- prev-line-pos tab-width) positions))) 5154 5155 ;; Indentation of all preceding list markers (when in a list) 5156 (when (setq pos (markdown-calculate-list-levels)) 5157 (setq positions (append pos positions))) 5158 5159 ;; First column 5160 (setq positions (cons 0 positions)) 5161 5162 ;; Return reversed list 5163 (reverse positions))) 5164 5165 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent 5166 "Handle RET depending on the context. 5167 If the point is at a table, move to the next row. Otherwise, 5168 indent according to value of `markdown-indent-on-enter'. 5169 When it is nil, simply call `newline'. Otherwise, indent the next line 5170 following RET using `markdown-indent-line'. Furthermore, when it 5171 is set to \\='indent-and-new-item and the point is in a list item, 5172 start a new item with the same indentation. If the point is in an 5173 empty list item, remove it (so that pressing RET twice when in a 5174 list simply adds a blank line)." 5175 (interactive) 5176 (cond 5177 ;; Table 5178 ((markdown-table-at-point-p) 5179 (call-interactively #'markdown-table-next-row)) 5180 ;; Indent non-table text 5181 (markdown-indent-on-enter 5182 (let (bounds) 5183 (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) 5184 (setq bounds (markdown-cur-list-item-bounds))) 5185 (let ((beg (cl-first bounds)) 5186 (end (cl-second bounds)) 5187 (nonlist-indent (cl-fourth bounds)) 5188 (checkbox (cl-sixth bounds))) 5189 ;; Point is in a list item 5190 (if (= (- end beg) (+ nonlist-indent (length checkbox))) 5191 ;; Delete blank list 5192 (progn 5193 (delete-region beg end) 5194 (newline) 5195 (markdown-indent-line)) 5196 (call-interactively #'markdown-insert-list-item))) 5197 ;; Point is not in a list 5198 (newline) 5199 (markdown-indent-line)))) 5200 ;; Insert a raw newline 5201 (t (newline)))) 5202 5203 (defun markdown-outdent-or-delete (arg) 5204 "Handle BACKSPACE by cycling through indentation points. 5205 When BACKSPACE is pressed, if there is only whitespace 5206 before the current point, then outdent the line one level. 5207 Otherwise, do normal delete by repeating 5208 `backward-delete-char-untabify' ARG times." 5209 (interactive "*p") 5210 (if (use-region-p) 5211 (backward-delete-char-untabify arg) 5212 (let ((cur-pos (current-column)) 5213 (start-of-indention (save-excursion 5214 (back-to-indentation) 5215 (current-column))) 5216 (positions (markdown-calc-indents))) 5217 (if (and (> cur-pos 0) (= cur-pos start-of-indention)) 5218 (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) 5219 (backward-delete-char-untabify arg))))) 5220 5221 (defun markdown-find-leftmost-column (beg end) 5222 "Find the leftmost column in the region from BEG to END." 5223 (let ((mincol 1000)) 5224 (save-excursion 5225 (goto-char beg) 5226 (while (< (point) end) 5227 (back-to-indentation) 5228 (unless (looking-at-p "[ \t]*$") 5229 (setq mincol (min mincol (current-column)))) 5230 (forward-line 1) 5231 )) 5232 mincol)) 5233 5234 (defun markdown-indent-region (beg end arg) 5235 "Indent the region from BEG to END using some heuristics. 5236 When ARG is non-nil, outdent the region instead. 5237 See `markdown-indent-line' and `markdown-indent-line'." 5238 (interactive "*r\nP") 5239 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) 5240 (leftmostcol (markdown-find-leftmost-column beg end)) 5241 (next-pos (if arg 5242 (markdown-outdent-find-next-position leftmostcol positions) 5243 (markdown-indent-find-next-position leftmostcol positions)))) 5244 (indent-rigidly beg end (- next-pos leftmostcol)) 5245 (setq deactivate-mark nil))) 5246 5247 (defun markdown-outdent-region (beg end) 5248 "Call `markdown-indent-region' on region from BEG to END with prefix." 5249 (interactive "*r") 5250 (markdown-indent-region beg end t)) 5251 5252 (defun markdown--indent-region (start end) 5253 (let ((deactivate-mark nil)) 5254 (save-excursion 5255 (goto-char end) 5256 (setq end (point-marker)) 5257 (goto-char start) 5258 (when (bolp) 5259 (forward-line 1)) 5260 (while (< (point) end) 5261 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) 5262 (indent-according-to-mode)) 5263 (forward-line 1)) 5264 (move-marker end nil)))) 5265 5266 5267 ;;; Markup Completion ========================================================= 5268 5269 (defconst markdown-complete-alist 5270 '((markdown-regex-header-atx . markdown-complete-atx) 5271 (markdown-regex-header-setext . markdown-complete-setext) 5272 (markdown-regex-hr . markdown-complete-hr)) 5273 "Association list of form (regexp . function) for markup completion.") 5274 5275 (defun markdown-incomplete-atx-p () 5276 "Return t if ATX header markup is incomplete and nil otherwise. 5277 Assumes match data is available for `markdown-regex-header-atx'. 5278 Checks that the number of trailing hash marks equals the number of leading 5279 hash marks, that there is only a single space before and after the text, 5280 and that there is no extraneous whitespace in the text." 5281 (or 5282 ;; Number of starting and ending hash marks differs 5283 (not (= (length (match-string 1)) (length (match-string 3)))) 5284 ;; When the header text is not empty... 5285 (and (> (length (match-string 2)) 0) 5286 ;; ...if there are extra leading, trailing, or interior spaces 5287 (or (not (= (match-beginning 2) (1+ (match-end 1)))) 5288 (not (= (match-beginning 3) (1+ (match-end 2)))) 5289 (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) 5290 ;; When the header text is empty... 5291 (and (= (length (match-string 2)) 0) 5292 ;; ...if there are too many or too few spaces 5293 (not (= (match-beginning 3) (+ (match-end 1) 2)))))) 5294 5295 (defun markdown-complete-atx () 5296 "Complete and normalize ATX headers. 5297 Add or remove hash marks to the end of the header to match the 5298 beginning. Ensure that there is only a single space between hash 5299 marks and header text. Removes extraneous whitespace from header text. 5300 Assumes match data is available for `markdown-regex-header-atx'. 5301 Return nil if markup was complete and non-nil if markup was completed." 5302 (when (markdown-incomplete-atx-p) 5303 (let* ((new-marker (make-marker)) 5304 (new-marker (set-marker new-marker (match-end 2)))) 5305 ;; Hash marks and spacing at end 5306 (goto-char (match-end 2)) 5307 (delete-region (match-end 2) (match-end 3)) 5308 (insert " " (match-string 1)) 5309 ;; Remove extraneous whitespace from title 5310 (replace-match (markdown-compress-whitespace-string (match-string 2)) 5311 t t nil 2) 5312 ;; Spacing at beginning 5313 (goto-char (match-end 1)) 5314 (delete-region (match-end 1) (match-beginning 2)) 5315 (insert " ") 5316 ;; Leave point at end of text 5317 (goto-char new-marker)))) 5318 5319 (defun markdown-incomplete-setext-p () 5320 "Return t if setext header markup is incomplete and nil otherwise. 5321 Assumes match data is available for `markdown-regex-header-setext'. 5322 Checks that length of underline matches text and that there is no 5323 extraneous whitespace in the text." 5324 (or (not (= (length (match-string 1)) (length (match-string 2)))) 5325 (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) 5326 5327 (defun markdown-complete-setext () 5328 "Complete and normalize setext headers. 5329 Add or remove underline characters to match length of header 5330 text. Removes extraneous whitespace from header text. Assumes 5331 match data is available for `markdown-regex-header-setext'. 5332 Return nil if markup was complete and non-nil if markup was completed." 5333 (when (markdown-incomplete-setext-p) 5334 (let* ((text (markdown-compress-whitespace-string (match-string 1))) 5335 (char (char-after (match-beginning 2))) 5336 (level (if (char-equal char ?-) 2 1))) 5337 (goto-char (match-beginning 0)) 5338 (delete-region (match-beginning 0) (match-end 0)) 5339 (markdown-insert-header level text t) 5340 t))) 5341 5342 (defun markdown-incomplete-hr-p () 5343 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. 5344 Assumes match data is available for `markdown-regex-hr'." 5345 (not (member (match-string 0) markdown-hr-strings))) 5346 5347 (defun markdown-complete-hr () 5348 "Complete horizontal rules. 5349 If horizontal rule string is a member of `markdown-hr-strings', 5350 do nothing. Otherwise, replace with the car of 5351 `markdown-hr-strings'. 5352 Assumes match data is available for `markdown-regex-hr'. 5353 Return nil if markup was complete and non-nil if markup was completed." 5354 (when (markdown-incomplete-hr-p) 5355 (replace-match (car markdown-hr-strings)) 5356 t)) 5357 5358 (defun markdown-complete () 5359 "Complete markup of object near point or in region when active. 5360 Handle all objects in `markdown-complete-alist', in order. 5361 See `markdown-complete-at-point' and `markdown-complete-region'." 5362 (interactive "*") 5363 (if (use-region-p) 5364 (markdown-complete-region (region-beginning) (region-end)) 5365 (markdown-complete-at-point))) 5366 5367 (defun markdown-complete-at-point () 5368 "Complete markup of object near point. 5369 Handle all elements of `markdown-complete-alist' in order." 5370 (interactive "*") 5371 (let ((list markdown-complete-alist) found changed) 5372 (while list 5373 (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? 5374 (function (cdar list))) 5375 (setq list (cdr list)) 5376 (when (thing-at-point-looking-at regexp) 5377 (setq found t) 5378 (setq changed (funcall function)) 5379 (setq list nil)))) 5380 (if found 5381 (or changed (user-error "Markup at point is complete")) 5382 (user-error "Nothing to complete at point")))) 5383 5384 (defun markdown-complete-region (beg end) 5385 "Complete markup of objects in region from BEG to END. 5386 Handle all objects in `markdown-complete-alist', in order. Each 5387 match is checked to ensure that a previous regexp does not also 5388 match." 5389 (interactive "*r") 5390 (let ((end-marker (set-marker (make-marker) end)) 5391 previous) 5392 (dolist (element markdown-complete-alist) 5393 (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? 5394 (function (cdr element))) 5395 (goto-char beg) 5396 (while (re-search-forward regexp end-marker 'limit) 5397 (when (match-string 0) 5398 ;; Make sure this is not a match for any of the preceding regexps. 5399 ;; This prevents mistaking an HR for a Setext subheading. 5400 (let (match) 5401 (save-match-data 5402 (dolist (prev-regexp previous) 5403 (or match (setq match (looking-back prev-regexp nil))))) 5404 (unless match 5405 (save-excursion (funcall function)))))) 5406 (cl-pushnew regexp previous :test #'equal))) 5407 previous)) 5408 5409 (defun markdown-complete-buffer () 5410 "Complete markup for all objects in the current buffer." 5411 (interactive "*") 5412 (markdown-complete-region (point-min) (point-max))) 5413 5414 5415 ;;; Markup Cycling ============================================================ 5416 5417 (defun markdown-cycle-atx (arg &optional remove) 5418 "Cycle ATX header markup. 5419 Promote header (decrease level) when ARG is 1 and demote 5420 header (increase level) if arg is -1. When REMOVE is non-nil, 5421 remove the header when the level reaches zero and stop cycling 5422 when it reaches six. Otherwise, perform a proper cycling through 5423 levels one through six. Assumes match data is available for 5424 `markdown-regex-header-atx'." 5425 (let* ((old-level (length (match-string 1))) 5426 (new-level (+ old-level arg)) 5427 (text (match-string 2))) 5428 (when (not remove) 5429 (setq new-level (% new-level 6)) 5430 (setq new-level (cond ((= new-level 0) 6) 5431 ((< new-level 0) (+ new-level 6)) 5432 (t new-level)))) 5433 (cond 5434 ((= new-level 0) 5435 (markdown-unwrap-thing-at-point nil 0 2)) 5436 ((<= new-level 6) 5437 (goto-char (match-beginning 0)) 5438 (delete-region (match-beginning 0) (match-end 0)) 5439 (markdown-insert-header new-level text nil))))) 5440 5441 (defun markdown-cycle-setext (arg &optional remove) 5442 "Cycle setext header markup. 5443 Promote header (increase level) when ARG is 1 and demote 5444 header (decrease level or remove) if arg is -1. When demoting a 5445 level-two setext header, replace with a level-three atx header. 5446 When REMOVE is non-nil, remove the header when the level reaches 5447 zero. Otherwise, cycle back to a level six atx header. Assumes 5448 match data is available for `markdown-regex-header-setext'." 5449 (let* ((char (char-after (match-beginning 2))) 5450 (old-level (if (char-equal char ?=) 1 2)) 5451 (new-level (+ old-level arg))) 5452 (when (and (not remove) (= new-level 0)) 5453 (setq new-level 6)) 5454 (cond 5455 ((= new-level 0) 5456 (markdown-unwrap-thing-at-point nil 0 1)) 5457 ((<= new-level 2) 5458 (markdown-insert-header new-level nil t)) 5459 ((<= new-level 6) 5460 (markdown-insert-header new-level nil nil))))) 5461 5462 (defun markdown-cycle-hr (arg &optional remove) 5463 "Cycle string used for horizontal rule from `markdown-hr-strings'. 5464 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle 5465 backwards (promote). When REMOVE is non-nil, remove the hr instead 5466 of cycling when the end of the list is reached. 5467 Assumes match data is available for `markdown-regex-hr'." 5468 (let* ((strings (if (= arg -1) 5469 (reverse markdown-hr-strings) 5470 markdown-hr-strings)) 5471 (tail (member (match-string 0) strings)) 5472 (new (or (cadr tail) 5473 (if remove 5474 (if (= arg 1) 5475 "" 5476 (car tail)) 5477 (car strings))))) 5478 (replace-match new))) 5479 5480 (defun markdown-cycle-bold () 5481 "Cycle bold markup between underscores and asterisks. 5482 Assumes match data is available for `markdown-regex-bold'." 5483 (save-excursion 5484 (let* ((old-delim (match-string 3)) 5485 (new-delim (if (string-equal old-delim "**") "__" "**"))) 5486 (replace-match new-delim t t nil 3) 5487 (replace-match new-delim t t nil 5)))) 5488 5489 (defun markdown-cycle-italic () 5490 "Cycle italic markup between underscores and asterisks. 5491 Assumes match data is available for `markdown-regex-italic'." 5492 (save-excursion 5493 (let* ((old-delim (match-string 2)) 5494 (new-delim (if (string-equal old-delim "*") "_" "*"))) 5495 (replace-match new-delim t t nil 2) 5496 (replace-match new-delim t t nil 4)))) 5497 5498 5499 ;;; Keymap ==================================================================== 5500 5501 (defun markdown--style-map-prompt () 5502 "Return a formatted prompt for Markdown markup insertion." 5503 (when markdown-enable-prefix-prompts 5504 (concat 5505 "Markdown: " 5506 (propertize "bold" 'face 'markdown-bold-face) ", " 5507 (propertize "italic" 'face 'markdown-italic-face) ", " 5508 (propertize "code" 'face 'markdown-inline-code-face) ", " 5509 (propertize "C = GFM code" 'face 'markdown-code-face) ", " 5510 (propertize "pre" 'face 'markdown-pre-face) ", " 5511 (propertize "footnote" 'face 'markdown-footnote-text-face) ", " 5512 (propertize "F = foldable" 'face 'markdown-bold-face) ", " 5513 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " 5514 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " 5515 (propertize "- = hr" 'face 'markdown-hr-face) ", " 5516 "C-h = more"))) 5517 5518 (defun markdown--command-map-prompt () 5519 "Return prompt for Markdown buffer-wide commands." 5520 (when markdown-enable-prefix-prompts 5521 (concat 5522 "Command: " 5523 (propertize "m" 'face 'markdown-bold-face) "arkdown, " 5524 (propertize "p" 'face 'markdown-bold-face) "review, " 5525 (propertize "o" 'face 'markdown-bold-face) "pen, " 5526 (propertize "e" 'face 'markdown-bold-face) "xport, " 5527 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " 5528 (propertize "c" 'face 'markdown-bold-face) "heck refs, " 5529 (propertize "u" 'face 'markdown-bold-face) "nused refs, " 5530 "C-h = more"))) 5531 5532 (defvar markdown-mode-style-map 5533 (let ((map (make-keymap (markdown--style-map-prompt)))) 5534 (define-key map (kbd "1") 'markdown-insert-header-atx-1) 5535 (define-key map (kbd "2") 'markdown-insert-header-atx-2) 5536 (define-key map (kbd "3") 'markdown-insert-header-atx-3) 5537 (define-key map (kbd "4") 'markdown-insert-header-atx-4) 5538 (define-key map (kbd "5") 'markdown-insert-header-atx-5) 5539 (define-key map (kbd "6") 'markdown-insert-header-atx-6) 5540 (define-key map (kbd "!") 'markdown-insert-header-setext-1) 5541 (define-key map (kbd "@") 'markdown-insert-header-setext-2) 5542 (define-key map (kbd "b") 'markdown-insert-bold) 5543 (define-key map (kbd "c") 'markdown-insert-code) 5544 (define-key map (kbd "C") 'markdown-insert-gfm-code-block) 5545 (define-key map (kbd "f") 'markdown-insert-footnote) 5546 (define-key map (kbd "F") 'markdown-insert-foldable-block) 5547 (define-key map (kbd "h") 'markdown-insert-header-dwim) 5548 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) 5549 (define-key map (kbd "i") 'markdown-insert-italic) 5550 (define-key map (kbd "k") 'markdown-insert-kbd) 5551 (define-key map (kbd "l") 'markdown-insert-link) 5552 (define-key map (kbd "p") 'markdown-insert-pre) 5553 (define-key map (kbd "P") 'markdown-pre-region) 5554 (define-key map (kbd "q") 'markdown-insert-blockquote) 5555 (define-key map (kbd "s") 'markdown-insert-strike-through) 5556 (define-key map (kbd "t") 'markdown-insert-table) 5557 (define-key map (kbd "Q") 'markdown-blockquote-region) 5558 (define-key map (kbd "w") 'markdown-insert-wiki-link) 5559 (define-key map (kbd "-") 'markdown-insert-hr) 5560 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) 5561 ;; Deprecated keys that may be removed in a future version 5562 (define-key map (kbd "e") 'markdown-insert-italic) 5563 map) 5564 "Keymap for Markdown text styling commands.") 5565 5566 (defvar markdown-mode-command-map 5567 (let ((map (make-keymap (markdown--command-map-prompt)))) 5568 (define-key map (kbd "m") 'markdown-other-window) 5569 (define-key map (kbd "p") 'markdown-preview) 5570 (define-key map (kbd "e") 'markdown-export) 5571 (define-key map (kbd "v") 'markdown-export-and-preview) 5572 (define-key map (kbd "o") 'markdown-open) 5573 (define-key map (kbd "l") 'markdown-live-preview-mode) 5574 (define-key map (kbd "w") 'markdown-kill-ring-save) 5575 (define-key map (kbd "c") 'markdown-check-refs) 5576 (define-key map (kbd "u") 'markdown-unused-refs) 5577 (define-key map (kbd "n") 'markdown-cleanup-list-numbers) 5578 (define-key map (kbd "]") 'markdown-complete-buffer) 5579 (define-key map (kbd "^") 'markdown-table-sort-lines) 5580 (define-key map (kbd "|") 'markdown-table-convert-region) 5581 (define-key map (kbd "t") 'markdown-table-transpose) 5582 map) 5583 "Keymap for Markdown buffer-wide commands.") 5584 5585 (defvar markdown-mode-map 5586 (let ((map (make-keymap))) 5587 ;; Markup insertion & removal 5588 (define-key map (kbd "C-c C-s") markdown-mode-style-map) 5589 (define-key map (kbd "C-c C-l") 'markdown-insert-link) 5590 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) 5591 ;; Promotion, demotion, and cycling 5592 (define-key map (kbd "C-c C--") 'markdown-promote) 5593 (define-key map (kbd "C-c C-=") 'markdown-demote) 5594 (define-key map (kbd "C-c C-]") 'markdown-complete) 5595 ;; Following and doing things 5596 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) 5597 (define-key map (kbd "C-c C-d") 'markdown-do) 5598 (define-key map (kbd "C-c '") 'markdown-edit-code-block) 5599 ;; Indentation 5600 (define-key map (kbd "RET") 'markdown-enter-key) 5601 (define-key map (kbd "DEL") 'markdown-outdent-or-delete) 5602 (define-key map (kbd "C-c >") 'markdown-indent-region) 5603 (define-key map (kbd "C-c <") 'markdown-outdent-region) 5604 ;; Visibility cycling 5605 (define-key map (kbd "TAB") 'markdown-cycle) 5606 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by 5607 ;; (local-)function-key-map. 5608 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) 5609 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) 5610 (define-key map (kbd "<backtab>") 'markdown-shifttab) 5611 ;; Heading and list navigation 5612 (define-key map (kbd "C-c C-n") 'markdown-outline-next) 5613 (define-key map (kbd "C-c C-p") 'markdown-outline-previous) 5614 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) 5615 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) 5616 (define-key map (kbd "C-c C-u") 'markdown-outline-up) 5617 ;; Buffer-wide commands 5618 (define-key map (kbd "C-c C-c") markdown-mode-command-map) 5619 ;; Subtree, list, and table editing 5620 (define-key map (kbd "C-c <up>") 'markdown-move-up) 5621 (define-key map (kbd "C-c <down>") 'markdown-move-down) 5622 (define-key map (kbd "C-c <left>") 'markdown-promote) 5623 (define-key map (kbd "C-c <right>") 'markdown-demote) 5624 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) 5625 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) 5626 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) 5627 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) 5628 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) 5629 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) 5630 (define-key map (kbd "M-RET") 'markdown-insert-list-item) 5631 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) 5632 ;; Lines 5633 (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) 5634 (define-key map [remap move-end-of-line] 'markdown-end-of-line) 5635 ;; Paragraphs (Markdown context aware) 5636 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) 5637 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) 5638 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) 5639 ;; Blocks (one or more paragraphs) 5640 (define-key map (kbd "C-M-{") 'markdown-backward-block) 5641 (define-key map (kbd "C-M-}") 'markdown-forward-block) 5642 (define-key map (kbd "C-c M-h") 'markdown-mark-block) 5643 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) 5644 ;; Pages (top-level sections) 5645 (define-key map [remap backward-page] 'markdown-backward-page) 5646 (define-key map [remap forward-page] 'markdown-forward-page) 5647 (define-key map [remap mark-page] 'markdown-mark-page) 5648 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) 5649 ;; Link Movement 5650 (define-key map (kbd "M-n") 'markdown-next-link) 5651 (define-key map (kbd "M-p") 'markdown-previous-link) 5652 ;; Toggling functionality 5653 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) 5654 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) 5655 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) 5656 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) 5657 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) 5658 ;; Alternative keys (in case of problems with the arrow keys) 5659 (define-key map (kbd "C-c C-x u") 'markdown-move-up) 5660 (define-key map (kbd "C-c C-x d") 'markdown-move-down) 5661 (define-key map (kbd "C-c C-x l") 'markdown-promote) 5662 (define-key map (kbd "C-c C-x r") 'markdown-demote) 5663 ;; Deprecated keys that may be removed in a future version 5664 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l 5665 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l 5666 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l 5667 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l 5668 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) 5669 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) 5670 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) 5671 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) 5672 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) 5673 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) 5674 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) 5675 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) 5676 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) 5677 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) 5678 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) 5679 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) 5680 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) 5681 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) 5682 (define-key map (kbd "C-c C-i") 'markdown-insert-image) 5683 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j 5684 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d 5685 (define-key map (kbd "C-c -") 'markdown-insert-hr) 5686 map) 5687 "Keymap for Markdown major mode.") 5688 5689 (defvar markdown-mode-mouse-map 5690 (when markdown-mouse-follow-link 5691 (let ((map (make-sparse-keymap))) 5692 (define-key map [follow-link] 'mouse-face) 5693 (define-key map [mouse-2] #'markdown-follow-thing-at-point) 5694 map)) 5695 "Keymap for following links with mouse.") 5696 5697 (defvar gfm-mode-map 5698 (let ((map (make-sparse-keymap))) 5699 (set-keymap-parent map markdown-mode-map) 5700 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) 5701 (define-key map "`" 'markdown-electric-backquote) 5702 map) 5703 "Keymap for `gfm-mode'. 5704 See also `markdown-mode-map'.") 5705 5706 5707 ;;; Menu ====================================================================== 5708 5709 (easy-menu-define markdown-mode-menu markdown-mode-map 5710 "Menu for Markdown mode." 5711 '("Markdown" 5712 "---" 5713 ("Movement" 5714 ["Jump" markdown-do] 5715 ["Follow Link" markdown-follow-thing-at-point] 5716 ["Next Link" markdown-next-link] 5717 ["Previous Link" markdown-previous-link] 5718 "---" 5719 ["Next Heading or List Item" markdown-outline-next] 5720 ["Previous Heading or List Item" markdown-outline-previous] 5721 ["Next at Same Level" markdown-outline-next-same-level] 5722 ["Previous at Same Level" markdown-outline-previous-same-level] 5723 ["Up to Parent" markdown-outline-up] 5724 "---" 5725 ["Forward Paragraph" markdown-forward-paragraph] 5726 ["Backward Paragraph" markdown-backward-paragraph] 5727 ["Forward Block" markdown-forward-block] 5728 ["Backward Block" markdown-backward-block]) 5729 ("Show & Hide" 5730 ["Cycle Heading Visibility" markdown-cycle 5731 :enable (markdown-on-heading-p)] 5732 ["Cycle Heading Visibility (Global)" markdown-shifttab] 5733 "---" 5734 ["Narrow to Region" narrow-to-region] 5735 ["Narrow to Block" markdown-narrow-to-block] 5736 ["Narrow to Section" narrow-to-defun] 5737 ["Narrow to Subtree" markdown-narrow-to-subtree] 5738 ["Widen" widen (buffer-narrowed-p)] 5739 "---" 5740 ["Toggle Markup Hiding" markdown-toggle-markup-hiding 5741 :keys "C-c C-x C-m" 5742 :style radio 5743 :selected markdown-hide-markup]) 5744 "---" 5745 ("Headings & Structure" 5746 ["Automatic Heading" markdown-insert-header-dwim 5747 :keys "C-c C-s h"] 5748 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim 5749 :keys "C-c C-s H"] 5750 ("Specific Heading (atx)" 5751 ["First Level atx" markdown-insert-header-atx-1 5752 :keys "C-c C-s 1"] 5753 ["Second Level atx" markdown-insert-header-atx-2 5754 :keys "C-c C-s 2"] 5755 ["Third Level atx" markdown-insert-header-atx-3 5756 :keys "C-c C-s 3"] 5757 ["Fourth Level atx" markdown-insert-header-atx-4 5758 :keys "C-c C-s 4"] 5759 ["Fifth Level atx" markdown-insert-header-atx-5 5760 :keys "C-c C-s 5"] 5761 ["Sixth Level atx" markdown-insert-header-atx-6 5762 :keys "C-c C-s 6"]) 5763 ("Specific Heading (Setext)" 5764 ["First Level Setext" markdown-insert-header-setext-1 5765 :keys "C-c C-s !"] 5766 ["Second Level Setext" markdown-insert-header-setext-2 5767 :keys "C-c C-s @"]) 5768 ["Horizontal Rule" markdown-insert-hr 5769 :keys "C-c C-s -"] 5770 "---" 5771 ["Move Subtree Up" markdown-move-up 5772 :keys "C-c <up>"] 5773 ["Move Subtree Down" markdown-move-down 5774 :keys "C-c <down>"] 5775 ["Promote Subtree" markdown-promote 5776 :keys "C-c <left>"] 5777 ["Demote Subtree" markdown-demote 5778 :keys "C-c <right>"]) 5779 ("Region & Mark" 5780 ["Indent Region" markdown-indent-region] 5781 ["Outdent Region" markdown-outdent-region] 5782 "--" 5783 ["Mark Paragraph" mark-paragraph] 5784 ["Mark Block" markdown-mark-block] 5785 ["Mark Section" mark-defun] 5786 ["Mark Subtree" markdown-mark-subtree]) 5787 ("Tables" 5788 ["Move Row Up" markdown-move-up 5789 :enable (markdown-table-at-point-p) 5790 :keys "C-c <up>"] 5791 ["Move Row Down" markdown-move-down 5792 :enable (markdown-table-at-point-p) 5793 :keys "C-c <down>"] 5794 ["Move Column Left" markdown-promote 5795 :enable (markdown-table-at-point-p) 5796 :keys "C-c <left>"] 5797 ["Move Column Right" markdown-demote 5798 :enable (markdown-table-at-point-p) 5799 :keys "C-c <right>"] 5800 ["Delete Row" markdown-table-delete-row 5801 :enable (markdown-table-at-point-p)] 5802 ["Insert Row" markdown-table-insert-row 5803 :enable (markdown-table-at-point-p)] 5804 ["Delete Column" markdown-table-delete-column 5805 :enable (markdown-table-at-point-p)] 5806 ["Insert Column" markdown-table-insert-column 5807 :enable (markdown-table-at-point-p)] 5808 ["Insert Table" markdown-insert-table] 5809 "--" 5810 ["Convert Region to Table" markdown-table-convert-region] 5811 ["Sort Table Lines" markdown-table-sort-lines 5812 :enable (markdown-table-at-point-p)] 5813 ["Transpose Table" markdown-table-transpose 5814 :enable (markdown-table-at-point-p)]) 5815 ("Lists" 5816 ["Insert List Item" markdown-insert-list-item] 5817 ["Move Subtree Up" markdown-move-up 5818 :keys "C-c <up>"] 5819 ["Move Subtree Down" markdown-move-down 5820 :keys "C-c <down>"] 5821 ["Indent Subtree" markdown-demote 5822 :keys "C-c <right>"] 5823 ["Outdent Subtree" markdown-promote 5824 :keys "C-c <left>"] 5825 ["Renumber List" markdown-cleanup-list-numbers] 5826 ["Insert Task List Item" markdown-insert-gfm-checkbox 5827 :keys "C-c C-x ["] 5828 ["Toggle Task List Item" markdown-toggle-gfm-checkbox 5829 :enable (markdown-gfm-task-list-item-at-point) 5830 :keys "C-c C-d"]) 5831 ("Links & Images" 5832 ["Insert Link" markdown-insert-link] 5833 ["Insert Image" markdown-insert-image] 5834 ["Insert Footnote" markdown-insert-footnote 5835 :keys "C-c C-s f"] 5836 ["Insert Wiki Link" markdown-insert-wiki-link 5837 :keys "C-c C-s w"] 5838 "---" 5839 ["Check References" markdown-check-refs] 5840 ["Find Unused References" markdown-unused-refs] 5841 ["Toggle URL Hiding" markdown-toggle-url-hiding 5842 :style radio 5843 :selected markdown-hide-urls] 5844 ["Toggle Inline Images" markdown-toggle-inline-images 5845 :keys "C-c C-x C-i" 5846 :style radio 5847 :selected markdown-inline-image-overlays] 5848 ["Toggle Wiki Links" markdown-toggle-wiki-links 5849 :style radio 5850 :selected markdown-enable-wiki-links]) 5851 ("Styles" 5852 ["Bold" markdown-insert-bold] 5853 ["Italic" markdown-insert-italic] 5854 ["Code" markdown-insert-code] 5855 ["Strikethrough" markdown-insert-strike-through] 5856 ["Keyboard" markdown-insert-kbd] 5857 "---" 5858 ["Blockquote" markdown-insert-blockquote] 5859 ["Preformatted" markdown-insert-pre] 5860 ["GFM Code Block" markdown-insert-gfm-code-block] 5861 ["Edit Code Block" markdown-edit-code-block 5862 :enable (markdown-code-block-at-point-p)] 5863 ["Foldable Block" markdown-insert-foldable-block] 5864 "---" 5865 ["Blockquote Region" markdown-blockquote-region] 5866 ["Preformatted Region" markdown-pre-region] 5867 "---" 5868 ["Fontify Code Blocks Natively" 5869 markdown-toggle-fontify-code-blocks-natively 5870 :style radio 5871 :selected markdown-fontify-code-blocks-natively] 5872 ["LaTeX Math Support" markdown-toggle-math 5873 :style radio 5874 :selected markdown-enable-math]) 5875 "---" 5876 ("Preview & Export" 5877 ["Compile" markdown-other-window] 5878 ["Preview" markdown-preview] 5879 ["Export" markdown-export] 5880 ["Export & View" markdown-export-and-preview] 5881 ["Open" markdown-open] 5882 ["Live Export" markdown-live-preview-mode 5883 :style radio 5884 :selected markdown-live-preview-mode] 5885 ["Kill ring save" markdown-kill-ring-save]) 5886 ("Markup Completion and Cycling" 5887 ["Complete Markup" markdown-complete] 5888 ["Promote Element" markdown-promote 5889 :keys "C-c C--"] 5890 ["Demote Element" markdown-demote 5891 :keys "C-c C-="]) 5892 "---" 5893 ["Kill Element" markdown-kill-thing-at-point] 5894 "---" 5895 ("Documentation" 5896 ["Version" markdown-show-version] 5897 ["Homepage" markdown-mode-info] 5898 ["Describe Mode" (describe-function 'markdown-mode)] 5899 ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) 5900 5901 5902 ;;; imenu ===================================================================== 5903 5904 (defun markdown-imenu-create-nested-index () 5905 "Create and return a nested imenu index alist for the current buffer. 5906 See `imenu-create-index-function' and `imenu--index-alist' for details." 5907 (let* ((root (list nil)) 5908 (min-level 9999) 5909 hashes headers) 5910 (save-excursion 5911 ;; Headings 5912 (goto-char (point-min)) 5913 (while (re-search-forward markdown-regex-header (point-max) t) 5914 (unless (or (markdown-code-block-at-point-p) 5915 (and (match-beginning 3) 5916 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) 5917 (cond 5918 ((match-string-no-properties 2) ;; level 1 setext 5919 (setq min-level 1) 5920 (push (list :heading (match-string-no-properties 1) 5921 :point (match-beginning 1) 5922 :level 1) headers)) 5923 ((match-string-no-properties 3) ;; level 2 setext 5924 (setq min-level (min min-level 2)) 5925 (push (list :heading (match-string-no-properties 1) 5926 :point (match-beginning 1) 5927 :level (- 2 (1- min-level))) headers)) 5928 ((setq hashes (markdown-trim-whitespace 5929 (match-string-no-properties 4))) 5930 (setq min-level (min min-level (length hashes))) 5931 (push (list :heading (match-string-no-properties 5) 5932 :point (match-beginning 4) 5933 :level (- (length hashes) (1- min-level))) headers))))) 5934 (cl-loop with cur-level = 0 5935 with cur-alist = nil 5936 with empty-heading = "-" 5937 with self-heading = "." 5938 for header in (reverse headers) 5939 for level = (plist-get header :level) 5940 do 5941 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) 5942 (cond 5943 ((= cur-level level) ; new sibling 5944 (setcdr cur-alist alist) 5945 (setq cur-alist alist)) 5946 ((< cur-level level) ; first child 5947 (dotimes (_ (- level cur-level 1)) 5948 (setq alist (list (cons empty-heading alist)))) 5949 (if cur-alist 5950 (let* ((parent (car cur-alist)) 5951 (self-pos (cdr parent))) 5952 (setcdr parent (cons (cons self-heading self-pos) alist))) 5953 (setcdr root alist)) ; primogenitor 5954 (setq cur-alist alist) 5955 (setq cur-level level)) 5956 (t ; new sibling of an ancestor 5957 (let ((sibling-alist (last (cdr root)))) 5958 (dotimes (_ (1- level)) 5959 (setq sibling-alist (last (cdar sibling-alist)))) 5960 (setcdr sibling-alist alist) 5961 (setq cur-alist alist)) 5962 (setq cur-level level))))) 5963 (setq root (copy-tree root)) 5964 ;; Footnotes 5965 (let ((fn (markdown-get-defined-footnotes))) 5966 (if (or (zerop (length fn)) 5967 (null markdown-add-footnotes-to-imenu)) 5968 (cdr root) 5969 (nconc (cdr root) (list (cons "Footnotes" fn)))))))) 5970 5971 (defun markdown-imenu-create-flat-index () 5972 "Create and return a flat imenu index alist for the current buffer. 5973 See `imenu-create-index-function' and `imenu--index-alist' for details." 5974 (let* ((empty-heading "-") index heading pos) 5975 (save-excursion 5976 ;; Headings 5977 (goto-char (point-min)) 5978 (while (re-search-forward markdown-regex-header (point-max) t) 5979 (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) 5980 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) 5981 (cond 5982 ((setq heading (match-string-no-properties 1)) 5983 (setq pos (match-beginning 1))) 5984 ((setq heading (match-string-no-properties 5)) 5985 (setq pos (match-beginning 4)))) 5986 (or (> (length heading) 0) 5987 (setq heading empty-heading)) 5988 (setq index (append index (list (cons heading pos)))))) 5989 ;; Footnotes 5990 (when markdown-add-footnotes-to-imenu 5991 (nconc index (markdown-get-defined-footnotes))) 5992 index))) 5993 5994 5995 ;;; References ================================================================ 5996 5997 (defun markdown-reference-goto-definition () 5998 "Jump to the definition of the reference at point or create it." 5999 (interactive) 6000 (when (thing-at-point-looking-at markdown-regex-link-reference) 6001 (let* ((text (match-string-no-properties 3)) 6002 (reference (match-string-no-properties 6)) 6003 (target (downcase (if (string= reference "") text reference))) 6004 (loc (cadr (save-match-data (markdown-reference-definition target))))) 6005 (if loc 6006 (goto-char loc) 6007 (goto-char (match-beginning 0)) 6008 (markdown-insert-reference-definition target))))) 6009 6010 (defun markdown-reference-find-links (reference) 6011 "Return a list of all links for REFERENCE. 6012 REFERENCE should not include the surrounding square brackets. 6013 Elements of the list have the form (text start line), where 6014 text is the link text, start is the location at the beginning of 6015 the link, and line is the line number on which the link appears." 6016 (let* ((ref-quote (regexp-quote reference)) 6017 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" 6018 ref-quote ref-quote)) 6019 links) 6020 (save-excursion 6021 (goto-char (point-min)) 6022 (while (re-search-forward regexp nil t) 6023 (let* ((text (or (match-string-no-properties 1) 6024 (match-string-no-properties 2))) 6025 (start (match-beginning 0)) 6026 (line (markdown-line-number-at-pos))) 6027 (cl-pushnew (list text start line) links :test #'equal)))) 6028 links)) 6029 6030 (defmacro markdown-for-all-refs (f) 6031 `(let ((result)) 6032 (save-excursion 6033 (goto-char (point-min)) 6034 (while 6035 (re-search-forward markdown-regex-link-reference nil t) 6036 (let* ((text (match-string-no-properties 3)) 6037 (reference (match-string-no-properties 6)) 6038 (target (downcase (if (string= reference "") text reference)))) 6039 (,f text target result)))) 6040 (reverse result))) 6041 6042 (defmacro markdown-collect-always (_ target result) 6043 `(cl-pushnew ,target ,result :test #'equal)) 6044 6045 (defmacro markdown-collect-undefined (text target result) 6046 `(unless (markdown-reference-definition target) 6047 (let ((entry (assoc ,target ,result))) 6048 (if (not entry) 6049 (cl-pushnew 6050 (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) 6051 ,result :test #'equal) 6052 (setcdr entry 6053 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) 6054 6055 (defun markdown-get-all-refs () 6056 "Return a list of all Markdown references." 6057 (markdown-for-all-refs markdown-collect-always)) 6058 6059 (defun markdown-get-undefined-refs () 6060 "Return a list of undefined Markdown references. 6061 Result is an alist of pairs (reference . occurrences), where 6062 occurrences is itself another alist of pairs (label . line-number). 6063 For example, an alist corresponding to [Nice editor][Emacs] at line 12, 6064 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is 6065 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." 6066 (markdown-for-all-refs markdown-collect-undefined)) 6067 6068 (defun markdown-get-unused-refs () 6069 (cl-sort 6070 (cl-set-difference 6071 (markdown-get-defined-references) (markdown-get-all-refs) 6072 :test (lambda (e1 e2) (equal (car e1) e2))) 6073 #'< :key #'cdr)) 6074 6075 (defmacro defun-markdown-buffer (name docstring) 6076 "Define a function to name and return a buffer. 6077 6078 By convention, NAME must be a name of a string constant with 6079 %buffer% placeholder used to name the buffer, and will also be 6080 used as a name of the function defined. 6081 6082 DOCSTRING will be used as the first part of the docstring." 6083 `(defun ,name (&optional buffer-name) 6084 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") 6085 (or buffer-name (setq buffer-name (buffer-name))) 6086 (let ((refbuf (get-buffer-create (replace-regexp-in-string 6087 "%buffer%" buffer-name 6088 ,name)))) 6089 (with-current-buffer refbuf 6090 (when view-mode 6091 (View-exit-and-edit)) 6092 (use-local-map button-buffer-map) 6093 (erase-buffer)) 6094 refbuf))) 6095 6096 (defconst markdown-reference-check-buffer 6097 "*Undefined references for %buffer%*" 6098 "Pattern for name of buffer for listing undefined references. 6099 The string %buffer% will be replaced by the corresponding 6100 `markdown-mode' buffer name.") 6101 6102 (defun-markdown-buffer 6103 markdown-reference-check-buffer 6104 "Name and return buffer for reference checking.") 6105 6106 (defconst markdown-unused-references-buffer 6107 "*Unused references for %buffer%*" 6108 "Pattern for name of buffer for listing unused references. 6109 The string %buffer% will be replaced by the corresponding 6110 `markdown-mode' buffer name.") 6111 6112 (defun-markdown-buffer 6113 markdown-unused-references-buffer 6114 "Name and return buffer for unused reference checking.") 6115 6116 (defconst markdown-reference-links-buffer 6117 "*Reference links for %buffer%*" 6118 "Pattern for name of buffer for listing references. 6119 The string %buffer% will be replaced by the corresponding buffer name.") 6120 6121 (defun-markdown-buffer 6122 markdown-reference-links-buffer 6123 "Name, setup, and return a buffer for listing links.") 6124 6125 ;; Add an empty Markdown reference definition to buffer 6126 ;; specified in the 'target-buffer property. The reference name is 6127 ;; the button's label. 6128 (define-button-type 'markdown-undefined-reference-button 6129 'help-echo "mouse-1, RET: create definition for undefined reference" 6130 'follow-link t 6131 'face 'bold 6132 'action (lambda (b) 6133 (let ((buffer (button-get b 'target-buffer)) 6134 (line (button-get b 'target-line)) 6135 (label (button-label b))) 6136 (switch-to-buffer-other-window buffer) 6137 (goto-char (point-min)) 6138 (forward-line line) 6139 (markdown-insert-reference-definition label) 6140 (markdown-check-refs t)))) 6141 6142 ;; Jump to line in buffer specified by 'target-buffer property. 6143 ;; Line number is button's 'target-line property. 6144 (define-button-type 'markdown-goto-line-button 6145 'help-echo "mouse-1, RET: go to line" 6146 'follow-link t 6147 'face 'italic 6148 'action (lambda (b) 6149 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6150 ;; use call-interactively to silence compiler 6151 (let ((current-prefix-arg (button-get b 'target-line))) 6152 (call-interactively 'goto-line)))) 6153 6154 ;; Kill a line in buffer specified by 'target-buffer property. 6155 ;; Line number is button's 'target-line property. 6156 (define-button-type 'markdown-kill-line-button 6157 'help-echo "mouse-1, RET: kill line" 6158 'follow-link t 6159 'face 'italic 6160 'action (lambda (b) 6161 (switch-to-buffer-other-window (button-get b 'target-buffer)) 6162 ;; use call-interactively to silence compiler 6163 (let ((current-prefix-arg (button-get b 'target-line))) 6164 (call-interactively 'goto-line)) 6165 (kill-line 1) 6166 (markdown-unused-refs t))) 6167 6168 ;; Jumps to a particular link at location given by 'target-char 6169 ;; property in buffer given by 'target-buffer property. 6170 (define-button-type 'markdown-location-button 6171 'help-echo "mouse-1, RET: jump to location of link" 6172 'follow-link t 6173 'face 'bold 6174 'action (lambda (b) 6175 (let ((target (button-get b 'target-buffer)) 6176 (loc (button-get b 'target-char))) 6177 (kill-buffer-and-window) 6178 (switch-to-buffer target) 6179 (goto-char loc)))) 6180 6181 (defun markdown-insert-undefined-reference-button (reference oldbuf) 6182 "Insert a button for creating REFERENCE in buffer OLDBUF. 6183 REFERENCE should be a list of the form (reference . occurrences), 6184 as returned by `markdown-get-undefined-refs'." 6185 (let ((label (car reference))) 6186 ;; Create a reference button 6187 (insert-button label 6188 :type 'markdown-undefined-reference-button 6189 'target-buffer oldbuf 6190 'target-line (cdr (car (cdr reference)))) 6191 (insert " (") 6192 (dolist (occurrence (cdr reference)) 6193 (let ((line (cdr occurrence))) 6194 ;; Create a line number button 6195 (insert-button (number-to-string line) 6196 :type 'markdown-goto-line-button 6197 'target-buffer oldbuf 6198 'target-line line) 6199 (insert " "))) 6200 (delete-char -1) 6201 (insert ")") 6202 (newline))) 6203 6204 (defun markdown-insert-unused-reference-button (reference oldbuf) 6205 "Insert a button for creating REFERENCE in buffer OLDBUF. 6206 REFERENCE must be a pair of (ref . line-number)." 6207 (let ((label (car reference)) 6208 (line (cdr reference))) 6209 ;; Create a reference button 6210 (insert-button label 6211 :type 'markdown-goto-line-button 6212 'face 'bold 6213 'target-buffer oldbuf 6214 'target-line line) 6215 (insert (format " (%d) [" line)) 6216 (insert-button "X" 6217 :type 'markdown-kill-line-button 6218 'face 'bold 6219 'target-buffer oldbuf 6220 'target-line line) 6221 (insert "]") 6222 (newline))) 6223 6224 (defun markdown-insert-link-button (link oldbuf) 6225 "Insert a button for jumping to LINK in buffer OLDBUF. 6226 LINK should be a list of the form (text char line) containing 6227 the link text, location, and line number." 6228 (let ((label (cl-first link)) 6229 (char (cl-second link)) 6230 (line (cl-third link))) 6231 ;; Create a reference button 6232 (insert-button label 6233 :type 'markdown-location-button 6234 'target-buffer oldbuf 6235 'target-char char) 6236 (insert (format " (line %d)\n" line)))) 6237 6238 (defun markdown-reference-goto-link (&optional reference) 6239 "Jump to the location of the first use of REFERENCE." 6240 (interactive) 6241 (unless reference 6242 (if (thing-at-point-looking-at markdown-regex-reference-definition) 6243 (setq reference (match-string-no-properties 2)) 6244 (user-error "No reference definition at point"))) 6245 (let ((links (markdown-reference-find-links reference))) 6246 (cond ((= (length links) 1) 6247 (goto-char (cadr (car links)))) 6248 ((> (length links) 1) 6249 (let ((oldbuf (current-buffer)) 6250 (linkbuf (markdown-reference-links-buffer))) 6251 (with-current-buffer linkbuf 6252 (insert "Links using reference " reference ":\n\n") 6253 (dolist (link (reverse links)) 6254 (markdown-insert-link-button link oldbuf))) 6255 (view-buffer-other-window linkbuf) 6256 (goto-char (point-min)) 6257 (forward-line 2))) 6258 (t 6259 (error "No links for reference %s" reference))))) 6260 6261 (defmacro defun-markdown-ref-checker 6262 (name docstring checker-function buffer-function none-message buffer-header insert-reference) 6263 "Define a function NAME acting on result of CHECKER-FUNCTION. 6264 6265 DOCSTRING is used as a docstring for the defined function. 6266 6267 BUFFER-FUNCTION should name and return an auxiliary buffer to put 6268 results in. 6269 6270 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. 6271 6272 BUFFER-HEADER is put into the auxiliary buffer first, followed by 6273 calling INSERT-REFERENCE for each element in the list returned by 6274 CHECKER-FUNCTION." 6275 `(defun ,name (&optional silent) 6276 ,(concat 6277 docstring 6278 "\n\nIf SILENT is non-nil, do not message anything when no 6279 such references found.") 6280 (interactive "P") 6281 (unless (derived-mode-p 'markdown-mode) 6282 (user-error "Not available in current mode")) 6283 (let ((oldbuf (current-buffer)) 6284 (refs (,checker-function)) 6285 (refbuf (,buffer-function))) 6286 (if (null refs) 6287 (progn 6288 (when (not silent) 6289 (message ,none-message)) 6290 (kill-buffer refbuf)) 6291 (with-current-buffer refbuf 6292 (insert ,buffer-header) 6293 (dolist (ref refs) 6294 (,insert-reference ref oldbuf)) 6295 (view-buffer-other-window refbuf) 6296 (goto-char (point-min)) 6297 (forward-line 2)))))) 6298 6299 (defun-markdown-ref-checker 6300 markdown-check-refs 6301 "Show all undefined Markdown references in current `markdown-mode' buffer. 6302 6303 Links which have empty reference definitions are considered to be 6304 defined." 6305 markdown-get-undefined-refs 6306 markdown-reference-check-buffer 6307 "No undefined references found" 6308 "The following references are undefined:\n\n" 6309 markdown-insert-undefined-reference-button) 6310 6311 6312 (defun-markdown-ref-checker 6313 markdown-unused-refs 6314 "Show all unused Markdown references in current `markdown-mode' buffer." 6315 markdown-get-unused-refs 6316 markdown-unused-references-buffer 6317 "No unused references found" 6318 "The following references are unused:\n\n" 6319 markdown-insert-unused-reference-button) 6320 6321 6322 6323 ;;; Lists ===================================================================== 6324 6325 (defun markdown-insert-list-item (&optional arg) 6326 "Insert a new list item. 6327 If the point is inside unordered list, insert a bullet mark. If 6328 the point is inside ordered list, insert the next number followed 6329 by a period. Use the previous list item to determine the amount 6330 of whitespace to place before and after list markers. 6331 6332 With a \\[universal-argument] prefix (i.e., when ARG is (4)), 6333 decrease the indentation by one level. 6334 6335 With two \\[universal-argument] prefixes (i.e., when ARG is (16)), 6336 increase the indentation by one level." 6337 (interactive "p") 6338 (let (bounds cur-indent marker indent new-indent new-loc) 6339 (save-match-data 6340 ;; Look for a list item on current or previous non-blank line 6341 (save-excursion 6342 (while (and (not (setq bounds (markdown-cur-list-item-bounds))) 6343 (not (bobp)) 6344 (markdown-cur-line-blank-p)) 6345 (forward-line -1))) 6346 (when bounds 6347 (cond ((save-excursion 6348 (skip-chars-backward " \t") 6349 (looking-at-p markdown-regex-list)) 6350 (beginning-of-line) 6351 (insert "\n") 6352 (forward-line -1)) 6353 ((not (markdown-cur-line-blank-p)) 6354 (newline))) 6355 (setq new-loc (point))) 6356 ;; Look ahead for a list item on next non-blank line 6357 (unless bounds 6358 (save-excursion 6359 (while (and (null bounds) 6360 (not (eobp)) 6361 (markdown-cur-line-blank-p)) 6362 (forward-line) 6363 (setq bounds (markdown-cur-list-item-bounds)))) 6364 (when bounds 6365 (setq new-loc (point)) 6366 (unless (markdown-cur-line-blank-p) 6367 (newline)))) 6368 (if (not bounds) 6369 ;; When not in a list, start a new unordered one 6370 (progn 6371 (unless (markdown-cur-line-blank-p) 6372 (insert "\n")) 6373 (insert markdown-unordered-list-item-prefix)) 6374 ;; Compute indentation and marker for new list item 6375 (setq cur-indent (nth 2 bounds)) 6376 (setq marker (nth 4 bounds)) 6377 ;; If current item is a GFM checkbox, insert new unchecked checkbox. 6378 (when (nth 5 bounds) 6379 (setq marker 6380 (concat marker 6381 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) 6382 (cond 6383 ;; Dedent: decrement indentation, find previous marker. 6384 ((= arg 4) 6385 (setq indent (max (- cur-indent markdown-list-indent-width) 0)) 6386 (let ((prev-bounds 6387 (save-excursion 6388 (goto-char (nth 0 bounds)) 6389 (when (markdown-up-list) 6390 (markdown-cur-list-item-bounds))))) 6391 (when prev-bounds 6392 (setq marker (nth 4 prev-bounds))))) 6393 ;; Indent: increment indentation by 4, use same marker. 6394 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) 6395 ;; Same level: keep current indentation and marker. 6396 (t (setq indent cur-indent))) 6397 (setq new-indent (make-string indent 32)) 6398 (goto-char new-loc) 6399 (cond 6400 ;; Ordered list 6401 ((string-match-p "[0-9]" marker) 6402 (if (= arg 16) ;; starting a new column indented one more level 6403 (insert (concat new-indent "1. ")) 6404 ;; Don't use previous match-data 6405 (set-match-data nil) 6406 ;; travel up to the last item and pick the correct number. If 6407 ;; the argument was nil, "new-indent = cur-indent" is the same, 6408 ;; so we don't need special treatment. Neat. 6409 (save-excursion 6410 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) 6411 (>= (forward-line -1) 0)))) 6412 (let* ((old-prefix (match-string 1)) 6413 (old-spacing (match-string 2)) 6414 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) 6415 (int-to-string (1+ (string-to-number old-prefix))) 6416 "1")) 6417 (space-adjust (- (length old-prefix) (length new-prefix))) 6418 (new-spacing (if (and (match-string 2) 6419 (not (string-match-p "\t" old-spacing)) 6420 (< space-adjust 0) 6421 (> space-adjust (- 1 (length (match-string 2))))) 6422 (substring (match-string 2) 0 space-adjust) 6423 (or old-spacing ". ")))) 6424 (insert (concat new-indent new-prefix new-spacing))))) 6425 ;; Unordered list, GFM task list, or ordered list with hash mark 6426 ((string-match-p "[\\*\\+-]\\|#\\." marker) 6427 (insert new-indent marker)))) 6428 ;; Propertize the newly inserted list item now 6429 (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) 6430 6431 (defun markdown-move-list-item-up () 6432 "Move the current list item up in the list when possible. 6433 In nested lists, move child items with the parent item." 6434 (interactive) 6435 (let (cur prev old) 6436 (when (setq cur (markdown-cur-list-item-bounds)) 6437 (setq old (point)) 6438 (goto-char (nth 0 cur)) 6439 (if (markdown-prev-list-item (nth 3 cur)) 6440 (progn 6441 (setq prev (markdown-cur-list-item-bounds)) 6442 (condition-case nil 6443 (progn 6444 (transpose-regions (nth 0 prev) (nth 1 prev) 6445 (nth 0 cur) (nth 1 cur) t) 6446 (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) 6447 ;; Catch error in case regions overlap. 6448 (error (goto-char old)))) 6449 (goto-char old))))) 6450 6451 (defun markdown-move-list-item-down () 6452 "Move the current list item down in the list when possible. 6453 In nested lists, move child items with the parent item." 6454 (interactive) 6455 (let (cur next old) 6456 (when (setq cur (markdown-cur-list-item-bounds)) 6457 (setq old (point)) 6458 (if (markdown-next-list-item (nth 3 cur)) 6459 (progn 6460 (setq next (markdown-cur-list-item-bounds)) 6461 (condition-case nil 6462 (progn 6463 (transpose-regions (nth 0 cur) (nth 1 cur) 6464 (nth 0 next) (nth 1 next) nil) 6465 (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) 6466 ;; Catch error in case regions overlap. 6467 (error (goto-char old)))) 6468 (goto-char old))))) 6469 6470 (defun markdown-demote-list-item (&optional bounds) 6471 "Indent (or demote) the current list item. 6472 Optionally, BOUNDS of the current list item may be provided if available. 6473 In nested lists, demote child items as well." 6474 (interactive) 6475 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6476 (save-excursion 6477 (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) 6478 (item-end (set-marker (make-marker) (nth 1 bounds))) 6479 (list-start (progn (markdown-beginning-of-list) 6480 (set-marker (make-marker) (point)))) 6481 (list-end (progn (markdown-end-of-list) 6482 (set-marker (make-marker) (point))))) 6483 (goto-char item-start) 6484 (while (< (point) item-end) 6485 (unless (markdown-cur-line-blank-p) 6486 (insert (make-string markdown-list-indent-width ? ))) 6487 (forward-line)) 6488 (markdown-syntax-propertize-list-items list-start list-end))))) 6489 6490 (defun markdown-promote-list-item (&optional bounds) 6491 "Unindent (or promote) the current list item. 6492 Optionally, BOUNDS of the current list item may be provided if available. 6493 In nested lists, demote child items as well." 6494 (interactive) 6495 (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) 6496 (save-excursion 6497 (save-match-data 6498 (let ((item-start (set-marker (make-marker) (nth 0 bounds))) 6499 (item-end (set-marker (make-marker) (nth 1 bounds))) 6500 (list-start (progn (markdown-beginning-of-list) 6501 (set-marker (make-marker) (point)))) 6502 (list-end (progn (markdown-end-of-list) 6503 (set-marker (make-marker) (point)))) 6504 num regexp) 6505 (goto-char item-start) 6506 (when (looking-at (format "^[ ]\\{1,%d\\}" 6507 markdown-list-indent-width)) 6508 (setq num (- (match-end 0) (match-beginning 0))) 6509 (setq regexp (format "^[ ]\\{1,%d\\}" num)) 6510 (while (and (< (point) item-end) 6511 (re-search-forward regexp item-end t)) 6512 (replace-match "" nil nil) 6513 (forward-line)) 6514 (markdown-syntax-propertize-list-items list-start list-end))))))) 6515 6516 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) 6517 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. 6518 PREV-ITEM is width of previous-indentation and list number 6519 6520 Assume that the previously found match was for a numbered item in 6521 a list." 6522 (let ((cpfx pfx) 6523 (cur-item nil) 6524 (idx 0) 6525 (continue t) 6526 (step t) 6527 (sep nil)) 6528 (while (and continue (not (eobp))) 6529 (setq step t) 6530 (cond 6531 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") 6532 (setq cpfx (match-string-no-properties 2)) 6533 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker 6534 (cond 6535 ((or (= (length cpfx) (length pfx)) 6536 (= (length cur-item) (length prev-item))) 6537 (save-excursion 6538 (replace-match 6539 (if (not markdown-ordered-list-enumeration) 6540 (concat pfx "1. ") 6541 (cl-incf idx) 6542 (concat pfx (number-to-string idx) ". ")))) 6543 (setq sep nil)) 6544 ;; indented a level 6545 ((< (length pfx) (length cpfx)) 6546 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) 6547 (setq step nil)) 6548 ;; exit the loop 6549 (t 6550 (setq step nil) 6551 (setq continue nil)))) 6552 6553 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") 6554 (setq cpfx (match-string-no-properties 1)) 6555 (cond 6556 ;; reset if separated before 6557 ((string= cpfx pfx) (when sep (setq idx 0))) 6558 ((string< cpfx pfx) 6559 (setq step nil) 6560 (setq continue nil)))) 6561 (t (setq sep t))) 6562 6563 (when step 6564 (beginning-of-line) 6565 (setq continue (= (forward-line) 0)))) 6566 sep)) 6567 6568 (defun markdown-cleanup-list-numbers () 6569 "Update the numbering of ordered lists." 6570 (interactive) 6571 (save-excursion 6572 (goto-char (point-min)) 6573 (markdown-cleanup-list-numbers-level ""))) 6574 6575 6576 ;;; Movement ================================================================== 6577 6578 ;; This function was originally derived from `org-beginning-of-line' from org.el. 6579 (defun markdown-beginning-of-line (&optional n) 6580 "Go to the beginning of the current visible line. 6581 6582 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6583 or symbol `reversed', on the first attempt move to where the 6584 headline text hashes, and only move to beginning of line when the 6585 cursor is already before the hashes of the text of the headline. 6586 6587 If `markdown-special-ctrl-a/e' is symbol `reversed' then go to 6588 the hashes of the text on the second attempt. 6589 6590 With argument N not nil or 1, move forward N - 1 lines first." 6591 (interactive "^p") 6592 (let ((origin (point)) 6593 (special (pcase markdown-special-ctrl-a/e 6594 (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) 6595 deactivate-mark) 6596 ;; First move to a visible line. 6597 (if visual-line-mode 6598 (beginning-of-visual-line n) 6599 (move-beginning-of-line n) 6600 ;; `move-beginning-of-line' may leave point after invisible 6601 ;; characters if line starts with such of these (e.g., with 6602 ;; a link at column 0). Really move to the beginning of the 6603 ;; current visible line. 6604 (forward-line 0)) 6605 (cond 6606 ;; No special behavior. Point is already at the beginning of 6607 ;; a line, logical or visual. 6608 ((not special)) 6609 ;; `beginning-of-visual-line' left point before logical beginning 6610 ;; of line: point is at the beginning of a visual line. Bail 6611 ;; out. 6612 ((and visual-line-mode (not (bolp)))) 6613 ((looking-at markdown-regex-header-atx) 6614 ;; At a header, special position is before the title. 6615 (let ((refpos (match-beginning 2)) 6616 (bol (point))) 6617 (if (eq special 'reversed) 6618 (when (and (= origin bol) (eq last-command this-command)) 6619 (goto-char refpos)) 6620 (when (or (> origin refpos) (<= origin bol)) 6621 (goto-char refpos))) 6622 ;; Prevent automatic cursor movement caused by the command loop. 6623 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6624 (when (and markdown-hide-markup 6625 (equal (get-char-property (point) 'display) "")) 6626 (setq disable-point-adjustment t)))) 6627 ((looking-at markdown-regex-list) 6628 ;; At a list item, special position is after the list marker or checkbox. 6629 (let ((refpos (or (match-end 4) (match-end 3)))) 6630 (if (eq special 'reversed) 6631 (when (and (= (point) origin) (eq last-command this-command)) 6632 (goto-char refpos)) 6633 (when (or (> origin refpos) (<= origin (line-beginning-position))) 6634 (goto-char refpos))))) 6635 ;; No special case, already at beginning of line. 6636 (t nil)))) 6637 6638 ;; This function was originally derived from `org-end-of-line' from org.el. 6639 (defun markdown-end-of-line (&optional n) 6640 "Go to the end of the line, but before ellipsis, if any. 6641 6642 If this is a headline, and `markdown-special-ctrl-a/e' is not nil 6643 or symbol `reversed', ignore closing tags on the first attempt, 6644 and only move to after the closing tags when the cursor is 6645 already beyond the end of the headline. 6646 6647 If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore 6648 closing tags on the second attempt. 6649 6650 With argument N not nil or 1, move forward N - 1 lines first." 6651 (interactive "^p") 6652 (let ((origin (point)) 6653 (special (pcase markdown-special-ctrl-a/e 6654 (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) 6655 deactivate-mark) 6656 ;; First move to a visible line. 6657 (if visual-line-mode 6658 (beginning-of-visual-line n) 6659 (move-beginning-of-line n)) 6660 (cond 6661 ;; At a headline, with closing tags. 6662 ((save-excursion 6663 (forward-line 0) 6664 (and (looking-at markdown-regex-header-atx) (match-end 3))) 6665 (let ((refpos (match-end 2)) 6666 (visual-end (and visual-line-mode 6667 (save-excursion 6668 (end-of-visual-line) 6669 (point))))) 6670 ;; If `end-of-visual-line' brings us before end of line or even closing 6671 ;; tags, i.e., the headline spans over multiple visual lines, move 6672 ;; there. 6673 (cond ((and visual-end 6674 (< visual-end refpos) 6675 (<= origin visual-end)) 6676 (goto-char visual-end)) 6677 ((not special) (end-of-line)) 6678 ((eq special 'reversed) 6679 (if (and (= origin (line-end-position)) 6680 (eq this-command last-command)) 6681 (goto-char refpos) 6682 (end-of-line))) 6683 (t 6684 (if (or (< origin refpos) (>= origin (line-end-position))) 6685 (goto-char refpos) 6686 (end-of-line)))) 6687 ;; Prevent automatic cursor movement caused by the command loop. 6688 ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. 6689 (when (and markdown-hide-markup 6690 (equal (get-char-property (point) 'display) "")) 6691 (setq disable-point-adjustment t)))) 6692 (visual-line-mode 6693 (let ((bol (line-beginning-position))) 6694 (end-of-visual-line) 6695 ;; If `end-of-visual-line' gets us past the ellipsis at the 6696 ;; end of a line, backtrack and use `end-of-line' instead. 6697 (when (/= bol (line-beginning-position)) 6698 (goto-char bol) 6699 (end-of-line)))) 6700 (t (end-of-line))))) 6701 6702 (defun markdown-beginning-of-defun (&optional arg) 6703 "`beginning-of-defun-function' for Markdown. 6704 This is used to find the beginning of the defun and should behave 6705 like ‘beginning-of-defun’, returning non-nil if it found the 6706 beginning of a defun. It moves the point backward, right before a 6707 heading which defines a defun. When ARG is non-nil, repeat that 6708 many times. When ARG is negative, move forward to the ARG-th 6709 following section." 6710 (or arg (setq arg 1)) 6711 (when (< arg 0) (end-of-line)) 6712 ;; Adjust position for setext headings. 6713 (when (and (thing-at-point-looking-at markdown-regex-header-setext) 6714 (not (= (point) (match-beginning 0))) 6715 (not (markdown-code-block-at-point-p))) 6716 (goto-char (match-end 0))) 6717 (let (found) 6718 ;; Move backward with positive argument. 6719 (while (and (not (bobp)) (> arg 0)) 6720 (setq found nil) 6721 (while (and (not found) 6722 (not (bobp)) 6723 (re-search-backward markdown-regex-header nil 'move)) 6724 (markdown-code-block-at-pos (match-beginning 0)) 6725 (setq found (match-beginning 0))) 6726 (setq arg (1- arg))) 6727 ;; Move forward with negative argument. 6728 (while (and (not (eobp)) (< arg 0)) 6729 (setq found nil) 6730 (while (and (not found) 6731 (not (eobp)) 6732 (re-search-forward markdown-regex-header nil 'move)) 6733 (markdown-code-block-at-pos (match-beginning 0)) 6734 (setq found (match-beginning 0))) 6735 (setq arg (1+ arg))) 6736 (when found 6737 (beginning-of-line) 6738 t))) 6739 6740 (defun markdown-end-of-defun () 6741 "`end-of-defun-function’ for Markdown. 6742 This is used to find the end of the defun at point. 6743 It is called with no argument, right after calling ‘beginning-of-defun-raw’, 6744 so it can assume that point is at the beginning of the defun body. 6745 It should move point to the first position after the defun." 6746 (or (eobp) (forward-char 1)) 6747 (let (found) 6748 (while (and (not found) 6749 (not (eobp)) 6750 (re-search-forward markdown-regex-header nil 'move)) 6751 (when (not (markdown-code-block-at-pos (match-beginning 0))) 6752 (setq found (match-beginning 0)))) 6753 (when found 6754 (goto-char found) 6755 (skip-syntax-backward "-")))) 6756 6757 (defun markdown-beginning-of-text-block () 6758 "Move backward to previous beginning of a plain text block. 6759 This function simply looks for blank lines without considering 6760 the surrounding context in light of Markdown syntax. For that, see 6761 `markdown-backward-block'." 6762 (interactive) 6763 (let ((start (point))) 6764 (if (re-search-backward markdown-regex-block-separator nil t) 6765 (goto-char (match-end 0)) 6766 (goto-char (point-min))) 6767 (when (and (= start (point)) (not (bobp))) 6768 (forward-line -1) 6769 (if (re-search-backward markdown-regex-block-separator nil t) 6770 (goto-char (match-end 0)) 6771 (goto-char (point-min)))))) 6772 6773 (defun markdown-end-of-text-block () 6774 "Move forward to next beginning of a plain text block. 6775 This function simply looks for blank lines without considering 6776 the surrounding context in light of Markdown syntax. For that, see 6777 `markdown-forward-block'." 6778 (interactive) 6779 (beginning-of-line) 6780 (skip-chars-forward " \t\n") 6781 (when (= (point) (point-min)) 6782 (forward-char)) 6783 (if (re-search-forward markdown-regex-block-separator nil t) 6784 (goto-char (match-end 0)) 6785 (goto-char (point-max))) 6786 (skip-chars-backward " \t\n") 6787 (forward-line)) 6788 6789 (defun markdown-backward-paragraph (&optional arg) 6790 "Move the point to the start of the current paragraph. 6791 With argument ARG, do it ARG times; a negative argument ARG = -N 6792 means move forward N blocks." 6793 (interactive "^p") 6794 (or arg (setq arg 1)) 6795 (if (< arg 0) 6796 (markdown-forward-paragraph (- arg)) 6797 (dotimes (_ arg) 6798 ;; Skip over whitespace in between paragraphs when moving backward. 6799 (skip-chars-backward " \t\n") 6800 (beginning-of-line) 6801 ;; Skip over code block endings. 6802 (when (markdown-range-properties-exist 6803 (line-beginning-position) (line-end-position) 6804 '(markdown-gfm-block-end 6805 markdown-tilde-fence-end)) 6806 (forward-line -1)) 6807 ;; Skip over blank lines inside blockquotes. 6808 (while (and (not (eobp)) 6809 (looking-at markdown-regex-blockquote) 6810 (= (length (match-string 3)) 0)) 6811 (forward-line -1)) 6812 ;; Proceed forward based on the type of block of paragraph. 6813 (let (bounds skip) 6814 (cond 6815 ;; Blockquotes 6816 ((looking-at markdown-regex-blockquote) 6817 (while (and (not (bobp)) 6818 (looking-at markdown-regex-blockquote) 6819 (> (length (match-string 3)) 0)) ;; not blank 6820 (forward-line -1)) 6821 (forward-line)) 6822 ;; List items 6823 ((setq bounds (markdown-cur-list-item-bounds)) 6824 (goto-char (nth 0 bounds))) 6825 ;; Other 6826 (t 6827 (while (and (not (bobp)) 6828 (not skip) 6829 (not (markdown-cur-line-blank-p)) 6830 (not (looking-at markdown-regex-blockquote)) 6831 (not (markdown-range-properties-exist 6832 (line-beginning-position) (line-end-position) 6833 '(markdown-gfm-block-end 6834 markdown-tilde-fence-end)))) 6835 (setq skip (markdown-range-properties-exist 6836 (line-beginning-position) (line-end-position) 6837 '(markdown-gfm-block-begin 6838 markdown-tilde-fence-begin))) 6839 (forward-line -1)) 6840 (unless (bobp) 6841 (forward-line 1)))))))) 6842 6843 (defun markdown-forward-paragraph (&optional arg) 6844 "Move forward to the next end of a paragraph. 6845 With argument ARG, do it ARG times; a negative argument ARG = -N 6846 means move backward N blocks." 6847 (interactive "^p") 6848 (or arg (setq arg 1)) 6849 (if (< arg 0) 6850 (markdown-backward-paragraph (- arg)) 6851 (dotimes (_ arg) 6852 ;; Skip whitespace in between paragraphs. 6853 (when (markdown-cur-line-blank-p) 6854 (skip-syntax-forward "-") 6855 (beginning-of-line)) 6856 ;; Proceed forward based on the type of block. 6857 (let (bounds skip) 6858 (cond 6859 ;; Blockquotes 6860 ((looking-at markdown-regex-blockquote) 6861 ;; Skip over blank lines inside blockquotes. 6862 (while (and (not (eobp)) 6863 (looking-at markdown-regex-blockquote) 6864 (= (length (match-string 3)) 0)) 6865 (forward-line)) 6866 ;; Move to end of quoted text block 6867 (while (and (not (eobp)) 6868 (looking-at markdown-regex-blockquote) 6869 (> (length (match-string 3)) 0)) ;; not blank 6870 (forward-line))) 6871 ;; List items 6872 ((and (markdown-cur-list-item-bounds) 6873 (setq bounds (markdown-next-list-item-bounds))) 6874 (goto-char (nth 0 bounds))) 6875 ;; Other 6876 (t 6877 (forward-line) 6878 (while (and (not (eobp)) 6879 (not skip) 6880 (not (markdown-cur-line-blank-p)) 6881 (not (looking-at markdown-regex-blockquote)) 6882 (not (markdown-range-properties-exist 6883 (line-beginning-position) (line-end-position) 6884 '(markdown-gfm-block-begin 6885 markdown-tilde-fence-begin)))) 6886 (setq skip (markdown-range-properties-exist 6887 (line-beginning-position) (line-end-position) 6888 '(markdown-gfm-block-end 6889 markdown-tilde-fence-end))) 6890 (forward-line)))))))) 6891 6892 (defun markdown-backward-block (&optional arg) 6893 "Move the point to the start of the current Markdown block. 6894 Moves across complete code blocks, list items, and blockquotes, 6895 but otherwise stops at blank lines, headers, and horizontal 6896 rules. With argument ARG, do it ARG times; a negative argument 6897 ARG = -N means move forward N blocks." 6898 (interactive "^p") 6899 (or arg (setq arg 1)) 6900 (if (< arg 0) 6901 (markdown-forward-block (- arg)) 6902 (dotimes (_ arg) 6903 ;; Skip over whitespace in between blocks when moving backward, 6904 ;; unless at a block boundary with no whitespace. 6905 (skip-syntax-backward "-") 6906 (beginning-of-line) 6907 ;; Proceed forward based on the type of block. 6908 (cond 6909 ;; Code blocks 6910 ((and (markdown-code-block-at-pos (point)) ;; this line 6911 (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line 6912 (forward-line -1) 6913 (while (and (markdown-code-block-at-point-p) (not (bobp))) 6914 (forward-line -1)) 6915 (forward-line)) 6916 ;; Headings 6917 ((markdown-heading-at-point) 6918 (goto-char (match-beginning 0))) 6919 ;; Horizontal rules 6920 ((looking-at markdown-regex-hr)) 6921 ;; Blockquotes 6922 ((looking-at markdown-regex-blockquote) 6923 (forward-line -1) 6924 (while (and (looking-at markdown-regex-blockquote) 6925 (not (bobp))) 6926 (forward-line -1)) 6927 (forward-line)) 6928 ;; List items 6929 ((markdown-cur-list-item-bounds) 6930 (markdown-beginning-of-list)) 6931 ;; Other 6932 (t 6933 ;; Move forward in case it is a one line regular paragraph. 6934 (unless (markdown-next-line-blank-p) 6935 (forward-line)) 6936 (unless (markdown-prev-line-blank-p) 6937 (markdown-backward-paragraph))))))) 6938 6939 (defun markdown-forward-block (&optional arg) 6940 "Move forward to the next end of a Markdown block. 6941 Moves across complete code blocks, list items, and blockquotes, 6942 but otherwise stops at blank lines, headers, and horizontal 6943 rules. With argument ARG, do it ARG times; a negative argument 6944 ARG = -N means move backward N blocks." 6945 (interactive "^p") 6946 (or arg (setq arg 1)) 6947 (if (< arg 0) 6948 (markdown-backward-block (- arg)) 6949 (dotimes (_ arg) 6950 ;; Skip over whitespace in between blocks when moving forward. 6951 (if (markdown-cur-line-blank-p) 6952 (skip-syntax-forward "-") 6953 (beginning-of-line)) 6954 ;; Proceed forward based on the type of block. 6955 (cond 6956 ;; Code blocks 6957 ((markdown-code-block-at-point-p) 6958 (forward-line) 6959 (while (and (markdown-code-block-at-point-p) (not (eobp))) 6960 (forward-line))) 6961 ;; Headings 6962 ((looking-at markdown-regex-header) 6963 (goto-char (or (match-end 4) (match-end 2) (match-end 3))) 6964 (forward-line)) 6965 ;; Horizontal rules 6966 ((looking-at markdown-regex-hr) 6967 (forward-line)) 6968 ;; Blockquotes 6969 ((looking-at markdown-regex-blockquote) 6970 (forward-line) 6971 (while (and (looking-at markdown-regex-blockquote) (not (eobp))) 6972 (forward-line))) 6973 ;; List items 6974 ((markdown-cur-list-item-bounds) 6975 (markdown-end-of-list) 6976 (forward-line)) 6977 ;; Other 6978 (t (markdown-forward-paragraph)))) 6979 (skip-syntax-backward "-") 6980 (unless (eobp) 6981 (forward-char 1)))) 6982 6983 (defun markdown-backward-page (&optional count) 6984 "Move backward to boundary of the current toplevel section. 6985 With COUNT, repeat, or go forward if negative." 6986 (interactive "p") 6987 (or count (setq count 1)) 6988 (if (< count 0) 6989 (markdown-forward-page (- count)) 6990 (skip-syntax-backward "-") 6991 (or (markdown-back-to-heading-over-code-block t t) 6992 (goto-char (point-min))) 6993 (when (looking-at markdown-regex-header) 6994 (let ((level (markdown-outline-level))) 6995 (when (> level 1) (markdown-up-heading level)) 6996 (when (> count 1) 6997 (condition-case nil 6998 (markdown-backward-same-level (1- count)) 6999 (error (goto-char (point-min))))))))) 7000 7001 (defun markdown-forward-page (&optional count) 7002 "Move forward to boundary of the current toplevel section. 7003 With COUNT, repeat, or go backward if negative." 7004 (interactive "p") 7005 (or count (setq count 1)) 7006 (if (< count 0) 7007 (markdown-backward-page (- count)) 7008 (if (markdown-back-to-heading-over-code-block t t) 7009 (let ((level (markdown-outline-level))) 7010 (when (> level 1) (markdown-up-heading level)) 7011 (condition-case nil 7012 (markdown-forward-same-level count) 7013 (error (goto-char (point-max))))) 7014 (markdown-next-visible-heading 1)))) 7015 7016 (defun markdown-next-link () 7017 "Jump to next inline, reference, or wiki link. 7018 If successful, return point. Otherwise, return nil. 7019 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." 7020 (interactive) 7021 (let ((opoint (point))) 7022 (when (or (markdown-link-p) (markdown-wiki-link-p)) 7023 ;; At a link already, move past it. 7024 (goto-char (+ (match-end 0) 1))) 7025 ;; Search for the next wiki link and move to the beginning. 7026 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) 7027 (markdown-code-block-at-point-p) 7028 (< (point) (point-max)))) 7029 (if (and (not (eq (point) opoint)) 7030 (or (markdown-link-p) (markdown-wiki-link-p))) 7031 ;; Group 1 will move past non-escape character in wiki link regexp. 7032 ;; Go to beginning of group zero for all other link types. 7033 (goto-char (or (match-beginning 1) (match-beginning 0))) 7034 (goto-char opoint) 7035 nil))) 7036 7037 (defun markdown-previous-link () 7038 "Jump to previous wiki link. 7039 If successful, return point. Otherwise, return nil. 7040 See `markdown-wiki-link-p' and `markdown-next-wiki-link'." 7041 (interactive) 7042 (let ((opoint (point))) 7043 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) 7044 (markdown-code-block-at-point-p) 7045 (> (point) (point-min)))) 7046 (if (and (not (eq (point) opoint)) 7047 (or (markdown-link-p) (markdown-wiki-link-p))) 7048 (goto-char (or (match-beginning 1) (match-beginning 0))) 7049 (goto-char opoint) 7050 nil))) 7051 7052 7053 ;;; Outline =================================================================== 7054 7055 (defun markdown-move-heading-common (move-fn &optional arg adjust) 7056 "Wrapper for `outline-mode' functions to skip false positives. 7057 MOVE-FN is a function and ARG is its argument. For example, 7058 headings inside preformatted code blocks may match 7059 `outline-regexp' but should not be considered as headings. 7060 When ADJUST is non-nil, adjust the point for interactive calls 7061 to avoid leaving the point at invisible markup. This adjustment 7062 generally should only be done for interactive calls, since other 7063 functions may expect the point to be at the beginning of the 7064 regular expression." 7065 (let ((prev -1) (start (point))) 7066 (if arg (funcall move-fn arg) (funcall move-fn)) 7067 (while (and (/= prev (point)) (markdown-code-block-at-point-p)) 7068 (setq prev (point)) 7069 (if arg (funcall move-fn arg) (funcall move-fn))) 7070 ;; Adjust point for setext headings and invisible text. 7071 (save-match-data 7072 (when (and adjust (thing-at-point-looking-at markdown-regex-header)) 7073 (if markdown-hide-markup 7074 ;; Move to beginning of heading text if markup is hidden. 7075 (goto-char (or (match-beginning 1) (match-beginning 5))) 7076 ;; Move to beginning of markup otherwise. 7077 (goto-char (or (match-beginning 1) (match-beginning 4)))))) 7078 (if (= (point) start) nil (point)))) 7079 7080 (defun markdown-next-visible-heading (arg) 7081 "Move to the next visible heading line of any level. 7082 With argument, repeats or can move backward if negative. ARG is 7083 passed to `outline-next-visible-heading'." 7084 (interactive "p") 7085 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) 7086 7087 (defun markdown-previous-visible-heading (arg) 7088 "Move to the previous visible heading line of any level. 7089 With argument, repeats or can move backward if negative. ARG is 7090 passed to `outline-previous-visible-heading'." 7091 (interactive "p") 7092 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) 7093 7094 (defun markdown-next-heading () 7095 "Move to the next heading line of any level." 7096 (markdown-move-heading-common #'outline-next-heading)) 7097 7098 (defun markdown-previous-heading () 7099 "Move to the previous heading line of any level." 7100 (markdown-move-heading-common #'outline-previous-heading)) 7101 7102 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) 7103 "Move back to the beginning of the previous heading. 7104 Returns t if the point is at a heading, the location if a heading 7105 was found, and nil otherwise. 7106 Only visible heading lines are considered, unless INVISIBLE-OK is 7107 non-nil. Throw an error if there is no previous heading unless 7108 NO-ERROR is non-nil. 7109 Leaves match data intact for `markdown-regex-header'." 7110 (beginning-of-line) 7111 (or (and (markdown-heading-at-point) 7112 (not (markdown-code-block-at-point-p))) 7113 (let (found) 7114 (save-excursion 7115 (while (and (not found) 7116 (re-search-backward markdown-regex-header nil t)) 7117 (when (and (or invisible-ok (not (outline-invisible-p))) 7118 (not (markdown-code-block-at-point-p))) 7119 (setq found (point)))) 7120 (if (not found) 7121 (unless no-error (user-error "Before first heading")) 7122 (setq found (point)))) 7123 (when found (goto-char found))))) 7124 7125 (defun markdown-forward-same-level (arg) 7126 "Move forward to the ARG'th heading at same level as this one. 7127 Stop at the first and last headings of a superior heading." 7128 (interactive "p") 7129 (markdown-back-to-heading-over-code-block) 7130 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) 7131 7132 (defun markdown-backward-same-level (arg) 7133 "Move backward to the ARG'th heading at same level as this one. 7134 Stop at the first and last headings of a superior heading." 7135 (interactive "p") 7136 (markdown-back-to-heading-over-code-block) 7137 (while (> arg 0) 7138 (let ((point-to-move-to 7139 (save-excursion 7140 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) 7141 (if point-to-move-to 7142 (progn 7143 (goto-char point-to-move-to) 7144 (setq arg (1- arg))) 7145 (user-error "No previous same-level heading"))))) 7146 7147 (defun markdown-up-heading (arg &optional interactive) 7148 "Move to the visible heading line of which the present line is a subheading. 7149 With argument, move up ARG levels. When called interactively (or 7150 INTERACTIVE is non-nil), also push the mark." 7151 (interactive "p\np") 7152 (and interactive (not (eq last-command 'markdown-up-heading)) 7153 (push-mark)) 7154 (markdown-move-heading-common #'outline-up-heading arg 'adjust)) 7155 7156 (defun markdown-back-to-heading (&optional invisible-ok) 7157 "Move to previous heading line, or beg of this line if it's a heading. 7158 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 7159 (interactive) 7160 (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) 7161 7162 (defalias 'markdown-end-of-heading 'outline-end-of-heading) 7163 7164 (defun markdown-on-heading-p () 7165 "Return non-nil if point is on a heading line." 7166 (get-text-property (line-beginning-position) 'markdown-heading)) 7167 7168 (defun markdown-end-of-subtree (&optional invisible-OK) 7169 "Move to the end of the current subtree. 7170 Only visible heading lines are considered, unless INVISIBLE-OK is 7171 non-nil. 7172 Derived from `org-end-of-subtree'." 7173 (markdown-back-to-heading invisible-OK) 7174 (let ((first t) 7175 (level (markdown-outline-level))) 7176 (while (and (not (eobp)) 7177 (or first (> (markdown-outline-level) level))) 7178 (setq first nil) 7179 (markdown-next-heading)) 7180 (if (memq (preceding-char) '(?\n ?\^M)) 7181 (progn 7182 ;; Go to end of line before heading 7183 (forward-char -1) 7184 (if (memq (preceding-char) '(?\n ?\^M)) 7185 ;; leave blank line before heading 7186 (forward-char -1))))) 7187 (point)) 7188 7189 (defun markdown-outline-fix-visibility () 7190 "Hide any false positive headings that should not be shown. 7191 For example, headings inside preformatted code blocks may match 7192 `outline-regexp' but should not be shown as headings when cycling. 7193 Also, the ending --- line in metadata blocks appears to be a 7194 setext header, but should not be folded." 7195 (save-excursion 7196 (goto-char (point-min)) 7197 ;; Unhide any false positives in metadata blocks 7198 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) 7199 (let ((body (progn (forward-line) 7200 (markdown-text-property-at-point 7201 'markdown-yaml-metadata-section)))) 7202 (when body 7203 (let ((end (progn (goto-char (cl-second body)) 7204 (markdown-text-property-at-point 7205 'markdown-yaml-metadata-end)))) 7206 (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) 7207 ;; Hide any false positives in code blocks 7208 (unless (outline-on-heading-p) 7209 (outline-next-visible-heading 1)) 7210 (while (< (point) (point-max)) 7211 (when (markdown-code-block-at-point-p) 7212 (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) 7213 (outline-next-visible-heading 1)))) 7214 7215 (defvar markdown-cycle-global-status 1) 7216 (defvar markdown-cycle-subtree-status nil) 7217 7218 (defun markdown-next-preface () 7219 (let (finish) 7220 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") 7221 nil 'move)) 7222 (unless (markdown-code-block-at-point-p) 7223 (goto-char (match-beginning 0)) 7224 (setq finish t)))) 7225 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) 7226 (forward-char -1))) 7227 7228 (defun markdown-show-entry () 7229 (save-excursion 7230 (outline-back-to-heading t) 7231 (outline-flag-region (1- (point)) 7232 (progn 7233 (markdown-next-preface) 7234 (if (= 1 (- (point-max) (point))) 7235 (point-max) 7236 (point))) 7237 nil))) 7238 7239 ;; This function was originally derived from `org-cycle' from org.el. 7240 (defun markdown-cycle (&optional arg) 7241 "Visibility cycling for Markdown mode. 7242 This function is called with a `\\[universal-argument]' or if ARG is t, perform 7243 global visibility cycling. If the point is at an atx-style header, cycle 7244 visibility of the corresponding subtree. Otherwise, indent the current line 7245 or insert a tab, as appropriate, by calling `indent-for-tab-command'." 7246 (interactive "P") 7247 (cond 7248 7249 ;; Global cycling 7250 (arg 7251 (cond 7252 ;; Move from overview to contents 7253 ((and (eq last-command this-command) 7254 (eq markdown-cycle-global-status 2)) 7255 (outline-hide-sublevels 1) 7256 (message "CONTENTS") 7257 (setq markdown-cycle-global-status 3) 7258 (markdown-outline-fix-visibility)) 7259 ;; Move from contents to all 7260 ((and (eq last-command this-command) 7261 (eq markdown-cycle-global-status 3)) 7262 (outline-show-all) 7263 (message "SHOW ALL") 7264 (setq markdown-cycle-global-status 1)) 7265 ;; Defaults to overview 7266 (t 7267 (outline-hide-body) 7268 (message "OVERVIEW") 7269 (setq markdown-cycle-global-status 2) 7270 (markdown-outline-fix-visibility)))) 7271 7272 ;; At a heading: rotate between three different views 7273 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) 7274 (markdown-back-to-heading) 7275 (let ((goal-column 0) eoh eol eos) 7276 ;; Determine boundaries 7277 (save-excursion 7278 (markdown-back-to-heading) 7279 (save-excursion 7280 (beginning-of-line 2) 7281 (while (and (not (eobp)) ;; this is like `next-line' 7282 (get-char-property (1- (point)) 'invisible)) 7283 (beginning-of-line 2)) (setq eol (point))) 7284 (markdown-end-of-heading) (setq eoh (point)) 7285 (markdown-end-of-subtree t) 7286 (skip-chars-forward " \t\n") 7287 (beginning-of-line 1) ; in case this is an item 7288 (setq eos (1- (point)))) 7289 ;; Find out what to do next and set `this-command' 7290 (cond 7291 ;; Nothing is hidden behind this heading 7292 ((= eos eoh) 7293 (message "EMPTY ENTRY") 7294 (setq markdown-cycle-subtree-status nil)) 7295 ;; Entire subtree is hidden in one line: open it 7296 ((>= eol eos) 7297 (markdown-show-entry) 7298 (outline-show-children) 7299 (message "CHILDREN") 7300 (setq markdown-cycle-subtree-status 'children)) 7301 ;; We just showed the children, now show everything. 7302 ((and (eq last-command this-command) 7303 (eq markdown-cycle-subtree-status 'children)) 7304 (outline-show-subtree) 7305 (message "SUBTREE") 7306 (setq markdown-cycle-subtree-status 'subtree)) 7307 ;; Default action: hide the subtree. 7308 (t 7309 (outline-hide-subtree) 7310 (message "FOLDED") 7311 (setq markdown-cycle-subtree-status 'folded))))) 7312 7313 ;; In a table, move forward by one cell 7314 ((markdown-table-at-point-p) 7315 (call-interactively #'markdown-table-forward-cell)) 7316 7317 ;; Otherwise, indent as appropriate 7318 (t 7319 (indent-for-tab-command)))) 7320 7321 (defun markdown-shifttab () 7322 "Handle S-TAB keybinding based on context. 7323 When in a table, move backward one cell. 7324 Otherwise, cycle global heading visibility by calling 7325 `markdown-cycle' with argument t." 7326 (interactive) 7327 (cond ((markdown-table-at-point-p) 7328 (call-interactively #'markdown-table-backward-cell)) 7329 (t (markdown-cycle t)))) 7330 7331 (defun markdown-outline-level () 7332 "Return the depth to which a statement is nested in the outline." 7333 (cond 7334 ((and (match-beginning 0) 7335 (markdown-code-block-at-pos (match-beginning 0))) 7336 7) ;; Only 6 header levels are defined. 7337 ((match-end 2) 1) 7338 ((match-end 3) 2) 7339 ((match-end 4) 7340 (length (markdown-trim-whitespace (match-string-no-properties 4)))))) 7341 7342 (defun markdown-promote-subtree (&optional arg) 7343 "Promote the current subtree of ATX headings. 7344 Note that Markdown does not support heading levels higher than 7345 six and therefore level-six headings will not be promoted 7346 further. If ARG is non-nil promote the heading, otherwise 7347 demote." 7348 (interactive "*P") 7349 (save-excursion 7350 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) 7351 (re-search-backward markdown-regex-header-atx nil t)) 7352 (not (markdown-code-block-at-point-p))) 7353 (let ((level (length (match-string 1))) 7354 (promote-or-demote (if arg 1 -1)) 7355 (remove 't)) 7356 (markdown-cycle-atx promote-or-demote remove) 7357 (catch 'end-of-subtree 7358 (while (and (markdown-next-heading) 7359 (looking-at markdown-regex-header-atx)) 7360 ;; Exit if this not a higher level heading; promote otherwise. 7361 (if (and (looking-at markdown-regex-header-atx) 7362 (<= (length (match-string-no-properties 1)) level)) 7363 (throw 'end-of-subtree nil) 7364 (markdown-cycle-atx promote-or-demote remove)))))))) 7365 7366 (defun markdown-demote-subtree () 7367 "Demote the current subtree of ATX headings." 7368 (interactive) 7369 (markdown-promote-subtree t)) 7370 7371 (defun markdown-move-subtree-up () 7372 "Move the current subtree of ATX headings up." 7373 (interactive) 7374 (outline-move-subtree-up 1)) 7375 7376 (defun markdown-move-subtree-down () 7377 "Move the current subtree of ATX headings down." 7378 (interactive) 7379 (outline-move-subtree-down 1)) 7380 7381 (defun markdown-outline-next () 7382 "Move to next list item, when in a list, or next visible heading." 7383 (interactive) 7384 (let ((bounds (markdown-next-list-item-bounds))) 7385 (if bounds 7386 (goto-char (nth 0 bounds)) 7387 (markdown-next-visible-heading 1)))) 7388 7389 (defun markdown-outline-previous () 7390 "Move to previous list item, when in a list, or previous visible heading." 7391 (interactive) 7392 (let ((bounds (markdown-prev-list-item-bounds))) 7393 (if bounds 7394 (goto-char (nth 0 bounds)) 7395 (markdown-previous-visible-heading 1)))) 7396 7397 (defun markdown-outline-next-same-level () 7398 "Move to next list item or heading of same level." 7399 (interactive) 7400 (let ((bounds (markdown-cur-list-item-bounds))) 7401 (if bounds 7402 (markdown-next-list-item (nth 3 bounds)) 7403 (markdown-forward-same-level 1)))) 7404 7405 (defun markdown-outline-previous-same-level () 7406 "Move to previous list item or heading of same level." 7407 (interactive) 7408 (let ((bounds (markdown-cur-list-item-bounds))) 7409 (if bounds 7410 (markdown-prev-list-item (nth 3 bounds)) 7411 (markdown-backward-same-level 1)))) 7412 7413 (defun markdown-outline-up () 7414 "Move to previous list item, when in a list, or previous heading." 7415 (interactive) 7416 (unless (markdown-up-list) 7417 (markdown-up-heading 1))) 7418 7419 7420 ;;; Marking and Narrowing ===================================================== 7421 7422 (defun markdown-mark-paragraph () 7423 "Put mark at end of this block, point at beginning. 7424 The block marked is the one that contains point or follows point. 7425 7426 Interactively, if this command is repeated or (in Transient Mark 7427 mode) if the mark is active, it marks the next block after the 7428 ones already marked." 7429 (interactive) 7430 (if (or (and (eq last-command this-command) (mark t)) 7431 (and transient-mark-mode mark-active)) 7432 (set-mark 7433 (save-excursion 7434 (goto-char (mark)) 7435 (markdown-forward-paragraph) 7436 (point))) 7437 (let ((beginning-of-defun-function #'markdown-backward-paragraph) 7438 (end-of-defun-function #'markdown-forward-paragraph)) 7439 (mark-defun)))) 7440 7441 (defun markdown-mark-block () 7442 "Put mark at end of this block, point at beginning. 7443 The block marked is the one that contains point or follows point. 7444 7445 Interactively, if this command is repeated or (in Transient Mark 7446 mode) if the mark is active, it marks the next block after the 7447 ones already marked." 7448 (interactive) 7449 (if (or (and (eq last-command this-command) (mark t)) 7450 (and transient-mark-mode mark-active)) 7451 (set-mark 7452 (save-excursion 7453 (goto-char (mark)) 7454 (markdown-forward-block) 7455 (point))) 7456 (let ((beginning-of-defun-function #'markdown-backward-block) 7457 (end-of-defun-function #'markdown-forward-block)) 7458 (mark-defun)))) 7459 7460 (defun markdown-narrow-to-block () 7461 "Make text outside current block invisible. 7462 The current block is the one that contains point or follows point." 7463 (interactive) 7464 (let ((beginning-of-defun-function #'markdown-backward-block) 7465 (end-of-defun-function #'markdown-forward-block)) 7466 (narrow-to-defun))) 7467 7468 (defun markdown-mark-text-block () 7469 "Put mark at end of this plain text block, point at beginning. 7470 The block marked is the one that contains point or follows point. 7471 7472 Interactively, if this command is repeated or (in Transient Mark 7473 mode) if the mark is active, it marks the next block after the 7474 ones already marked." 7475 (interactive) 7476 (if (or (and (eq last-command this-command) (mark t)) 7477 (and transient-mark-mode mark-active)) 7478 (set-mark 7479 (save-excursion 7480 (goto-char (mark)) 7481 (markdown-end-of-text-block) 7482 (point))) 7483 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) 7484 (end-of-defun-function #'markdown-end-of-text-block)) 7485 (mark-defun)))) 7486 7487 (defun markdown-mark-page () 7488 "Put mark at end of this top level section, point at beginning. 7489 The top level section marked is the one that contains point or 7490 follows point. 7491 7492 Interactively, if this command is repeated or (in Transient Mark 7493 mode) if the mark is active, it marks the next page after the 7494 ones already marked." 7495 (interactive) 7496 (if (or (and (eq last-command this-command) (mark t)) 7497 (and transient-mark-mode mark-active)) 7498 (set-mark 7499 (save-excursion 7500 (goto-char (mark)) 7501 (markdown-forward-page) 7502 (point))) 7503 (let ((beginning-of-defun-function #'markdown-backward-page) 7504 (end-of-defun-function #'markdown-forward-page)) 7505 (mark-defun)))) 7506 7507 (defun markdown-narrow-to-page () 7508 "Make text outside current top level section invisible. 7509 The current section is the one that contains point or follows point." 7510 (interactive) 7511 (let ((beginning-of-defun-function #'markdown-backward-page) 7512 (end-of-defun-function #'markdown-forward-page)) 7513 (narrow-to-defun))) 7514 7515 (defun markdown-mark-subtree () 7516 "Mark the current subtree. 7517 This puts point at the start of the current subtree, and mark at the end." 7518 (interactive) 7519 (let ((beg)) 7520 (if (markdown-heading-at-point) 7521 (beginning-of-line) 7522 (markdown-previous-visible-heading 1)) 7523 (setq beg (point)) 7524 (markdown-end-of-subtree) 7525 (push-mark (point) nil t) 7526 (goto-char beg))) 7527 7528 (defun markdown-narrow-to-subtree () 7529 "Narrow buffer to the current subtree." 7530 (interactive) 7531 (save-excursion 7532 (save-match-data 7533 (narrow-to-region 7534 (progn (markdown-back-to-heading-over-code-block t) (point)) 7535 (progn (markdown-end-of-subtree) 7536 (if (and (markdown-heading-at-point) (not (eobp))) 7537 (backward-char 1)) 7538 (point)))))) 7539 7540 7541 ;;; Generic Structure Editing, Completion, and Cycling Commands =============== 7542 7543 (defun markdown-move-up () 7544 "Move thing at point up. 7545 When in a list item, call `markdown-move-list-item-up'. 7546 When in a table, call `markdown-table-move-row-up'. 7547 Otherwise, move the current heading subtree up with 7548 `markdown-move-subtree-up'." 7549 (interactive) 7550 (cond 7551 ((markdown-list-item-at-point-p) 7552 (call-interactively #'markdown-move-list-item-up)) 7553 ((markdown-table-at-point-p) 7554 (call-interactively #'markdown-table-move-row-up)) 7555 (t 7556 (call-interactively #'markdown-move-subtree-up)))) 7557 7558 (defun markdown-move-down () 7559 "Move thing at point down. 7560 When in a list item, call `markdown-move-list-item-down'. 7561 Otherwise, move the current heading subtree up with 7562 `markdown-move-subtree-down'." 7563 (interactive) 7564 (cond 7565 ((markdown-list-item-at-point-p) 7566 (call-interactively #'markdown-move-list-item-down)) 7567 ((markdown-table-at-point-p) 7568 (call-interactively #'markdown-table-move-row-down)) 7569 (t 7570 (call-interactively #'markdown-move-subtree-down)))) 7571 7572 (defun markdown-promote () 7573 "Promote or move element at point to the left. 7574 Depending on the context, this function will promote a heading or 7575 list item at the point, move a table column to the left, or cycle 7576 markup." 7577 (interactive) 7578 (let (bounds) 7579 (cond 7580 ;; Promote atx heading subtree 7581 ((thing-at-point-looking-at markdown-regex-header-atx) 7582 (markdown-promote-subtree)) 7583 ;; Promote setext heading 7584 ((thing-at-point-looking-at markdown-regex-header-setext) 7585 (markdown-cycle-setext -1)) 7586 ;; Promote horizontal rule 7587 ((thing-at-point-looking-at markdown-regex-hr) 7588 (markdown-cycle-hr -1)) 7589 ;; Promote list item 7590 ((setq bounds (markdown-cur-list-item-bounds)) 7591 (markdown-promote-list-item bounds)) 7592 ;; Move table column to the left 7593 ((markdown-table-at-point-p) 7594 (call-interactively #'markdown-table-move-column-left)) 7595 ;; Promote bold 7596 ((thing-at-point-looking-at markdown-regex-bold) 7597 (markdown-cycle-bold)) 7598 ;; Promote italic 7599 ((thing-at-point-looking-at markdown-regex-italic) 7600 (markdown-cycle-italic)) 7601 (t 7602 (user-error "Nothing to promote at point"))))) 7603 7604 (defun markdown-demote () 7605 "Demote or move element at point to the right. 7606 Depending on the context, this function will demote a heading or 7607 list item at the point, move a table column to the right, or cycle 7608 or remove markup." 7609 (interactive) 7610 (let (bounds) 7611 (cond 7612 ;; Demote atx heading subtree 7613 ((thing-at-point-looking-at markdown-regex-header-atx) 7614 (markdown-demote-subtree)) 7615 ;; Demote setext heading 7616 ((thing-at-point-looking-at markdown-regex-header-setext) 7617 (markdown-cycle-setext 1)) 7618 ;; Demote horizontal rule 7619 ((thing-at-point-looking-at markdown-regex-hr) 7620 (markdown-cycle-hr 1)) 7621 ;; Demote list item 7622 ((setq bounds (markdown-cur-list-item-bounds)) 7623 (markdown-demote-list-item bounds)) 7624 ;; Move table column to the right 7625 ((markdown-table-at-point-p) 7626 (call-interactively #'markdown-table-move-column-right)) 7627 ;; Demote bold 7628 ((thing-at-point-looking-at markdown-regex-bold) 7629 (markdown-cycle-bold)) 7630 ;; Demote italic 7631 ((thing-at-point-looking-at markdown-regex-italic) 7632 (markdown-cycle-italic)) 7633 (t 7634 (user-error "Nothing to demote at point"))))) 7635 7636 7637 ;;; Commands ================================================================== 7638 7639 (defun markdown (&optional output-buffer-name) 7640 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. 7641 The output buffer name defaults to `markdown-output-buffer-name'. 7642 Return the name of the output buffer used." 7643 (interactive) 7644 (save-window-excursion 7645 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) 7646 ((listp markdown-command) markdown-command))) 7647 (command (car-safe commands)) 7648 (command-args (cdr-safe commands)) 7649 begin-region end-region) 7650 (if (use-region-p) 7651 (setq begin-region (region-beginning) 7652 end-region (region-end)) 7653 (setq begin-region (point-min) 7654 end-region (point-max))) 7655 7656 (unless output-buffer-name 7657 (setq output-buffer-name markdown-output-buffer-name)) 7658 (when (and (stringp command) (not (executable-find command))) 7659 (user-error "Markdown command %s is not found" command)) 7660 (let ((exit-code 7661 (cond 7662 ;; Handle case when `markdown-command' does not read from stdin 7663 ((and (stringp command) markdown-command-needs-filename) 7664 (if (not buffer-file-name) 7665 (user-error "Must be visiting a file") 7666 ;; Don’t use ‘shell-command’ because it’s not guaranteed to 7667 ;; return the exit code of the process. 7668 (let ((command (if (listp markdown-command) 7669 (string-join markdown-command " ") 7670 markdown-command))) 7671 (shell-command-on-region 7672 ;; Pass an empty region so that stdin is empty. 7673 (point) (point) 7674 (concat command " " 7675 (shell-quote-argument buffer-file-name)) 7676 output-buffer-name)))) 7677 ;; Pass region to `markdown-command' via stdin 7678 (t 7679 (let ((buf (get-buffer-create output-buffer-name))) 7680 (with-current-buffer buf 7681 (setq buffer-read-only nil) 7682 (erase-buffer)) 7683 (if (stringp command) 7684 (if (not (null command-args)) 7685 (apply #'call-process-region begin-region end-region command nil buf nil command-args) 7686 (call-process-region begin-region end-region command nil buf)) 7687 (if markdown-command-needs-filename 7688 (if (not buffer-file-name) 7689 (user-error "Must be visiting a file") 7690 (funcall markdown-command begin-region end-region buf buffer-file-name)) 7691 (funcall markdown-command begin-region end-region buf)) 7692 ;; If the ‘markdown-command’ function didn’t signal an 7693 ;; error, assume it succeeded by binding ‘exit-code’ to 0. 7694 0)))))) 7695 ;; The exit code can be a signal description string, so don’t use ‘=’ 7696 ;; or ‘zerop’. 7697 (unless (eq exit-code 0) 7698 (user-error "%s failed with exit code %s" 7699 markdown-command exit-code)))) 7700 output-buffer-name)) 7701 7702 (defun markdown-standalone (&optional output-buffer-name) 7703 "Special function to provide standalone HTML output. 7704 Insert the output in the buffer named OUTPUT-BUFFER-NAME." 7705 (interactive) 7706 (setq output-buffer-name (markdown output-buffer-name)) 7707 (let ((css-path markdown-css-paths)) 7708 (with-current-buffer output-buffer-name 7709 (set-buffer output-buffer-name) 7710 (setq-local markdown-css-paths css-path) 7711 (unless (markdown-output-standalone-p) 7712 (markdown-add-xhtml-header-and-footer output-buffer-name)) 7713 (goto-char (point-min)) 7714 (html-mode))) 7715 output-buffer-name) 7716 7717 (defun markdown-other-window (&optional output-buffer-name) 7718 "Run `markdown-command' on current buffer and display in other window. 7719 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7720 that name." 7721 (interactive) 7722 (markdown-display-buffer-other-window 7723 (markdown-standalone output-buffer-name))) 7724 7725 (defun markdown-output-standalone-p () 7726 "Determine whether `markdown-command' output is standalone XHTML. 7727 Standalone XHTML output is identified by an occurrence of 7728 `markdown-xhtml-standalone-regexp' in the first five lines of output." 7729 (save-excursion 7730 (goto-char (point-min)) 7731 (save-match-data 7732 (re-search-forward 7733 markdown-xhtml-standalone-regexp 7734 (save-excursion (goto-char (point-min)) (forward-line 4) (point)) 7735 t)))) 7736 7737 (defun markdown-stylesheet-link-string (stylesheet-path) 7738 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" 7739 (or (and (string-prefix-p "~" stylesheet-path) 7740 (expand-file-name stylesheet-path)) 7741 stylesheet-path) 7742 "\" />")) 7743 7744 (defun markdown-escape-title (title) 7745 "Escape a minimum set of characters in TITLE so they don't clash with html." 7746 (replace-regexp-in-string ">" ">" 7747 (replace-regexp-in-string "<" "<" 7748 (replace-regexp-in-string "&" "&" title)))) 7749 7750 (defun markdown-add-xhtml-header-and-footer (title) 7751 "Wrap XHTML header and footer with given TITLE around current buffer." 7752 (goto-char (point-min)) 7753 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" 7754 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" 7755 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" 7756 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" 7757 "<head>\n<title>") 7758 (insert (markdown-escape-title title)) 7759 (insert "</title>\n") 7760 (unless (= (length markdown-content-type) 0) 7761 (insert 7762 (format 7763 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" 7764 markdown-content-type 7765 (or (and markdown-coding-system 7766 (coding-system-get markdown-coding-system 7767 'mime-charset)) 7768 (coding-system-get buffer-file-coding-system 7769 'mime-charset) 7770 "utf-8")))) 7771 (if (> (length markdown-css-paths) 0) 7772 (insert (mapconcat #'markdown-stylesheet-link-string 7773 markdown-css-paths "\n"))) 7774 (when (> (length markdown-xhtml-header-content) 0) 7775 (insert markdown-xhtml-header-content)) 7776 (insert "\n</head>\n\n" 7777 "<body>\n\n") 7778 (when (> (length markdown-xhtml-body-preamble) 0) 7779 (insert markdown-xhtml-body-preamble "\n")) 7780 (goto-char (point-max)) 7781 (when (> (length markdown-xhtml-body-epilogue) 0) 7782 (insert "\n" markdown-xhtml-body-epilogue)) 7783 (insert "\n" 7784 "</body>\n" 7785 "</html>\n")) 7786 7787 (defun markdown-preview (&optional output-buffer-name) 7788 "Run `markdown-command' on the current buffer and view output in browser. 7789 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with 7790 that name." 7791 (interactive) 7792 (browse-url-of-buffer 7793 (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) 7794 7795 (defun markdown-export-file-name (&optional extension) 7796 "Attempt to generate a filename for Markdown output. 7797 The file extension will be EXTENSION if given, or .html by default. 7798 If the current buffer is visiting a file, we construct a new 7799 output filename based on that filename. Otherwise, return nil." 7800 (when (buffer-file-name) 7801 (unless extension 7802 (setq extension ".html")) 7803 (let ((candidate 7804 (concat 7805 (cond 7806 ((buffer-file-name) 7807 (file-name-sans-extension (buffer-file-name))) 7808 (t (buffer-name))) 7809 extension))) 7810 (cond 7811 ((equal candidate (buffer-file-name)) 7812 (concat candidate extension)) 7813 (t 7814 candidate))))) 7815 7816 (defun markdown-export (&optional output-file) 7817 "Run Markdown on the current buffer, save to file, and return the filename. 7818 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename 7819 generated by `markdown-export-file-name', which will be constructed using the 7820 current filename, but with the extension removed and replaced with .html." 7821 (interactive) 7822 (unless output-file 7823 (setq output-file (markdown-export-file-name ".html"))) 7824 (when output-file 7825 (let* ((init-buf (current-buffer)) 7826 (init-point (point)) 7827 (init-buf-string (buffer-string)) 7828 (output-buffer (find-file-noselect output-file)) 7829 (output-buffer-name (buffer-name output-buffer))) 7830 (run-hooks 'markdown-before-export-hook) 7831 (markdown-standalone output-buffer-name) 7832 (with-current-buffer output-buffer 7833 (run-hooks 'markdown-after-export-hook) 7834 (save-buffer) 7835 (when markdown-export-kill-buffer (kill-buffer))) 7836 ;; if modified, restore initial buffer 7837 (when (buffer-modified-p init-buf) 7838 (erase-buffer) 7839 (insert init-buf-string) 7840 (save-buffer) 7841 (goto-char init-point)) 7842 output-file))) 7843 7844 (defun markdown-export-and-preview () 7845 "Export to XHTML using `markdown-export' and browse the resulting file." 7846 (interactive) 7847 (browse-url-of-file (markdown-export))) 7848 7849 (defvar-local markdown-live-preview-buffer nil 7850 "Buffer used to preview markdown output in `markdown-live-preview-export'.") 7851 7852 (defvar-local markdown-live-preview-source-buffer nil 7853 "Source buffer from which current buffer was generated. 7854 This is the inverse of `markdown-live-preview-buffer'.") 7855 7856 (defvar markdown-live-preview-currently-exporting nil) 7857 7858 (defun markdown-live-preview-get-filename () 7859 "Standardize the filename exported by `markdown-live-preview-export'." 7860 (markdown-export-file-name ".html")) 7861 7862 (defun markdown-live-preview-window-eww (file) 7863 "Preview FILE with eww. 7864 To be used with `markdown-live-preview-window-function'." 7865 (when (and (bound-and-true-p eww-auto-rename-buffer) 7866 markdown-live-preview-buffer) 7867 (kill-buffer markdown-live-preview-buffer)) 7868 (eww-open-file file) 7869 ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" 7870 ;; Try to find the buffer whose name ends with "eww*" 7871 (if (bound-and-true-p eww-auto-rename-buffer) 7872 (cl-loop for buf in (buffer-list) 7873 when (string-match-p "eww\\*\\'" (buffer-name buf)) 7874 return buf) 7875 (get-buffer "*eww*"))) 7876 7877 (defun markdown-visual-lines-between-points (beg end) 7878 (save-excursion 7879 (goto-char beg) 7880 (cl-loop with count = 0 7881 while (progn (end-of-visual-line) 7882 (and (< (point) end) (line-move-visual 1 t))) 7883 do (cl-incf count) 7884 finally return count))) 7885 7886 (defun markdown-live-preview-window-serialize (buf) 7887 "Get window point and scroll data for all windows displaying BUF." 7888 (when (buffer-live-p buf) 7889 (with-current-buffer buf 7890 (mapcar 7891 (lambda (win) 7892 (with-selected-window win 7893 (let* ((start (window-start)) 7894 (pt (window-point)) 7895 (pt-or-sym (cond ((= pt (point-min)) 'min) 7896 ((= pt (point-max)) 'max) 7897 (t pt))) 7898 (diff (markdown-visual-lines-between-points 7899 start pt))) 7900 (list win pt-or-sym diff)))) 7901 (get-buffer-window-list buf))))) 7902 7903 (defun markdown-get-point-back-lines (pt num-lines) 7904 (save-excursion 7905 (goto-char pt) 7906 (line-move-visual (- num-lines) t) 7907 ;; in testing, can occasionally overshoot the number of lines to traverse 7908 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) 7909 (when (> actual-num-lines num-lines) 7910 (line-move-visual (- actual-num-lines num-lines) t))) 7911 (point))) 7912 7913 (defun markdown-live-preview-window-deserialize (window-posns) 7914 "Apply window point and scroll data from WINDOW-POSNS. 7915 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." 7916 (cl-destructuring-bind (win pt-or-sym diff) window-posns 7917 (when (window-live-p win) 7918 (with-current-buffer markdown-live-preview-buffer 7919 (set-window-buffer win (current-buffer)) 7920 (cl-destructuring-bind (actual-pt actual-diff) 7921 (cl-case pt-or-sym 7922 (min (list (point-min) 0)) 7923 (max (list (point-max) diff)) 7924 (t (list pt-or-sym diff))) 7925 (set-window-start 7926 win (markdown-get-point-back-lines actual-pt actual-diff)) 7927 (set-window-point win actual-pt)))))) 7928 7929 (defun markdown-live-preview-export () 7930 "Export to XHTML using `markdown-export'. 7931 Browse the resulting file within Emacs using 7932 `markdown-live-preview-window-function' Return the buffer 7933 displaying the rendered output." 7934 (interactive) 7935 (let ((filename (markdown-live-preview-get-filename))) 7936 (when filename 7937 (let* ((markdown-live-preview-currently-exporting t) 7938 (cur-buf (current-buffer)) 7939 (export-file (markdown-export filename)) 7940 ;; get positions in all windows currently displaying output buffer 7941 (window-data 7942 (markdown-live-preview-window-serialize 7943 markdown-live-preview-buffer))) 7944 (save-window-excursion 7945 (let ((output-buffer 7946 (funcall markdown-live-preview-window-function export-file))) 7947 (with-current-buffer output-buffer 7948 (setq markdown-live-preview-source-buffer cur-buf) 7949 (add-hook 'kill-buffer-hook 7950 #'markdown-live-preview-remove-on-kill t t)) 7951 (with-current-buffer cur-buf 7952 (setq markdown-live-preview-buffer output-buffer)))) 7953 (with-current-buffer cur-buf 7954 ;; reset all windows displaying output buffer to where they were, 7955 ;; now with the new output 7956 (mapc #'markdown-live-preview-window-deserialize window-data) 7957 ;; delete html editing buffer 7958 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) 7959 (when (and export-file (file-exists-p export-file) 7960 (eq markdown-live-preview-delete-export 7961 'delete-on-export)) 7962 (delete-file export-file)) 7963 markdown-live-preview-buffer))))) 7964 7965 (defun markdown-live-preview-remove () 7966 (when (buffer-live-p markdown-live-preview-buffer) 7967 (kill-buffer markdown-live-preview-buffer)) 7968 (setq markdown-live-preview-buffer nil) 7969 ;; if set to 'delete-on-export, the output has already been deleted 7970 (when (eq markdown-live-preview-delete-export 'delete-on-destroy) 7971 (let ((outfile-name (markdown-live-preview-get-filename))) 7972 (when (and outfile-name (file-exists-p outfile-name)) 7973 (delete-file outfile-name))))) 7974 7975 (defun markdown-get-other-window () 7976 "Find another window to display preview or output content." 7977 (cond 7978 ((memq markdown-split-window-direction '(vertical below)) 7979 (or (window-in-direction 'below) (split-window-vertically))) 7980 ((memq markdown-split-window-direction '(horizontal right)) 7981 (or (window-in-direction 'right) (split-window-horizontally))) 7982 (t (split-window-sensibly (get-buffer-window))))) 7983 7984 (defun markdown-display-buffer-other-window (buf) 7985 "Display preview or output buffer BUF in another window." 7986 (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) 7987 (display-buffer buf) 7988 (let ((cur-buf (current-buffer)) 7989 (window (markdown-get-other-window))) 7990 (set-window-buffer window buf) 7991 (set-buffer cur-buf)))) 7992 7993 (defun markdown-live-preview-if-markdown () 7994 (when (and (derived-mode-p 'markdown-mode) 7995 markdown-live-preview-mode) 7996 (unless markdown-live-preview-currently-exporting 7997 (if (buffer-live-p markdown-live-preview-buffer) 7998 (markdown-live-preview-export) 7999 (markdown-display-buffer-other-window 8000 (markdown-live-preview-export)))))) 8001 8002 (defun markdown-live-preview-remove-on-kill () 8003 (cond ((and (derived-mode-p 'markdown-mode) 8004 markdown-live-preview-mode) 8005 (markdown-live-preview-remove)) 8006 (markdown-live-preview-source-buffer 8007 (with-current-buffer markdown-live-preview-source-buffer 8008 (setq markdown-live-preview-buffer nil)) 8009 (setq markdown-live-preview-source-buffer nil)))) 8010 8011 (defun markdown-live-preview-switch-to-output () 8012 "Turn on `markdown-live-preview-mode' and switch to output buffer. 8013 The output buffer is opened in another window." 8014 (interactive) 8015 (if markdown-live-preview-mode 8016 (markdown-display-buffer-other-window (markdown-live-preview-export))) 8017 (markdown-live-preview-mode)) 8018 8019 (defun markdown-live-preview-re-export () 8020 "Re-export the current live previewed content. 8021 If the current buffer is a buffer displaying the exported version of a 8022 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and 8023 update this buffer's contents." 8024 (interactive) 8025 (when markdown-live-preview-source-buffer 8026 (with-current-buffer markdown-live-preview-source-buffer 8027 (markdown-live-preview-export)))) 8028 8029 (defun markdown-open () 8030 "Open file for the current buffer with `markdown-open-command'." 8031 (interactive) 8032 (unless markdown-open-command 8033 (user-error "Variable `markdown-open-command' must be set")) 8034 (if (stringp markdown-open-command) 8035 (if (not buffer-file-name) 8036 (user-error "Must be visiting a file") 8037 (save-buffer) 8038 (let ((exit-code (call-process markdown-open-command nil nil nil 8039 buffer-file-name))) 8040 ;; The exit code can be a signal description string, so don’t use ‘=’ 8041 ;; or ‘zerop’. 8042 (unless (eq exit-code 0) 8043 (user-error "%s failed with exit code %s" 8044 markdown-open-command exit-code)))) 8045 (funcall markdown-open-command)) 8046 nil) 8047 8048 (defun markdown-kill-ring-save () 8049 "Run Markdown on file and store output in the kill ring." 8050 (interactive) 8051 (save-window-excursion 8052 (markdown) 8053 (with-current-buffer markdown-output-buffer-name 8054 (kill-ring-save (point-min) (point-max))))) 8055 8056 8057 ;;; Links ===================================================================== 8058 8059 (defun markdown-backward-to-link-start () 8060 "Backward link start position if current position is in link title." 8061 ;; Issue #305 8062 (when (eq (get-text-property (point) 'face) 'markdown-link-face) 8063 (skip-chars-backward "^[") 8064 (forward-char -1))) 8065 8066 (defun markdown-link-p () 8067 "Return non-nil when `point' is at a non-wiki link. 8068 See `markdown-wiki-link-p' for more information." 8069 (save-excursion 8070 (let ((case-fold-search nil)) 8071 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) 8072 (markdown-backward-to-link-start) 8073 (or (thing-at-point-looking-at markdown-regex-link-inline) 8074 (thing-at-point-looking-at markdown-regex-link-reference) 8075 (thing-at-point-looking-at markdown-regex-uri) 8076 (thing-at-point-looking-at markdown-regex-angle-uri)))))) 8077 8078 (defun markdown-link-at-pos (pos) 8079 "Return properties of link or image at position POS. 8080 Value is a list of elements describing the link: 8081 0. beginning position 8082 1. end position 8083 2. link text 8084 3. URL 8085 4. reference label 8086 5. title text 8087 6. bang (nil or \"!\")" 8088 (save-excursion 8089 (goto-char pos) 8090 (markdown-backward-to-link-start) 8091 (let (begin end text url reference title bang) 8092 (cond 8093 ;; Inline image or link at point. 8094 ((thing-at-point-looking-at markdown-regex-link-inline) 8095 (setq bang (match-string-no-properties 1) 8096 begin (match-beginning 0) 8097 text (match-string-no-properties 3) 8098 url (match-string-no-properties 6)) 8099 ;; consider nested parentheses 8100 ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link 8101 (let* ((close-pos (scan-sexps (match-beginning 5) 1)) 8102 (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) 8103 (setq end close-pos) 8104 ;; A link can contain spaces if it is wrapped with angle brackets 8105 (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) 8106 (setq url (match-string-no-properties 1 destination-part))) 8107 ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) 8108 (setq url (match-string-no-properties 1 destination-part) 8109 title (substring (match-string-no-properties 2 destination-part) 1 -1))) 8110 (t (setq url destination-part))) 8111 (setq url (url-unhex-string url)))) 8112 ;; Reference link at point. 8113 ((thing-at-point-looking-at markdown-regex-link-reference) 8114 (setq bang (match-string-no-properties 1) 8115 begin (match-beginning 0) 8116 end (match-end 0) 8117 text (match-string-no-properties 3)) 8118 (when (char-equal (char-after (match-beginning 5)) ?\[) 8119 (setq reference (match-string-no-properties 6)))) 8120 ;; Angle bracket URI at point. 8121 ((thing-at-point-looking-at markdown-regex-angle-uri) 8122 (setq begin (match-beginning 0) 8123 end (match-end 0) 8124 url (match-string-no-properties 2))) 8125 ;; Plain URI at point. 8126 ((thing-at-point-looking-at markdown-regex-uri) 8127 (setq begin (match-beginning 0) 8128 end (match-end 0) 8129 url (match-string-no-properties 1)))) 8130 (list begin end text url reference title bang)))) 8131 8132 (defun markdown-link-url () 8133 "Return the URL part of the regular (non-wiki) link at point. 8134 Works with both inline and reference style links, and with images. 8135 If point is not at a link or the link reference is not defined 8136 returns nil." 8137 (let* ((values (markdown-link-at-pos (point))) 8138 (text (nth 2 values)) 8139 (url (nth 3 values)) 8140 (ref (nth 4 values))) 8141 (or url (and ref (car (markdown-reference-definition 8142 (downcase (if (string= ref "") text ref)))))))) 8143 8144 (defun markdown--browse-url (url) 8145 (let* ((struct (url-generic-parse-url url)) 8146 (full (url-fullness struct)) 8147 (file url)) 8148 ;; Parse URL, determine fullness, strip query string 8149 (setq file (car (url-path-and-query struct))) 8150 ;; Open full URLs in browser, files in Emacs 8151 (if full 8152 (browse-url url) 8153 (when (and file (> (length file) 0)) 8154 (let ((link-file (funcall markdown-translate-filename-function file))) 8155 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) 8156 (if (functionp markdown-open-image-command) 8157 (funcall markdown-open-image-command link-file) 8158 (process-file markdown-open-image-command nil nil nil link-file)) 8159 (find-file link-file))))))) 8160 8161 (defun markdown-follow-link-at-point (&optional event) 8162 "Open the non-wiki link at point or EVENT. 8163 If the link is a complete URL, open in browser with `browse-url'. 8164 Otherwise, open with `find-file' after stripping anchor and/or query string. 8165 Translate filenames using `markdown-filename-translate-function'." 8166 (interactive (list last-command-event)) 8167 (if event (posn-set-point (event-start event))) 8168 (if (markdown-link-p) 8169 (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) 8170 (markdown--browse-url (markdown-link-url))) 8171 (user-error "Point is not at a Markdown link or URL"))) 8172 8173 (defun markdown-fontify-inline-links (last) 8174 "Add text properties to next inline link from point to LAST." 8175 (when (markdown-match-generic-links last nil) 8176 (let* ((link-start (match-beginning 3)) 8177 (link-end (match-end 3)) 8178 (url-start (match-beginning 6)) 8179 (url-end (match-end 6)) 8180 (url (match-string-no-properties 6)) 8181 (title-start (match-beginning 7)) 8182 (title-end (match-end 7)) 8183 (title (match-string-no-properties 7)) 8184 ;; Markup part 8185 (mp (list 'invisible 'markdown-markup 8186 'rear-nonsticky t 8187 'font-lock-multiline t)) 8188 ;; Link part (without face) 8189 (lp (list 'keymap markdown-mode-mouse-map 8190 'mouse-face 'markdown-highlight-face 8191 'font-lock-multiline t 8192 'help-echo (if title (concat title "\n" url) url))) 8193 ;; URL part 8194 (up (list 'keymap markdown-mode-mouse-map 8195 'invisible 'markdown-markup 8196 'mouse-face 'markdown-highlight-face 8197 'font-lock-multiline t)) 8198 ;; URL composition character 8199 (url-char (markdown--first-displayable markdown-url-compose-char)) 8200 ;; Title part 8201 (tp (list 'invisible 'markdown-markup 8202 'font-lock-multiline t))) 8203 (dolist (g '(1 2 4 5 8)) 8204 (when (match-end g) 8205 (add-text-properties (match-beginning g) (match-end g) mp) 8206 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8207 ;; Preserve existing faces applied to link part (e.g., inline code) 8208 (when link-start 8209 (add-text-properties link-start link-end lp) 8210 (add-face-text-property link-start link-end 'markdown-link-face)) 8211 (when url-start 8212 (add-text-properties url-start url-end up) 8213 (add-face-text-property url-start url-end 'markdown-url-face)) 8214 (when title-start 8215 (add-text-properties url-end title-end tp) 8216 (add-face-text-property url-end title-end 'markdown-link-title-face)) 8217 (when (and markdown-hide-urls url-start) 8218 (compose-region url-start (or title-end url-end) url-char)) 8219 t))) 8220 8221 (defun markdown-fontify-reference-links (last) 8222 "Add text properties to next reference link from point to LAST." 8223 (when (markdown-match-generic-links last t) 8224 (let* ((link-start (match-beginning 3)) 8225 (link-end (match-end 3)) 8226 (ref-start (match-beginning 6)) 8227 (ref-end (match-end 6)) 8228 ;; Markup part 8229 (mp (list 'invisible 'markdown-markup 8230 'rear-nonsticky t 8231 'font-lock-multiline t)) 8232 ;; Link part 8233 (lp (list 'keymap markdown-mode-mouse-map 8234 'mouse-face 'markdown-highlight-face 8235 'font-lock-multiline t 8236 'help-echo (lambda (_ __ pos) 8237 (save-match-data 8238 (save-excursion 8239 (goto-char pos) 8240 (or (markdown-link-url) 8241 "Undefined reference")))))) 8242 ;; URL composition character 8243 (url-char (markdown--first-displayable markdown-url-compose-char)) 8244 ;; Reference part 8245 (rp (list 'invisible 'markdown-markup 8246 'font-lock-multiline t))) 8247 (dolist (g '(1 2 4 5 8)) 8248 (when (match-end g) 8249 (add-text-properties (match-beginning g) (match-end g) mp) 8250 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) 8251 (when link-start 8252 (add-text-properties link-start link-end lp) 8253 (add-face-text-property link-start link-end 'markdown-link-face)) 8254 (when ref-start 8255 (add-text-properties ref-start ref-end rp) 8256 (add-face-text-property ref-start ref-end 'markdown-reference-face) 8257 (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) 8258 (compose-region ref-start ref-end url-char))) 8259 t))) 8260 8261 (defun markdown-fontify-angle-uris (last) 8262 "Add text properties to angle URIs from point to LAST." 8263 (when (markdown-match-angle-uris last) 8264 (let* ((url-start (match-beginning 2)) 8265 (url-end (match-end 2)) 8266 ;; Markup part 8267 (mp (list 'face 'markdown-markup-face 8268 'invisible 'markdown-markup 8269 'rear-nonsticky t 8270 'font-lock-multiline t)) 8271 ;; URI part 8272 (up (list 'keymap markdown-mode-mouse-map 8273 'face 'markdown-plain-url-face 8274 'mouse-face 'markdown-highlight-face 8275 'font-lock-multiline t))) 8276 (dolist (g '(1 3)) 8277 (add-text-properties (match-beginning g) (match-end g) mp)) 8278 (add-text-properties url-start url-end up) 8279 t))) 8280 8281 (defun markdown-fontify-plain-uris (last) 8282 "Add text properties to plain URLs from point to LAST." 8283 (when (markdown-match-plain-uris last) 8284 (let* ((start (match-beginning 0)) 8285 (end (match-end 0)) 8286 (props (list 'keymap markdown-mode-mouse-map 8287 'face 'markdown-plain-url-face 8288 'mouse-face 'markdown-highlight-face 8289 'rear-nonsticky t 8290 'font-lock-multiline t))) 8291 (add-text-properties start end props) 8292 t))) 8293 8294 (defun markdown-toggle-url-hiding (&optional arg) 8295 "Toggle the display or hiding of URLs. 8296 With a prefix argument ARG, enable URL hiding if ARG is positive, 8297 and disable it otherwise." 8298 (interactive (list (or current-prefix-arg 'toggle))) 8299 (setq markdown-hide-urls 8300 (if (eq arg 'toggle) 8301 (not markdown-hide-urls) 8302 (> (prefix-numeric-value arg) 0))) 8303 (when (called-interactively-p 'interactive) 8304 (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) 8305 (markdown-reload-extensions)) 8306 8307 8308 ;;; Wiki Links ================================================================ 8309 8310 (defun markdown-wiki-link-p () 8311 "Return non-nil if wiki links are enabled and `point' is at a true wiki link. 8312 A true wiki link name matches `markdown-regex-wiki-link' but does 8313 not match the current file name after conversion. This modifies 8314 the data returned by `match-data'. Note that the potential wiki 8315 link name must be available via `match-string'." 8316 (when markdown-enable-wiki-links 8317 (let ((case-fold-search nil)) 8318 (and (thing-at-point-looking-at markdown-regex-wiki-link) 8319 (not (markdown-code-block-at-point-p)) 8320 (or (not buffer-file-name) 8321 (not (string-equal (buffer-file-name) 8322 (markdown-convert-wiki-link-to-filename 8323 (markdown-wiki-link-link))))))))) 8324 8325 (defun markdown-wiki-link-link () 8326 "Return the link part of the wiki link using current match data. 8327 The location of the link component depends on the value of 8328 `markdown-wiki-link-alias-first'." 8329 (if markdown-wiki-link-alias-first 8330 (or (match-string-no-properties 5) (match-string-no-properties 3)) 8331 (match-string-no-properties 3))) 8332 8333 (defun markdown-wiki-link-alias () 8334 "Return the alias or text part of the wiki link using current match data. 8335 The location of the alias component depends on the value of 8336 `markdown-wiki-link-alias-first'." 8337 (if markdown-wiki-link-alias-first 8338 (match-string-no-properties 3) 8339 (or (match-string-no-properties 5) (match-string-no-properties 3)))) 8340 8341 (defun markdown--wiki-link-search-types () 8342 (let ((ret (and markdown-wiki-link-search-type 8343 (cl-copy-list markdown-wiki-link-search-type)))) 8344 (when (and markdown-wiki-link-search-subdirectories 8345 (not (memq 'sub-directories markdown-wiki-link-search-type))) 8346 (push 'sub-directories ret)) 8347 (when (and markdown-wiki-link-search-parent-directories 8348 (not (memq 'parent-directories markdown-wiki-link-search-type))) 8349 (push 'parent-directories ret)) 8350 ret)) 8351 8352 (defun markdown--project-root () 8353 (or (cl-loop for dir in '(".git" ".hg" ".svn") 8354 when (locate-dominating-file default-directory dir) 8355 return it) 8356 (progn 8357 (require 'project) 8358 (let ((project (project-current t))) 8359 (with-no-warnings 8360 (if (fboundp 'project-root) 8361 (project-root project) 8362 (car (project-roots project)))))))) 8363 8364 (defun markdown-convert-wiki-link-to-filename (name) 8365 "Generate a filename from the wiki link NAME. 8366 Spaces in NAME are replaced with `markdown-link-space-sub-char'. 8367 When in `gfm-mode', follow GitHub's conventions where [[Test Test]] 8368 and [[test test]] both map to Test-test.ext. Look in the current 8369 directory first, then in subdirectories if 8370 `markdown-wiki-link-search-subdirectories' is non-nil, and then 8371 in parent directories if 8372 `markdown-wiki-link-search-parent-directories' is non-nil." 8373 (save-match-data 8374 ;; This function must not overwrite match data(PR #590) 8375 (let* ((basename (replace-regexp-in-string 8376 "[[:space:]\n]" markdown-link-space-sub-char name)) 8377 (basename (if (derived-mode-p 'gfm-mode) 8378 (concat (upcase (substring basename 0 1)) 8379 (downcase (substring basename 1 nil))) 8380 basename)) 8381 (search-types (markdown--wiki-link-search-types)) 8382 directory extension default candidates dir) 8383 (when buffer-file-name 8384 (setq directory (file-name-directory buffer-file-name) 8385 extension (file-name-extension buffer-file-name))) 8386 (setq default (concat basename 8387 (when extension (concat "." extension)))) 8388 (cond 8389 ;; Look in current directory first. 8390 ((or (null buffer-file-name) 8391 (file-exists-p default)) 8392 default) 8393 ;; Possibly search in subdirectories, next. 8394 ((and (memq 'sub-directories search-types) 8395 (setq candidates 8396 (directory-files-recursively 8397 directory (concat "^" default "$")))) 8398 (car candidates)) 8399 ;; Possibly search in parent directories as a last resort. 8400 ((and (memq 'parent-directories search-types) 8401 (setq dir (locate-dominating-file directory default))) 8402 (concat dir default)) 8403 ((and (memq 'project search-types) 8404 (setq candidates 8405 (directory-files-recursively 8406 (markdown--project-root) (concat "^" default "$")))) 8407 (car candidates)) 8408 ;; If nothing is found, return default in current directory. 8409 (t default))))) 8410 8411 (defun markdown-follow-wiki-link (name &optional other) 8412 "Follow the wiki link NAME. 8413 Convert the name to a file name and call `find-file'. Ensure that 8414 the new buffer remains in `markdown-mode'. Open the link in another 8415 window when OTHER is non-nil." 8416 (let ((filename (markdown-convert-wiki-link-to-filename name)) 8417 (wp (when buffer-file-name 8418 (file-name-directory buffer-file-name)))) 8419 (if (not wp) 8420 (user-error "Must be visiting a file") 8421 (when other (other-window 1)) 8422 (let ((default-directory wp)) 8423 (find-file filename))) 8424 (unless (derived-mode-p 'markdown-mode) 8425 (markdown-mode)))) 8426 8427 (defun markdown-follow-wiki-link-at-point (&optional arg) 8428 "Find Wiki Link at point. 8429 With prefix argument ARG, open the file in other window. 8430 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." 8431 (interactive "P") 8432 (if (markdown-wiki-link-p) 8433 (markdown-follow-wiki-link (markdown-wiki-link-link) arg) 8434 (user-error "Point is not at a Wiki Link"))) 8435 8436 (defun markdown-highlight-wiki-link (from to face) 8437 "Highlight the wiki link in the region between FROM and TO using FACE." 8438 (put-text-property from to 'font-lock-face face)) 8439 8440 (defun markdown-unfontify-region-wiki-links (from to) 8441 "Remove wiki link faces from the region specified by FROM and TO." 8442 (interactive "*r") 8443 (let ((modified (buffer-modified-p))) 8444 (remove-text-properties from to '(font-lock-face markdown-link-face)) 8445 (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) 8446 ;; remove-text-properties marks the buffer modified in emacs 24.3, 8447 ;; undo that if it wasn't originally marked modified 8448 (set-buffer-modified-p modified))) 8449 8450 (defun markdown-fontify-region-wiki-links (from to) 8451 "Search region given by FROM and TO for wiki links and fontify them. 8452 If a wiki link is found check to see if the backing file exists 8453 and highlight accordingly." 8454 (goto-char from) 8455 (save-match-data 8456 (while (re-search-forward markdown-regex-wiki-link to t) 8457 (when (not (markdown-code-block-at-point-p)) 8458 (let ((highlight-beginning (match-beginning 1)) 8459 (highlight-end (match-end 1)) 8460 (file-name 8461 (markdown-convert-wiki-link-to-filename 8462 (markdown-wiki-link-link)))) 8463 (if (condition-case nil (file-exists-p file-name) (error nil)) 8464 (markdown-highlight-wiki-link 8465 highlight-beginning highlight-end 'markdown-link-face) 8466 (markdown-highlight-wiki-link 8467 highlight-beginning highlight-end 'markdown-missing-link-face))))))) 8468 8469 (defun markdown-extend-changed-region (from to) 8470 "Extend region given by FROM and TO so that we can fontify all links. 8471 The region is extended to the first newline before and the first 8472 newline after." 8473 ;; start looking for the first new line before 'from 8474 (goto-char from) 8475 (re-search-backward "\n" nil t) 8476 (let ((new-from (point-min)) 8477 (new-to (point-max))) 8478 (if (not (= (point) from)) 8479 (setq new-from (point))) 8480 ;; do the same thing for the first new line after 'to 8481 (goto-char to) 8482 (re-search-forward "\n" nil t) 8483 (if (not (= (point) to)) 8484 (setq new-to (point))) 8485 (cl-values new-from new-to))) 8486 8487 (defun markdown-check-change-for-wiki-link (from to) 8488 "Check region between FROM and TO for wiki links and re-fontify as needed." 8489 (interactive "*r") 8490 (let* ((modified (buffer-modified-p)) 8491 (buffer-undo-list t) 8492 (inhibit-read-only t) 8493 deactivate-mark 8494 buffer-file-truename) 8495 (unwind-protect 8496 (save-excursion 8497 (save-match-data 8498 (save-restriction 8499 (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 8500 ;; Extend the region to fontify so that it starts 8501 ;; and ends at safe places. 8502 (cl-multiple-value-bind (new-from new-to) 8503 (markdown-extend-changed-region from to) 8504 (goto-char new-from) 8505 ;; Only refontify when the range contains text with a 8506 ;; wiki link face or if the wiki link regexp matches. 8507 (when (or (markdown-range-property-any 8508 new-from new-to 'font-lock-face 8509 '(markdown-link-face markdown-missing-link-face)) 8510 (re-search-forward 8511 markdown-regex-wiki-link new-to t)) 8512 ;; Unfontify existing fontification (start from scratch) 8513 (markdown-unfontify-region-wiki-links new-from new-to) 8514 ;; Now do the fontification. 8515 (markdown-fontify-region-wiki-links new-from new-to)))))) 8516 (cursor-intangible-mode -1) 8517 (and (not modified) 8518 (buffer-modified-p) 8519 (set-buffer-modified-p nil))))) 8520 8521 (defun markdown-check-change-for-wiki-link-after-change (from to _) 8522 "Check region between FROM and TO for wiki links and re-fontify as needed. 8523 Designed to be used with the `after-change-functions' hook." 8524 (markdown-check-change-for-wiki-link from to)) 8525 8526 (defun markdown-fontify-buffer-wiki-links () 8527 "Refontify all wiki links in the buffer." 8528 (interactive) 8529 (markdown-check-change-for-wiki-link (point-min) (point-max))) 8530 8531 (defun markdown-toggle-wiki-links (&optional arg) 8532 "Toggle support for wiki links. 8533 With a prefix argument ARG, enable wiki link support if ARG is positive, 8534 and disable it otherwise." 8535 (interactive (list (or current-prefix-arg 'toggle))) 8536 (setq markdown-enable-wiki-links 8537 (if (eq arg 'toggle) 8538 (not markdown-enable-wiki-links) 8539 (> (prefix-numeric-value arg) 0))) 8540 (when (called-interactively-p 'interactive) 8541 (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) 8542 (markdown-reload-extensions)) 8543 8544 (defun markdown-setup-wiki-link-hooks () 8545 "Add or remove hooks for fontifying wiki links. 8546 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." 8547 ;; Anytime text changes make sure it gets fontified correctly 8548 (if (and markdown-enable-wiki-links 8549 markdown-wiki-link-fontify-missing) 8550 (add-hook 'after-change-functions 8551 #'markdown-check-change-for-wiki-link-after-change t t) 8552 (remove-hook 'after-change-functions 8553 #'markdown-check-change-for-wiki-link-after-change t)) 8554 ;; If we left the buffer there is a really good chance we were 8555 ;; creating one of the wiki link documents. Make sure we get 8556 ;; refontified when we come back. 8557 (if (and markdown-enable-wiki-links 8558 markdown-wiki-link-fontify-missing) 8559 (progn 8560 (add-hook 'window-configuration-change-hook 8561 #'markdown-fontify-buffer-wiki-links t t) 8562 (markdown-fontify-buffer-wiki-links)) 8563 (remove-hook 'window-configuration-change-hook 8564 #'markdown-fontify-buffer-wiki-links t) 8565 (markdown-unfontify-region-wiki-links (point-min) (point-max)))) 8566 8567 8568 ;;; Following & Doing ========================================================= 8569 8570 (defun markdown-follow-thing-at-point (arg) 8571 "Follow thing at point if possible, such as a reference link or wiki link. 8572 Opens inline and reference links in a browser. Opens wiki links 8573 to other files in the current window, or the another window if 8574 ARG is non-nil. 8575 See `markdown-follow-link-at-point' and 8576 `markdown-follow-wiki-link-at-point'." 8577 (interactive "P") 8578 (cond ((markdown-link-p) 8579 (markdown-follow-link-at-point)) 8580 ((markdown-wiki-link-p) 8581 (markdown-follow-wiki-link-at-point arg)) 8582 (t 8583 (let* ((values (markdown-link-at-pos (point))) 8584 (url (nth 3 values))) 8585 (unless url 8586 (user-error "Nothing to follow at point")) 8587 (markdown--browse-url url))))) 8588 8589 (defun markdown-do () 8590 "Do something sensible based on context at point. 8591 Jumps between reference links and definitions; between footnote 8592 markers and footnote text." 8593 (interactive) 8594 (cond 8595 ;; Footnote definition 8596 ((markdown-footnote-text-positions) 8597 (markdown-footnote-return)) 8598 ;; Footnote marker 8599 ((markdown-footnote-marker-positions) 8600 (markdown-footnote-goto-text)) 8601 ;; Reference link 8602 ((thing-at-point-looking-at markdown-regex-link-reference) 8603 (markdown-reference-goto-definition)) 8604 ;; Reference definition 8605 ((thing-at-point-looking-at markdown-regex-reference-definition) 8606 (markdown-reference-goto-link (match-string-no-properties 2))) 8607 ;; Link 8608 ((or (markdown-link-p) (markdown-wiki-link-p)) 8609 (markdown-follow-thing-at-point nil)) 8610 ;; GFM task list item 8611 ((markdown-gfm-task-list-item-at-point) 8612 (markdown-toggle-gfm-checkbox)) 8613 ;; Align table 8614 ((markdown-table-at-point-p) 8615 (call-interactively #'markdown-table-align)) 8616 ;; Otherwise 8617 (t 8618 (markdown-insert-gfm-checkbox)))) 8619 8620 8621 ;;; Miscellaneous ============================================================= 8622 8623 (defun markdown-compress-whitespace-string (str) 8624 "Compress whitespace in STR and return result. 8625 Leading and trailing whitespace is removed. Sequences of multiple 8626 spaces, tabs, and newlines are replaced with single spaces." 8627 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" 8628 (replace-regexp-in-string "[ \t\n]+" " " str))) 8629 8630 (defun markdown--substitute-command-keys (string) 8631 "Like `substitute-command-keys' but, but prefers control characters. 8632 First pass STRING to `substitute-command-keys' and then 8633 substitute `C-i` for `TAB` and `C-m` for `RET`." 8634 (replace-regexp-in-string 8635 "\\<TAB\\>" "C-i" 8636 (replace-regexp-in-string 8637 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) 8638 8639 (defun markdown-line-number-at-pos (&optional pos) 8640 "Return (narrowed) buffer line number at position POS. 8641 If POS is nil, use current buffer location. 8642 This is an exact copy of `line-number-at-pos' for use in emacs21." 8643 (let ((opoint (or pos (point))) start) 8644 (save-excursion 8645 (goto-char (point-min)) 8646 (setq start (point)) 8647 (goto-char opoint) 8648 (forward-line 0) 8649 (1+ (count-lines start (point)))))) 8650 8651 (defun markdown-inside-link-p () 8652 "Return t if point is within a link." 8653 (save-match-data 8654 (thing-at-point-looking-at (markdown-make-regex-link-generic)))) 8655 8656 (defun markdown-line-is-reference-definition-p () 8657 "Return whether the current line is a (non-footnote) reference definition." 8658 (save-excursion 8659 (move-beginning-of-line 1) 8660 (and (looking-at-p markdown-regex-reference-definition) 8661 (not (looking-at-p "[ \t]*\\[^"))))) 8662 8663 (defun markdown-adaptive-fill-function () 8664 "Return prefix for filling paragraph or nil if not determined." 8665 (cond 8666 ;; List item inside blockquote 8667 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") 8668 (replace-regexp-in-string 8669 "[0-9\\.*+-]" " " (match-string-no-properties 0))) 8670 ;; Blockquote 8671 ((looking-at markdown-regex-blockquote) 8672 (buffer-substring-no-properties (match-beginning 0) (match-end 2))) 8673 ;; List items 8674 ((looking-at markdown-regex-list) 8675 (match-string-no-properties 0)) 8676 ;; Footnote definition 8677 ((looking-at-p markdown-regex-footnote-definition) 8678 " ") ; four spaces 8679 ;; No match 8680 (t nil))) 8681 8682 (defun markdown-fill-paragraph (&optional justify) 8683 "Fill paragraph at or after point. 8684 This function is like \\[fill-paragraph], but it skips Markdown 8685 code blocks. If the point is in a code block, or just before one, 8686 do not fill. Otherwise, call `fill-paragraph' as usual. If 8687 JUSTIFY is non-nil, justify text as well. Since this function 8688 handles filling itself, it always returns t so that 8689 `fill-paragraph' doesn't run." 8690 (interactive "P") 8691 (unless (or (markdown-code-block-at-point-p) 8692 (save-excursion 8693 (back-to-indentation) 8694 (skip-syntax-forward "-") 8695 (markdown-code-block-at-point-p))) 8696 (let ((fill-prefix (save-excursion 8697 (goto-char (line-beginning-position)) 8698 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") 8699 (match-string-no-properties 1))))) 8700 (fill-paragraph justify))) 8701 t) 8702 8703 (defun markdown-fill-forward-paragraph (&optional arg) 8704 "Function used by `fill-paragraph' to move over ARG paragraphs. 8705 This is a `fill-forward-paragraph-function' for `markdown-mode'. 8706 It is called with a single argument specifying the number of 8707 paragraphs to move. Just like `forward-paragraph', it should 8708 return the number of paragraphs left to move." 8709 (or arg (setq arg 1)) 8710 (if (> arg 0) 8711 ;; With positive ARG, move across ARG non-code-block paragraphs, 8712 ;; one at a time. When passing a code block, don't decrement ARG. 8713 (while (and (not (eobp)) 8714 (> arg 0) 8715 (= (forward-paragraph 1) 0) 8716 (or (markdown-code-block-at-pos (line-beginning-position 0)) 8717 (setq arg (1- arg))))) 8718 ;; Move backward by one paragraph with negative ARG (always -1). 8719 (let ((start (point))) 8720 (setq arg (forward-paragraph arg)) 8721 (while (and (not (eobp)) 8722 (progn (move-to-left-margin) (not (eobp))) 8723 (looking-at-p paragraph-separate)) 8724 (forward-line 1)) 8725 (cond 8726 ;; Move point past whitespace following list marker. 8727 ((looking-at markdown-regex-list) 8728 (goto-char (match-end 0))) 8729 ;; Move point past whitespace following pipe at beginning of line 8730 ;; to handle Pandoc line blocks. 8731 ((looking-at "^|\\s-*") 8732 (goto-char (match-end 0))) 8733 ;; Return point if the paragraph passed was a code block. 8734 ((markdown-code-block-at-pos (line-beginning-position 2)) 8735 (goto-char start))))) 8736 arg) 8737 8738 (defun markdown--inhibit-electric-quote () 8739 "Function added to `electric-quote-inhibit-functions'. 8740 Return non-nil if the quote has been inserted inside a code block 8741 or span." 8742 (let ((pos (1- (point)))) 8743 (or (markdown-inline-code-at-pos pos) 8744 (markdown-code-block-at-pos pos)))) 8745 8746 8747 ;;; Extension Framework ======================================================= 8748 8749 (defun markdown-reload-extensions () 8750 "Check settings, update font-lock keywords and hooks, and re-fontify buffer." 8751 (interactive) 8752 (when (derived-mode-p 'markdown-mode) 8753 ;; Refontify buffer 8754 (font-lock-flush) 8755 ;; Add or remove hooks related to extensions 8756 (markdown-setup-wiki-link-hooks))) 8757 8758 (defun markdown-handle-local-variables () 8759 "Run in `hack-local-variables-hook' to update font lock rules. 8760 Checks to see if there is actually a ‘markdown-mode’ file local variable 8761 before regenerating font-lock rules for extensions." 8762 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) 8763 (assoc 'markdown-enable-math file-local-variables-alist)) 8764 (when (assoc 'markdown-enable-math file-local-variables-alist) 8765 (markdown-toggle-math markdown-enable-math)) 8766 (markdown-reload-extensions))) 8767 8768 8769 ;;; Math Support ============================================================== 8770 8771 (defconst markdown-mode-font-lock-keywords-math 8772 (list 8773 ;; Equation reference (eq:foo) 8774 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) 8775 (2 markdown-reference-face) 8776 (3 markdown-markup-face))) 8777 ;; Equation reference \eqref{foo} 8778 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) 8779 (2 markdown-reference-face) 8780 (3 markdown-markup-face)))) 8781 "Font lock keywords to add and remove when toggling math support.") 8782 8783 (defun markdown-toggle-math (&optional arg) 8784 "Toggle support for inline and display LaTeX math expressions. 8785 With a prefix argument ARG, enable math mode if ARG is positive, 8786 and disable it otherwise. If called from Lisp, enable the mode 8787 if ARG is omitted or nil." 8788 (interactive (list (or current-prefix-arg 'toggle))) 8789 (setq markdown-enable-math 8790 (if (eq arg 'toggle) 8791 (not markdown-enable-math) 8792 (> (prefix-numeric-value arg) 0))) 8793 (if markdown-enable-math 8794 (font-lock-add-keywords 8795 'markdown-mode markdown-mode-font-lock-keywords-math) 8796 (font-lock-remove-keywords 8797 'markdown-mode markdown-mode-font-lock-keywords-math)) 8798 (when (called-interactively-p 'interactive) 8799 (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) 8800 (markdown-reload-extensions)) 8801 8802 8803 ;;; GFM Checkboxes ============================================================ 8804 8805 (define-button-type 'markdown-gfm-checkbox-button 8806 'follow-link t 8807 'face 'markdown-gfm-checkbox-face 8808 'mouse-face 'markdown-highlight-face 8809 'action #'markdown-toggle-gfm-checkbox-button) 8810 8811 (defun markdown-gfm-task-list-item-at-point (&optional bounds) 8812 "Return non-nil if there is a GFM task list item at the point. 8813 Optionally, the list item BOUNDS may be given if available, as 8814 returned by `markdown-cur-list-item-bounds'. When a task list item 8815 is found, the return value is the same value returned by 8816 `markdown-cur-list-item-bounds'." 8817 (unless bounds 8818 (setq bounds (markdown-cur-list-item-bounds))) 8819 (> (length (nth 5 bounds)) 0)) 8820 8821 (defun markdown-insert-gfm-checkbox () 8822 "Add GFM checkbox at point. 8823 Returns t if added. 8824 Returns nil if non-applicable." 8825 (interactive) 8826 (let ((bounds (markdown-cur-list-item-bounds))) 8827 (if bounds 8828 (unless (cl-sixth bounds) 8829 (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) 8830 (markup "[ ] ")) 8831 (if (< pos (point)) 8832 (save-excursion 8833 (goto-char pos) 8834 (insert markup)) 8835 (goto-char pos) 8836 (insert markup)) 8837 (syntax-propertize (+ (cl-second bounds) 4)) 8838 t)) 8839 (unless (save-excursion 8840 (back-to-indentation) 8841 (or (markdown-list-item-at-point-p) 8842 (markdown-heading-at-point) 8843 (markdown-in-comment-p) 8844 (markdown-code-block-at-point-p))) 8845 (let ((pos (save-excursion 8846 (back-to-indentation) 8847 (point))) 8848 (markup (concat (or (save-excursion 8849 (beginning-of-line 0) 8850 (cl-fifth (markdown-cur-list-item-bounds))) 8851 markdown-unordered-list-item-prefix) 8852 "[ ] "))) 8853 (if (< pos (point)) 8854 (save-excursion 8855 (goto-char pos) 8856 (insert markup)) 8857 (goto-char pos) 8858 (insert markup)) 8859 (syntax-propertize (line-end-position)) 8860 t))))) 8861 8862 (defun markdown-toggle-gfm-checkbox () 8863 "Toggle GFM checkbox at point. 8864 Returns the resulting status as a string, either \"[x]\" or \"[ ]\". 8865 Returns nil if there is no task list item at the point." 8866 (interactive) 8867 (save-match-data 8868 (save-excursion 8869 (let ((bounds (markdown-cur-list-item-bounds))) 8870 (when bounds 8871 ;; Move to beginning of task list item 8872 (goto-char (cl-first bounds)) 8873 ;; Advance to column of first non-whitespace after marker 8874 (forward-char (cl-fourth bounds)) 8875 (cond ((looking-at "\\[ \\]") 8876 (replace-match 8877 (if markdown-gfm-uppercase-checkbox "[X]" "[x]") 8878 nil t) 8879 (match-string-no-properties 0)) 8880 ((looking-at "\\[[xX]\\]") 8881 (replace-match "[ ]" nil t) 8882 (match-string-no-properties 0)))))))) 8883 8884 (defun markdown-toggle-gfm-checkbox-button (button) 8885 "Toggle GFM checkbox BUTTON on click." 8886 (save-match-data 8887 (save-excursion 8888 (goto-char (button-start button)) 8889 (markdown-toggle-gfm-checkbox)))) 8890 8891 (defun markdown-make-gfm-checkboxes-buttons (start end) 8892 "Make GFM checkboxes buttons in region between START and END." 8893 (save-excursion 8894 (goto-char start) 8895 (let ((case-fold-search t)) 8896 (save-excursion 8897 (while (re-search-forward markdown-regex-gfm-checkbox end t) 8898 (make-button (match-beginning 1) (match-end 1) 8899 :type 'markdown-gfm-checkbox-button)))))) 8900 8901 ;; Called when any modification is made to buffer text. 8902 (defun markdown-gfm-checkbox-after-change-function (beg end _) 8903 "Add to `after-change-functions' to setup GFM checkboxes as buttons. 8904 BEG and END are the limits of scanned region." 8905 (save-excursion 8906 (save-match-data 8907 ;; Rescan between start of line from `beg' and start of line after `end'. 8908 (markdown-make-gfm-checkboxes-buttons 8909 (progn (goto-char beg) (beginning-of-line) (point)) 8910 (progn (goto-char end) (forward-line 1) (point)))))) 8911 8912 (defun markdown-remove-gfm-checkbox-overlays () 8913 "Remove all GFM checkbox overlays in buffer." 8914 (save-excursion 8915 (save-restriction 8916 (widen) 8917 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) 8918 8919 8920 ;;; Display inline image ====================================================== 8921 8922 (defvar-local markdown-inline-image-overlays nil) 8923 8924 (defun markdown-remove-inline-images () 8925 "Remove inline image overlays from image links in the buffer. 8926 This can be toggled with `markdown-toggle-inline-images' 8927 or \\[markdown-toggle-inline-images]." 8928 (interactive) 8929 (mapc #'delete-overlay markdown-inline-image-overlays) 8930 (setq markdown-inline-image-overlays nil) 8931 (when (fboundp 'clear-image-cache) (clear-image-cache))) 8932 8933 (defcustom markdown-display-remote-images nil 8934 "If non-nil, download and display remote images. 8935 See also `markdown-inline-image-overlays'. 8936 8937 Only image URLs specified with a protocol listed in 8938 `markdown-remote-image-protocols' are displayed." 8939 :group 'markdown 8940 :type 'boolean) 8941 8942 (defcustom markdown-remote-image-protocols '("https") 8943 "List of protocols to use to download remote images. 8944 See also `markdown-display-remote-images'." 8945 :group 'markdown 8946 :type '(repeat string)) 8947 8948 (defvar markdown--remote-image-cache 8949 (make-hash-table :test 'equal) 8950 "A map from URLs to image paths.") 8951 8952 (defun markdown--get-remote-image (url) 8953 "Retrieve the image path for a given URL." 8954 (or (gethash url markdown--remote-image-cache) 8955 (let ((dl-path (make-temp-file "markdown-mode--image"))) 8956 (require 'url) 8957 (url-copy-file url dl-path t) 8958 (puthash url dl-path markdown--remote-image-cache)))) 8959 8960 (defun markdown-display-inline-images () 8961 "Add inline image overlays to image links in the buffer. 8962 This can be toggled with `markdown-toggle-inline-images' 8963 or \\[markdown-toggle-inline-images]." 8964 (interactive) 8965 (unless (display-images-p) 8966 (error "Cannot show images")) 8967 (save-excursion 8968 (save-restriction 8969 (widen) 8970 (goto-char (point-min)) 8971 (while (re-search-forward markdown-regex-link-inline nil t) 8972 (let* ((start (match-beginning 0)) 8973 (imagep (match-beginning 1)) 8974 (end (match-end 0)) 8975 (file (match-string-no-properties 6))) 8976 (when (and imagep 8977 (not (zerop (length file)))) 8978 (unless (file-exists-p file) 8979 (let* ((download-file (funcall markdown-translate-filename-function file)) 8980 (valid-url (ignore-errors 8981 (member (downcase (url-type (url-generic-parse-url download-file))) 8982 markdown-remote-image-protocols)))) 8983 (if (and markdown-display-remote-images valid-url) 8984 (setq file (markdown--get-remote-image download-file)) 8985 (when (not valid-url) 8986 ;; strip query parameter 8987 (setq file (replace-regexp-in-string "?.+\\'" "" file)) 8988 (unless (file-exists-p file) 8989 (setq file (url-unhex-string file))))))) 8990 (when (file-exists-p file) 8991 (let* ((abspath (if (file-name-absolute-p file) 8992 file 8993 (concat default-directory file))) 8994 (image 8995 (cond ((and markdown-max-image-size 8996 (image-type-available-p 'imagemagick)) 8997 (create-image 8998 abspath 'imagemagick nil 8999 :max-width (car markdown-max-image-size) 9000 :max-height (cdr markdown-max-image-size))) 9001 (markdown-max-image-size 9002 (create-image abspath nil nil 9003 :max-width (car markdown-max-image-size) 9004 :max-height (cdr markdown-max-image-size))) 9005 (t (create-image abspath))))) 9006 (when image 9007 (let ((ov (make-overlay start end))) 9008 (overlay-put ov 'display image) 9009 (overlay-put ov 'face 'default) 9010 (push ov markdown-inline-image-overlays))))))))))) 9011 9012 (defun markdown-toggle-inline-images () 9013 "Toggle inline image overlays in the buffer." 9014 (interactive) 9015 (if markdown-inline-image-overlays 9016 (markdown-remove-inline-images) 9017 (markdown-display-inline-images))) 9018 9019 9020 ;;; GFM Code Block Fontification ============================================== 9021 9022 (defcustom markdown-fontify-code-blocks-natively nil 9023 "When non-nil, fontify code in code blocks using the native major mode. 9024 This only works for fenced code blocks where the language is 9025 specified where we can automatically determine the appropriate 9026 mode to use. The language to mode mapping may be customized by 9027 setting the variable `markdown-code-lang-modes'." 9028 :group 'markdown 9029 :type 'boolean 9030 :safe #'booleanp 9031 :package-version '(markdown-mode . "2.3")) 9032 9033 (defcustom markdown-fontify-code-block-default-mode nil 9034 "Default mode to use to fontify code blocks. 9035 This mode is used when automatic detection fails, such as for GFM 9036 code blocks with no language specified." 9037 :group 'markdown 9038 :type '(choice function (const :tag "None" nil)) 9039 :package-version '(markdown-mode . "2.4")) 9040 9041 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg) 9042 "Toggle the native fontification of code blocks. 9043 With a prefix argument ARG, enable if ARG is positive, 9044 and disable otherwise." 9045 (interactive (list (or current-prefix-arg 'toggle))) 9046 (setq markdown-fontify-code-blocks-natively 9047 (if (eq arg 'toggle) 9048 (not markdown-fontify-code-blocks-natively) 9049 (> (prefix-numeric-value arg) 0))) 9050 (when (called-interactively-p 'interactive) 9051 (message "markdown-mode native code block fontification %s" 9052 (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) 9053 (markdown-reload-extensions)) 9054 9055 ;; This is based on `org-src-lang-modes' from org-src.el 9056 (defcustom markdown-code-lang-modes 9057 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) 9058 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) 9059 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) 9060 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) 9061 ("bash" . sh-mode)) 9062 "Alist mapping languages to their major mode. 9063 The key is the language name, the value is the major mode. For 9064 many languages this is simple, but for language where this is not 9065 the case, this variable provides a way to simplify things on the 9066 user side. For example, there is no ocaml-mode in Emacs, but the 9067 mode to use is `tuareg-mode'." 9068 :group 'markdown 9069 :type '(repeat 9070 (cons 9071 (string "Language name") 9072 (symbol "Major mode"))) 9073 :package-version '(markdown-mode . "2.3")) 9074 9075 (defun markdown-get-lang-mode (lang) 9076 "Return major mode that should be used for LANG. 9077 LANG is a string, and the returned major mode is a symbol." 9078 (cl-find-if 9079 #'markdown--lang-mode-predicate 9080 (nconc (list (cdr (assoc lang markdown-code-lang-modes)) 9081 (cdr (assoc (downcase lang) markdown-code-lang-modes))) 9082 (and (fboundp 'treesit-language-available-p) 9083 (list (and (treesit-language-available-p (intern lang)) 9084 (intern (concat lang "-ts-mode"))) 9085 (and (treesit-language-available-p (intern (downcase lang))) 9086 (intern (concat (downcase lang) "-ts-mode"))))) 9087 (list 9088 (intern (concat lang "-mode")) 9089 (intern (concat (downcase lang) "-mode")))))) 9090 9091 (defun markdown--lang-mode-predicate (mode) 9092 (and mode 9093 (fboundp mode) 9094 (or 9095 ;; https://github.com/jrblevin/markdown-mode/issues/787 9096 ;; major-mode-remap-alist was introduced at Emacs 29.1 9097 (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) 9098 for func = (cdr pair) 9099 thereis (and (atom func) (eq mode func))) 9100 ;; https://github.com/jrblevin/markdown-mode/issues/761 9101 (cl-loop for pair in auto-mode-alist 9102 for func = (cdr pair) 9103 thereis (and (atom func) (eq mode func)))))) 9104 9105 (defun markdown-fontify-code-blocks-generic (matcher last) 9106 "Add text properties to next code block from point to LAST. 9107 Use matching function MATCHER." 9108 (when (funcall matcher last) 9109 (save-excursion 9110 (save-match-data 9111 (let* ((start (match-beginning 0)) 9112 (end (match-end 0)) 9113 ;; Find positions outside opening and closing backquotes. 9114 (bol-prev (progn (goto-char start) 9115 (if (bolp) (line-beginning-position 0) (line-beginning-position)))) 9116 (eol-next (progn (goto-char end) 9117 (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) 9118 lang) 9119 (if (and markdown-fontify-code-blocks-natively 9120 (or (setq lang (markdown-code-block-lang)) 9121 markdown-fontify-code-block-default-mode)) 9122 (markdown-fontify-code-block-natively lang start end) 9123 (add-text-properties start end '(face markdown-pre-face))) 9124 ;; Set background for block as well as opening and closing lines. 9125 (font-lock-append-text-property 9126 bol-prev eol-next 'face 'markdown-code-face) 9127 ;; Set invisible property for lines before and after, including newline. 9128 (add-text-properties bol-prev start '(invisible markdown-markup)) 9129 (add-text-properties end eol-next '(invisible markdown-markup))))) 9130 t)) 9131 9132 (defun markdown-fontify-gfm-code-blocks (last) 9133 "Add text properties to next GFM code block from point to LAST." 9134 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) 9135 9136 (defun markdown-fontify-fenced-code-blocks (last) 9137 "Add text properties to next tilde fenced code block from point to LAST." 9138 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) 9139 9140 ;; Based on `org-src-font-lock-fontify-block' from org-src.el. 9141 (defun markdown-fontify-code-block-natively (lang start end) 9142 "Fontify given GFM or fenced code block. 9143 This function is called by Emacs for automatic fontification when 9144 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the 9145 language used in the block. START and END specify the block 9146 position." 9147 (let ((lang-mode (if lang (markdown-get-lang-mode lang) 9148 markdown-fontify-code-block-default-mode))) 9149 (when (fboundp lang-mode) 9150 (let ((string (buffer-substring-no-properties start end)) 9151 (modified (buffer-modified-p)) 9152 (markdown-buffer (current-buffer)) pos next) 9153 (remove-text-properties start end '(face nil)) 9154 (with-current-buffer 9155 (get-buffer-create 9156 (format " *markdown-code-fontification:%s*" (symbol-name lang-mode))) 9157 ;; Make sure that modification hooks are not inhibited in 9158 ;; the org-src-fontification buffer in case we're called 9159 ;; from `jit-lock-function' (Bug#25132). 9160 (let ((inhibit-modification-hooks nil)) 9161 (delete-region (point-min) (point-max)) 9162 (insert string " ")) ;; so there's a final property change 9163 (unless (eq major-mode lang-mode) (funcall lang-mode)) 9164 (font-lock-ensure) 9165 (setq pos (point-min)) 9166 (while (setq next (next-single-property-change pos 'face)) 9167 (let ((val (get-text-property pos 'face))) 9168 (when val 9169 (put-text-property 9170 (+ start (1- pos)) (1- (+ start next)) 'face 9171 val markdown-buffer))) 9172 (setq pos next))) 9173 (add-text-properties 9174 start end 9175 '(font-lock-fontified t fontified t font-lock-multiline t)) 9176 (set-buffer-modified-p modified))))) 9177 9178 (require 'edit-indirect nil t) 9179 (defvar edit-indirect-guess-mode-function) 9180 (defvar edit-indirect-after-commit-functions) 9181 9182 (defun markdown--edit-indirect-after-commit-function (beg end) 9183 "Corrective logic run on code block content from lines BEG to END. 9184 Restores code block indentation from BEG to END, and ensures trailing newlines 9185 at the END of code blocks." 9186 ;; ensure trailing newlines 9187 (goto-char end) 9188 (unless (eq (char-before) ?\n) 9189 (insert "\n")) 9190 ;; restore code block indentation 9191 (goto-char (- beg 1)) 9192 (let ((block-indentation (current-indentation))) 9193 (when (> block-indentation 0) 9194 (indent-rigidly beg end block-indentation))) 9195 (font-lock-ensure)) 9196 9197 (defun markdown-edit-code-block () 9198 "Edit Markdown code block in an indirect buffer." 9199 (interactive) 9200 (save-excursion 9201 (if (fboundp 'edit-indirect-region) 9202 (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) 9203 (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) 9204 (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) 9205 (if (and begin end) 9206 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) 9207 (lang (markdown-code-block-lang)) 9208 (mode (or (and lang (markdown-get-lang-mode lang)) 9209 markdown-edit-code-block-default-mode)) 9210 (edit-indirect-guess-mode-function 9211 (lambda (_parent-buffer _beg _end) 9212 (funcall mode))) 9213 (indirect-buf (edit-indirect-region begin end 'display-buffer))) 9214 ;; reset `sh-shell' when indirect buffer 9215 (when (and (not (member system-type '(ms-dos windows-nt))) 9216 (member mode '(shell-script-mode sh-mode)) 9217 (member lang (append 9218 (mapcar (lambda (e) (symbol-name (car e))) 9219 sh-ancestor-alist) 9220 '("csh" "rc" "sh")))) 9221 (with-current-buffer indirect-buf 9222 (sh-set-shell lang))) 9223 (when (> indentation 0) ;; un-indent in edit-indirect buffer 9224 (with-current-buffer indirect-buf 9225 (indent-rigidly (point-min) (point-max) (- indentation))))) 9226 (user-error "Not inside a GFM or tilde fenced code block"))) 9227 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") 9228 (progn (package-refresh-contents) 9229 (package-install 'edit-indirect) 9230 (markdown-edit-code-block)))))) 9231 9232 9233 ;;; Table Editing ============================================================= 9234 9235 ;; These functions were originally adapted from `org-table.el'. 9236 9237 ;; General helper functions 9238 9239 (defmacro markdown--with-gensyms (symbols &rest body) 9240 (declare (debug (sexp body)) (indent 1)) 9241 `(let ,(mapcar (lambda (s) 9242 `(,s (make-symbol (concat "--" (symbol-name ',s))))) 9243 symbols) 9244 ,@body)) 9245 9246 (defun markdown--split-string (string &optional separators) 9247 "Splits STRING into substrings at SEPARATORS. 9248 SEPARATORS is a regular expression. If nil it defaults to 9249 `split-string-default-separators'. This version returns no empty 9250 strings if there are matches at the beginning and end of string." 9251 (let ((start 0) notfirst list) 9252 (while (and (string-match 9253 (or separators split-string-default-separators) 9254 string 9255 (if (and notfirst 9256 (= start (match-beginning 0)) 9257 (< start (length string))) 9258 (1+ start) start)) 9259 (< (match-beginning 0) (length string))) 9260 (setq notfirst t) 9261 (or (eq (match-beginning 0) 0) 9262 (and (eq (match-beginning 0) (match-end 0)) 9263 (eq (match-beginning 0) start)) 9264 (push (substring string start (match-beginning 0)) list)) 9265 (setq start (match-end 0))) 9266 (or (eq start (length string)) 9267 (push (substring string start) list)) 9268 (nreverse list))) 9269 9270 (defun markdown--string-width (s) 9271 "Return width of string S. 9272 This version ignores characters with invisibility property 9273 `markdown-markup'." 9274 (let (b) 9275 (when (or (eq t buffer-invisibility-spec) 9276 (member 'markdown-markup buffer-invisibility-spec)) 9277 (while (setq b (text-property-any 9278 0 (length s) 9279 'invisible 'markdown-markup s)) 9280 (setq s (concat 9281 (substring s 0 b) 9282 (substring s (or (next-single-property-change 9283 b 'invisible s) 9284 (length s)))))))) 9285 (string-width s)) 9286 9287 (defun markdown--remove-invisible-markup (s) 9288 "Remove Markdown markup from string S. 9289 This version removes characters with invisibility property 9290 `markdown-markup'." 9291 (let (b) 9292 (while (setq b (text-property-any 9293 0 (length s) 9294 'invisible 'markdown-markup s)) 9295 (setq s (concat 9296 (substring s 0 b) 9297 (substring s (or (next-single-property-change 9298 b 'invisible s) 9299 (length s))))))) 9300 s) 9301 9302 ;; Functions for maintaining tables 9303 9304 (defvar markdown-table-at-point-p-function #'markdown--table-at-point-p 9305 "Function to decide if point is inside a table. 9306 9307 The indirection serves to differentiate between standard markdown 9308 tables and gfm tables which are less strict about the markup.") 9309 9310 (defconst markdown-table-line-regexp "^[ \t]*|" 9311 "Regexp matching any line inside a table.") 9312 9313 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]" 9314 "Regexp matching hline inside a table.") 9315 9316 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" 9317 "Regexp matching dline inside a table.") 9318 9319 (defun markdown-table-at-point-p () 9320 "Return non-nil when point is inside a table." 9321 (funcall markdown-table-at-point-p-function)) 9322 9323 (defun markdown--table-at-point-p () 9324 "Return non-nil when point is inside a table." 9325 (save-excursion 9326 (beginning-of-line) 9327 (and (looking-at-p markdown-table-line-regexp) 9328 (not (markdown-code-block-at-point-p))))) 9329 9330 (defconst gfm-table-line-regexp "^.?*|" 9331 "Regexp matching any line inside a table.") 9332 9333 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+" 9334 "Regexp matching hline inside a table.") 9335 9336 ;; GFM simplified tables syntax is as follows: 9337 ;; - A header line for the column names, this is any text 9338 ;; separated by `|'. 9339 ;; - Followed by a string -|-|- ..., the number of dashes is optional 9340 ;; but must be higher than 1. The number of separators should match 9341 ;; the number of columns. 9342 ;; - Followed by the rows of data, which has the same format as the 9343 ;; header line. 9344 ;; Example: 9345 ;; 9346 ;; foo | bar 9347 ;; ------|--------- 9348 ;; bar | baz 9349 ;; bar | baz 9350 (defun gfm--table-at-point-p () 9351 "Return non-nil when point is inside a gfm-compatible table." 9352 (or (markdown--table-at-point-p) 9353 (save-excursion 9354 (beginning-of-line) 9355 (when (looking-at-p gfm-table-line-regexp) 9356 ;; we might be at the first line of the table, check if the 9357 ;; line below is the hline 9358 (or (save-excursion 9359 (forward-line 1) 9360 (looking-at-p gfm-table-hline-regexp)) 9361 ;; go up to find the header 9362 (catch 'done 9363 (while (looking-at-p gfm-table-line-regexp) 9364 (cond 9365 ((looking-at-p gfm-table-hline-regexp) 9366 (throw 'done t)) 9367 ((bobp) 9368 (throw 'done nil))) 9369 (forward-line -1)) 9370 nil)))))) 9371 9372 (defun markdown-table-hline-at-point-p () 9373 "Return non-nil when point is on a hline in a table. 9374 This function assumes point is on a table." 9375 (save-excursion 9376 (beginning-of-line) 9377 (looking-at-p markdown-table-hline-regexp))) 9378 9379 (defun markdown-table-begin () 9380 "Find the beginning of the table and return its position. 9381 This function assumes point is on a table." 9382 (save-excursion 9383 (while (and (not (bobp)) 9384 (markdown-table-at-point-p)) 9385 (forward-line -1)) 9386 (unless (or (eobp) 9387 (markdown-table-at-point-p)) 9388 (forward-line 1)) 9389 (point))) 9390 9391 (defun markdown-table-end () 9392 "Find the end of the table and return its position. 9393 This function assumes point is on a table." 9394 (save-excursion 9395 (while (and (not (eobp)) 9396 (markdown-table-at-point-p)) 9397 (forward-line 1)) 9398 (point))) 9399 9400 (defun markdown-table-get-dline () 9401 "Return index of the table data line at point. 9402 This function assumes point is on a table." 9403 (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) 9404 (save-excursion 9405 (goto-char (markdown-table-begin)) 9406 (while (and (re-search-forward 9407 markdown-table-dline-regexp end t) 9408 (setq cnt (1+ cnt)) 9409 (< (line-end-position) pos)))) 9410 cnt)) 9411 9412 (defun markdown--thing-at-wiki-link (pos) 9413 (when markdown-enable-wiki-links 9414 (save-excursion 9415 (save-match-data 9416 (goto-char pos) 9417 (thing-at-point-looking-at markdown-regex-wiki-link))))) 9418 9419 (defun markdown-table-get-column () 9420 "Return table column at point. 9421 This function assumes point is on a table." 9422 (let ((pos (point)) (cnt 0)) 9423 (save-excursion 9424 (beginning-of-line) 9425 (while (search-forward "|" pos t) 9426 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9427 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9428 (setq cnt (1+ cnt))))) 9429 cnt)) 9430 9431 (defun markdown-table-get-cell (&optional n) 9432 "Return the content of the cell in column N of current row. 9433 N defaults to column at point. This function assumes point is on 9434 a table." 9435 (and n (markdown-table-goto-column n)) 9436 (skip-chars-backward "^|\n") (backward-char 1) 9437 (if (looking-at "|[^|\r\n]*") 9438 (let* ((pos (match-beginning 0)) 9439 (val (buffer-substring (1+ pos) (match-end 0)))) 9440 (goto-char (min (line-end-position) (+ 2 pos))) 9441 ;; Trim whitespaces 9442 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) 9443 val (replace-regexp-in-string "[ \t]+\\'" "" val))) 9444 (forward-char 1) "")) 9445 9446 (defun markdown-table-goto-dline (n) 9447 "Go to the Nth data line in the table at point. 9448 Return t when the line exists, nil otherwise. This function 9449 assumes point is on a table." 9450 (goto-char (markdown-table-begin)) 9451 (let ((end (markdown-table-end)) (cnt 0)) 9452 (while (and (re-search-forward 9453 markdown-table-dline-regexp end t) 9454 (< (setq cnt (1+ cnt)) n))) 9455 (= cnt n))) 9456 9457 (defun markdown-table-goto-column (n &optional on-delim) 9458 "Go to the Nth column in the table line at point. 9459 With optional argument ON-DELIM, stop with point before the left 9460 delimiter of the cell. If there are less than N cells, just go 9461 beyond the last delimiter. This function assumes point is on a 9462 table." 9463 (beginning-of-line 1) 9464 (when (> n 0) 9465 (while (and (> n 0) (search-forward "|" (line-end-position) t)) 9466 (when (and (not (looking-back "\\\\|" (line-beginning-position))) 9467 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9468 (cl-decf n))) 9469 (if on-delim 9470 (backward-char 1) 9471 (when (looking-at " ") (forward-char 1))))) 9472 9473 (defmacro markdown-table-save-cell (&rest body) 9474 "Save cell at point, execute BODY and restore cell. 9475 This function assumes point is on a table." 9476 (declare (debug (body))) 9477 (markdown--with-gensyms (line column) 9478 `(let ((,line (copy-marker (line-beginning-position))) 9479 (,column (markdown-table-get-column))) 9480 (unwind-protect 9481 (progn ,@body) 9482 (goto-char ,line) 9483 (markdown-table-goto-column ,column) 9484 (set-marker ,line nil))))) 9485 9486 (defun markdown-table-blank-line (s) 9487 "Convert a table line S into a line with blank cells." 9488 (if (string-match "^[ \t]*|-" s) 9489 (setq s (mapconcat 9490 (lambda (x) (if (member x '(?| ?+)) "|" " ")) 9491 s "")) 9492 (with-temp-buffer 9493 (insert s) 9494 (goto-char (point-min)) 9495 (when (re-search-forward "|" nil t) 9496 (let ((cur (point)) 9497 ret) 9498 (while (re-search-forward "|" nil t) 9499 (when (and (not (eql (char-before (match-beginning 0)) ?\\)) 9500 (not (markdown--thing-at-wiki-link (match-beginning 0)))) 9501 (push (make-string (- (match-beginning 0) cur) ? ) ret) 9502 (setq cur (match-end 0)))) 9503 (format "|%s|" (string-join (nreverse ret) "|"))))))) 9504 9505 (defun markdown-table-colfmt (fmtspec) 9506 "Process column alignment specifier FMTSPEC for tables." 9507 (when (stringp fmtspec) 9508 (mapcar (lambda (x) 9509 (cond ((string-match-p "^:.*:$" x) 'c) 9510 ((string-match-p "^:" x) 'l) 9511 ((string-match-p ":$" x) 'r) 9512 (t 'd))) 9513 (markdown--split-string fmtspec "\\s-*|\\s-*")))) 9514 9515 (defun markdown--first-column-p (bar-pos) 9516 (save-excursion 9517 (save-match-data 9518 (goto-char bar-pos) 9519 (looking-back "^\\s-*" (line-beginning-position))))) 9520 9521 (defun markdown--table-line-to-columns (line) 9522 (with-temp-buffer 9523 (insert line) 9524 (goto-char (point-min)) 9525 (let ((cur (point)) 9526 ret) 9527 (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) 9528 (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) 9529 (if (markdown--first-column-p (match-beginning 1)) 9530 (setq cur (match-end 0)) 9531 (cond ((eql (char-before (match-beginning 1)) ?\\) 9532 ;; keep spaces 9533 (goto-char (match-end 1))) 9534 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing 9535 (t 9536 (push (buffer-substring-no-properties cur (match-beginning 0)) ret) 9537 (setq cur (match-end 0))))))) 9538 (when (< cur (length line)) 9539 (push (buffer-substring-no-properties cur (point-max)) ret)) 9540 (nreverse ret)))) 9541 9542 (defsubst markdown--is-delimiter-row (line) 9543 (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) 9544 (cl-loop for c across line 9545 always (member c '(?| ?- ?: ?\t ? ))))) 9546 9547 (defun markdown-table-align () 9548 "Align table at point. 9549 This function assumes point is on a table." 9550 (interactive) 9551 (let ((begin (markdown-table-begin)) 9552 (end (copy-marker (markdown-table-end)))) 9553 (markdown-table-save-cell 9554 (goto-char begin) 9555 (let* (fmtspec 9556 ;; Store table indent 9557 (indent (progn (looking-at "[ \t]*") (match-string 0))) 9558 ;; Split table in lines and save column format specifier 9559 (lines (mapcar (lambda (line) 9560 (if (markdown--is-delimiter-row line) 9561 (progn (setq fmtspec (or fmtspec line)) nil) 9562 line)) 9563 (markdown--split-string (buffer-substring begin end) "\n"))) 9564 ;; Split lines in cells 9565 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) 9566 (remq nil lines))) 9567 ;; Calculate maximum number of cells in a line 9568 (maxcells (if cells 9569 (apply #'max (mapcar #'length cells)) 9570 (user-error "Empty table"))) 9571 ;; Empty cells to fill short lines 9572 (emptycells (make-list maxcells "")) 9573 maxwidths) 9574 ;; Calculate maximum width for each column 9575 (dotimes (i maxcells) 9576 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) 9577 (push (apply #'max 1 (mapcar #'markdown--string-width column)) 9578 maxwidths))) 9579 (setq maxwidths (nreverse maxwidths)) 9580 ;; Process column format specifier 9581 (setq fmtspec (markdown-table-colfmt fmtspec)) 9582 ;; Compute formats needed for output of table lines 9583 (let ((hfmt (concat indent "|")) 9584 (rfmt (concat indent "|")) 9585 hfmt1 rfmt1 fmt) 9586 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) 9587 (setq fmt (pop fmtspec)) 9588 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) 9589 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) 9590 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) 9591 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) 9592 (setq rfmt (concat rfmt (format rfmt1 width))) 9593 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) 9594 ;; Replace modified lines only 9595 (dolist (line lines) 9596 (let ((line (if line 9597 (apply #'format rfmt (append (pop cells) emptycells)) 9598 hfmt)) 9599 (previous (buffer-substring (point) (line-end-position)))) 9600 (if (equal previous line) 9601 (forward-line) 9602 (insert line "\n") 9603 (delete-region (point) (line-beginning-position 2)))))) 9604 (set-marker end nil))))) 9605 9606 (defun markdown-table-insert-row (&optional arg) 9607 "Insert a new row above the row at point into the table. 9608 With optional argument ARG, insert below the current row." 9609 (interactive "P") 9610 (unless (markdown-table-at-point-p) 9611 (user-error "Not at a table")) 9612 (let* ((line (buffer-substring 9613 (line-beginning-position) (line-end-position))) 9614 (new (markdown-table-blank-line line))) 9615 (beginning-of-line (if arg 2 1)) 9616 (unless (bolp) (insert "\n")) 9617 (insert-before-markers new "\n") 9618 (beginning-of-line 0) 9619 (re-search-forward "| ?" (line-end-position) t))) 9620 9621 (defun markdown-table-delete-row () 9622 "Delete row or horizontal line at point from the table." 9623 (interactive) 9624 (unless (markdown-table-at-point-p) 9625 (user-error "Not at a table")) 9626 (let ((col (current-column))) 9627 (kill-region (line-beginning-position) 9628 (min (1+ (line-end-position)) (point-max))) 9629 (unless (markdown-table-at-point-p) (beginning-of-line 0)) 9630 (move-to-column col))) 9631 9632 (defun markdown-table-move-row (&optional up) 9633 "Move table line at point down. 9634 With optional argument UP, move it up." 9635 (interactive "P") 9636 (unless (markdown-table-at-point-p) 9637 (user-error "Not at a table")) 9638 (let* ((col (current-column)) (pos (point)) 9639 (tonew (if up 0 2)) txt) 9640 (beginning-of-line tonew) 9641 (unless (markdown-table-at-point-p) 9642 (goto-char pos) (user-error "Cannot move row further")) 9643 (goto-char pos) (beginning-of-line 1) (setq pos (point)) 9644 (setq txt (buffer-substring (point) (1+ (line-end-position)))) 9645 (delete-region (point) (1+ (line-end-position))) 9646 (beginning-of-line tonew) 9647 (insert txt) (beginning-of-line 0) 9648 (move-to-column col))) 9649 9650 (defun markdown-table-move-row-up () 9651 "Move table row at point up." 9652 (interactive) 9653 (markdown-table-move-row 'up)) 9654 9655 (defun markdown-table-move-row-down () 9656 "Move table row at point down." 9657 (interactive) 9658 (markdown-table-move-row nil)) 9659 9660 (defun markdown-table-insert-column () 9661 "Insert a new table column." 9662 (interactive) 9663 (unless (markdown-table-at-point-p) 9664 (user-error "Not at a table")) 9665 (let* ((col (max 1 (markdown-table-get-column))) 9666 (begin (markdown-table-begin)) 9667 (end (copy-marker (markdown-table-end)))) 9668 (markdown-table-save-cell 9669 (goto-char begin) 9670 (while (< (point) end) 9671 (markdown-table-goto-column col t) 9672 (if (markdown-table-hline-at-point-p) 9673 (insert "|---") 9674 (insert "| ")) 9675 (forward-line))) 9676 (set-marker end nil) 9677 (when markdown-table-align-p 9678 (markdown-table-align)))) 9679 9680 (defun markdown-table-delete-column () 9681 "Delete column at point from table." 9682 (interactive) 9683 (unless (markdown-table-at-point-p) 9684 (user-error "Not at a table")) 9685 (let ((col (markdown-table-get-column)) 9686 (begin (markdown-table-begin)) 9687 (end (copy-marker (markdown-table-end)))) 9688 (markdown-table-save-cell 9689 (goto-char begin) 9690 (while (< (point) end) 9691 (markdown-table-goto-column col t) 9692 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") 9693 (replace-match "|")) 9694 (forward-line))) 9695 (set-marker end nil) 9696 (markdown-table-goto-column (max 1 (1- col))) 9697 (when markdown-table-align-p 9698 (markdown-table-align)))) 9699 9700 (defun markdown-table-move-column (&optional left) 9701 "Move table column at point to the right. 9702 With optional argument LEFT, move it to the left." 9703 (interactive "P") 9704 (unless (markdown-table-at-point-p) 9705 (user-error "Not at a table")) 9706 (let* ((col (markdown-table-get-column)) 9707 (col1 (if left (1- col) col)) 9708 (colpos (if left (1- col) (1+ col))) 9709 (begin (markdown-table-begin)) 9710 (end (copy-marker (markdown-table-end)))) 9711 (when (and left (= col 1)) 9712 (user-error "Cannot move column further left")) 9713 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) 9714 (user-error "Cannot move column further right")) 9715 (markdown-table-save-cell 9716 (goto-char begin) 9717 (while (< (point) end) 9718 (markdown-table-goto-column col1 t) 9719 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") 9720 (replace-match "|\\2|\\1|")) 9721 (forward-line))) 9722 (set-marker end nil) 9723 (markdown-table-goto-column colpos) 9724 (when markdown-table-align-p 9725 (markdown-table-align)))) 9726 9727 (defun markdown-table-move-column-left () 9728 "Move table column at point to the left." 9729 (interactive) 9730 (markdown-table-move-column 'left)) 9731 9732 (defun markdown-table-move-column-right () 9733 "Move table column at point to the right." 9734 (interactive) 9735 (markdown-table-move-column nil)) 9736 9737 (defun markdown-table-next-row () 9738 "Go to the next row (same column) in the table. 9739 Create new table lines if required." 9740 (interactive) 9741 (unless (markdown-table-at-point-p) 9742 (user-error "Not at a table")) 9743 (if (or (looking-at "[ \t]*$") 9744 (save-excursion (skip-chars-backward " \t") (bolp))) 9745 (newline) 9746 (when markdown-table-align-p 9747 (markdown-table-align)) 9748 (let ((col (markdown-table-get-column))) 9749 (beginning-of-line 2) 9750 (if (or (not (markdown-table-at-point-p)) 9751 (markdown-table-hline-at-point-p)) 9752 (progn 9753 (beginning-of-line 0) 9754 (markdown-table-insert-row 'below))) 9755 (markdown-table-goto-column col) 9756 (skip-chars-backward "^|\n\r") 9757 (when (looking-at " ") (forward-char 1))))) 9758 9759 (defun markdown-table-forward-cell () 9760 "Go to the next cell in the table. 9761 Create new table lines if required." 9762 (interactive) 9763 (unless (markdown-table-at-point-p) 9764 (user-error "Not at a table")) 9765 (when markdown-table-align-p 9766 (markdown-table-align)) 9767 (let ((end (markdown-table-end))) 9768 (when (markdown-table-hline-at-point-p) (end-of-line 1)) 9769 (condition-case nil 9770 (progn 9771 (re-search-forward "\\(?:^\\|[^\\]\\)|" end) 9772 (when (looking-at "[ \t]*$") 9773 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) 9774 (when (and (looking-at "[-:]") 9775 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) 9776 (goto-char (match-beginning 1))) 9777 (if (looking-at "[-:]") 9778 (progn 9779 (beginning-of-line 0) 9780 (markdown-table-insert-row 'below)) 9781 (when (looking-at " ") (forward-char 1)))) 9782 (error (markdown-table-insert-row 'below))))) 9783 9784 (defun markdown-table-backward-cell () 9785 "Go to the previous cell in the table." 9786 (interactive) 9787 (unless (markdown-table-at-point-p) 9788 (user-error "Not at a table")) 9789 (when markdown-table-align-p 9790 (markdown-table-align)) 9791 (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) 9792 (condition-case nil 9793 (progn 9794 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) 9795 ;; When this function is called while in the first cell in a 9796 ;; table, the point will now be at the beginning of a line. In 9797 ;; this case, we need to move past one additional table 9798 ;; boundary, the end of the table on the previous line. 9799 (when (= (point) (line-beginning-position)) 9800 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9801 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) 9802 (error (user-error "Cannot move to previous table cell"))) 9803 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) 9804 9805 ;; This may have dropped point on the hline. 9806 (when (markdown-table-hline-at-point-p) 9807 (markdown-table-backward-cell))) 9808 9809 (defun markdown-table-transpose () 9810 "Transpose table at point. 9811 Horizontal separator lines will be eliminated." 9812 (interactive) 9813 (unless (markdown-table-at-point-p) 9814 (user-error "Not at a table")) 9815 (let* ((table (buffer-substring-no-properties 9816 (markdown-table-begin) (markdown-table-end))) 9817 ;; Convert table to Lisp structure 9818 (table (delq nil 9819 (mapcar 9820 (lambda (x) 9821 (unless (string-match-p 9822 markdown-table-hline-regexp x) 9823 (markdown--table-line-to-columns x))) 9824 (markdown--split-string table "[ \t]*\n[ \t]*")))) 9825 (dline_old (markdown-table-get-dline)) 9826 (col_old (markdown-table-get-column)) 9827 (contents (mapcar (lambda (_) 9828 (let ((tp table)) 9829 (mapcar 9830 (lambda (_) 9831 (prog1 9832 (pop (car tp)) 9833 (setq tp (cdr tp)))) 9834 table))) 9835 (car table)))) 9836 (goto-char (markdown-table-begin)) 9837 (save-excursion 9838 (re-search-forward "|") (backward-char) 9839 (delete-region (point) (markdown-table-end)) 9840 (insert (mapconcat 9841 (lambda(x) 9842 (concat "| " (mapconcat 'identity x " | " ) " |\n")) 9843 contents ""))) 9844 (markdown-table-goto-dline col_old) 9845 (markdown-table-goto-column dline_old)) 9846 (when markdown-table-align-p 9847 (markdown-table-align))) 9848 9849 (defun markdown-table-sort-lines (&optional sorting-type) 9850 "Sort table lines according to the column at point. 9851 9852 The position of point indicates the column to be used for 9853 sorting, and the range of lines is the range between the nearest 9854 horizontal separator lines, or the entire table of no such lines 9855 exist. If point is before the first column, user will be prompted 9856 for the sorting column. If there is an active region, the mark 9857 specifies the first line and the sorting column, while point 9858 should be in the last line to be included into the sorting. 9859 9860 The command then prompts for the sorting type which can be 9861 alphabetically or numerically. Sorting in reverse order is also 9862 possible. 9863 9864 If SORTING-TYPE is specified when this function is called from a 9865 Lisp program, no prompting will take place. SORTING-TYPE must be 9866 a character, any of (?a ?A ?n ?N) where the capital letters 9867 indicate that sorting should be done in reverse order." 9868 (interactive) 9869 (unless (markdown-table-at-point-p) 9870 (user-error "Not at a table")) 9871 ;; Set sorting type and column used for sorting 9872 (let ((column (let ((c (markdown-table-get-column))) 9873 (cond ((> c 0) c) 9874 ((called-interactively-p 'any) 9875 (read-number "Use column N for sorting: ")) 9876 (t 1)))) 9877 (sorting-type 9878 (or sorting-type 9879 (progn 9880 ;; workaround #641 9881 ;; Emacs < 28 hides prompt message by another message. This erases it. 9882 (message "") 9883 (read-char-exclusive 9884 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) 9885 (save-restriction 9886 ;; Narrow buffer to appropriate sorting area 9887 (if (region-active-p) 9888 (narrow-to-region 9889 (save-excursion 9890 (progn 9891 (goto-char (region-beginning)) (line-beginning-position))) 9892 (save-excursion 9893 (progn 9894 (goto-char (region-end)) (line-end-position)))) 9895 (let ((start (markdown-table-begin)) 9896 (end (markdown-table-end))) 9897 (narrow-to-region 9898 (save-excursion 9899 (if (re-search-backward 9900 markdown-table-hline-regexp start t) 9901 (line-beginning-position 2) 9902 start)) 9903 (if (save-excursion (re-search-forward 9904 markdown-table-hline-regexp end t)) 9905 (match-beginning 0) 9906 end)))) 9907 ;; Determine arguments for `sort-subr' 9908 (let* ((extract-key-from-cell 9909 (cl-case sorting-type 9910 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) 9911 ((?n ?N) #'string-to-number) 9912 (t (user-error "Invalid sorting type: %c" sorting-type)))) 9913 (predicate 9914 (cl-case sorting-type 9915 ((?n ?N) #'<) 9916 ((?a ?A) #'string<)))) 9917 ;; Sort selected area 9918 (goto-char (point-min)) 9919 (sort-subr (memq sorting-type '(?A ?N)) 9920 (lambda () 9921 (forward-line) 9922 (while (and (not (eobp)) 9923 (not (looking-at 9924 markdown-table-dline-regexp))) 9925 (forward-line))) 9926 #'end-of-line 9927 (lambda () 9928 (funcall extract-key-from-cell 9929 (markdown-table-get-cell column))) 9930 nil 9931 predicate) 9932 (goto-char (point-min)))))) 9933 9934 (defun markdown-table-convert-region (begin end &optional separator) 9935 "Convert region from BEGIN to END to table with SEPARATOR. 9936 9937 If every line contains at least one TAB character, the function 9938 assumes that the material is tab separated (TSV). If every line 9939 contains a comma, comma-separated values (CSV) are assumed. If 9940 not, lines are split at whitespace into cells. 9941 9942 You can use a prefix argument to force a specific separator: 9943 \\[universal-argument] once forces CSV, \\[universal-argument] 9944 twice forces TAB, and \\[universal-argument] three times will 9945 prompt for a regular expression to match the separator, and a 9946 numeric argument N indicates that at least N consecutive 9947 spaces, or alternatively a TAB should be used as the separator." 9948 9949 (interactive "r\nP") 9950 (let* ((begin (min begin end)) (end (max begin end)) re) 9951 (goto-char begin) (beginning-of-line 1) 9952 (setq begin (point-marker)) 9953 (goto-char end) 9954 (if (bolp) (backward-char 1) (end-of-line 1)) 9955 (setq end (point-marker)) 9956 (when (equal separator '(64)) 9957 (setq separator (read-regexp "Regexp for cell separator: "))) 9958 (unless separator 9959 ;; Get the right cell separator 9960 (goto-char begin) 9961 (setq separator 9962 (cond 9963 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) 9964 ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) 9965 (t 1)))) 9966 (goto-char begin) 9967 (if (equal separator '(4)) 9968 ;; Parse CSV 9969 (while (< (point) end) 9970 (cond 9971 ((looking-at "^") (insert "| ")) 9972 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) 9973 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") 9974 (replace-match "\\1") (if (looking-at "\"") (insert "\""))) 9975 ((looking-at "[^,\n]+") (goto-char (match-end 0))) 9976 ((looking-at "[ \t]*,") (replace-match " | ")) 9977 (t (beginning-of-line 2)))) 9978 (setq re 9979 (cond 9980 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") 9981 ((equal separator '(16)) "^\\|\t") 9982 ((integerp separator) 9983 (if (< separator 1) 9984 (user-error "Cell separator must contain one or more spaces") 9985 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) 9986 ((stringp separator) (format "^ *\\|%s" separator)) 9987 (t (error "Invalid cell separator")))) 9988 (let (finish) 9989 (while (and (not finish) (re-search-forward re end t)) 9990 (if (eolp) 9991 (progn 9992 (replace-match "|" t t) 9993 (forward-line 1) 9994 (when (eobp) 9995 (setq finish t))) 9996 (replace-match "| " t t))))) 9997 (goto-char begin) 9998 (when markdown-table-align-p 9999 (markdown-table-align)))) 10000 10001 (defun markdown-insert-table (&optional rows columns align) 10002 "Insert an empty pipe table. 10003 Optional arguments ROWS, COLUMNS, and ALIGN specify number of 10004 rows and columns and the column alignment." 10005 (interactive) 10006 (let* ((rows (or rows (read-number "Number of Rows: "))) 10007 (columns (or columns (read-number "Number of Columns: "))) 10008 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) 10009 (align (cond ((equal align "l") ":--") 10010 ((equal align "r") "--:") 10011 ((equal align "c") ":-:") 10012 (t "---"))) 10013 (pos (point)) 10014 (indent (make-string (current-column) ?\ )) 10015 (line (concat 10016 (apply 'concat indent "|" 10017 (make-list columns " |")) "\n")) 10018 (hline (apply 'concat indent "|" 10019 (make-list columns (concat align "|"))))) 10020 (if (string-match 10021 "^[ \t]*$" (buffer-substring-no-properties 10022 (line-beginning-position) (point))) 10023 (beginning-of-line 1) 10024 (newline)) 10025 (dotimes (_ rows) (insert line)) 10026 (goto-char pos) 10027 (if (> rows 1) 10028 (progn 10029 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) 10030 (markdown-table-forward-cell))) 10031 10032 10033 ;;; ElDoc Support ============================================================= 10034 10035 (defun markdown-eldoc-function (&rest _ignored) 10036 "Return a helpful string when appropriate based on context. 10037 * Report URL when point is at a hidden URL. 10038 * Report language name when point is a code block with hidden markup." 10039 (cond 10040 ;; Hidden URL or reference for inline link 10041 ((and (or (thing-at-point-looking-at markdown-regex-link-inline) 10042 (thing-at-point-looking-at markdown-regex-link-reference)) 10043 (or markdown-hide-urls markdown-hide-markup)) 10044 (let* ((imagep (string-equal (match-string 1) "!")) 10045 (referencep (string-equal (match-string 5) "[")) 10046 (link (match-string-no-properties 6)) 10047 (edit-keys (markdown--substitute-command-keys 10048 (if imagep 10049 "\\[markdown-insert-image]" 10050 "\\[markdown-insert-link]"))) 10051 (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) 10052 (object (if referencep "reference" "URL"))) 10053 (format "Hidden %s (%s to edit): %s" object edit-str 10054 (if referencep 10055 (concat 10056 (propertize "[" 'face 'markdown-markup-face) 10057 (propertize link 'face 'markdown-reference-face) 10058 (propertize "]" 'face 'markdown-markup-face)) 10059 (propertize link 'face 'markdown-url-face))))) 10060 ;; Hidden language name for fenced code blocks 10061 ((and (markdown-code-block-at-point-p) 10062 (not (get-text-property (point) 'markdown-pre)) 10063 markdown-hide-markup) 10064 (let ((lang (save-excursion (markdown-code-block-lang)))) 10065 (unless lang (setq lang "[unspecified]")) 10066 (format "Hidden code block language: %s (%s to toggle markup)" 10067 (propertize lang 'face 'markdown-language-keyword-face) 10068 (markdown--substitute-command-keys 10069 "\\[markdown-toggle-markup-hiding]")))))) 10070 10071 (defun markdown--image-media-handler (mimetype data) 10072 (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) 10073 (filename (read-string "Insert filename for image: ")) 10074 (link-text (read-string "Link text: ")) 10075 (filepath (file-name-with-extension filename ext)) 10076 (dir (file-name-directory filepath))) 10077 (when (and dir (not (file-directory-p dir))) 10078 (make-directory dir t)) 10079 (with-temp-file filepath 10080 (insert data)) 10081 (when (string-match-p "\\s-" filepath) 10082 (setq filepath (concat "<" filepath ">"))) 10083 (markdown-insert-inline-image link-text filepath))) 10084 10085 (defun markdown--file-media-handler (_mimetype data) 10086 (let* ((data (split-string data "[\0\r\n]" t "^file://")) 10087 (files (cdr data))) 10088 (while (not (null files)) 10089 (let* ((file (url-unhex-string (car files))) 10090 (file (file-relative-name file)) 10091 (prompt (format "Link text(%s): " (file-name-nondirectory file))) 10092 (link-text (read-string prompt))) 10093 (when (string-match-p "\\s-" file) 10094 (setq file (concat "<" file ">"))) 10095 (markdown-insert-inline-image link-text file) 10096 (when (not (null (cdr files))) 10097 (insert " ")) 10098 (setq files (cdr files)))))) 10099 10100 (defun markdown--dnd-local-file-handler (url _action) 10101 (require 'mailcap) 10102 (require 'dnd) 10103 (let* ((filename (dnd-get-local-file-name url)) 10104 (mimetype (mailcap-file-name-to-mime-type filename)) 10105 (file (file-relative-name filename)) 10106 (link-text "link text")) 10107 (when (string-match-p "\\s-" file) 10108 (setq file (concat "<" file ">"))) 10109 (if (string-prefix-p "image/" mimetype) 10110 (markdown-insert-inline-image link-text file) 10111 (markdown-insert-inline-link link-text file)))) 10112 10113 10114 ;;; Mode Definition ========================================================== 10115 10116 (defun markdown-show-version () 10117 "Show the version number in the minibuffer." 10118 (interactive) 10119 (message "markdown-mode, version %s" markdown-mode-version)) 10120 10121 (defun markdown-mode-info () 10122 "Open the `markdown-mode' homepage." 10123 (interactive) 10124 (browse-url "https://jblevins.org/projects/markdown-mode/")) 10125 10126 ;;;###autoload 10127 (define-derived-mode markdown-mode text-mode "Markdown" 10128 "Major mode for editing Markdown files." 10129 (when buffer-read-only 10130 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) 10131 (setq-local buffer-read-only nil))) 10132 ;; Natural Markdown tab width 10133 (setq tab-width 4) 10134 ;; Comments 10135 (setq-local comment-start "<!-- ") 10136 (setq-local comment-end " -->") 10137 (setq-local comment-start-skip "<!--[ \t]*") 10138 (setq-local comment-column 0) 10139 (setq-local comment-auto-fill-only-comments nil) 10140 (setq-local comment-use-syntax t) 10141 ;; Sentence 10142 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") 10143 ;; Syntax 10144 (add-hook 'syntax-propertize-extend-region-functions 10145 #'markdown-syntax-propertize-extend-region nil t) 10146 (add-hook 'jit-lock-after-change-extend-region-functions 10147 #'markdown-font-lock-extend-region-function t t) 10148 (setq-local syntax-propertize-function #'markdown-syntax-propertize) 10149 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. 10150 ;; Font lock. 10151 (setq font-lock-defaults 10152 '(markdown-mode-font-lock-keywords 10153 nil nil nil nil 10154 (font-lock-multiline . t) 10155 (font-lock-syntactic-face-function . markdown-syntactic-face) 10156 (font-lock-extra-managed-props 10157 . (composition display invisible rear-nonsticky 10158 keymap help-echo mouse-face)))) 10159 (if markdown-hide-markup 10160 (add-to-invisibility-spec 'markdown-markup) 10161 (remove-from-invisibility-spec 'markdown-markup)) 10162 ;; Wiki links 10163 (markdown-setup-wiki-link-hooks) 10164 ;; Math mode 10165 (when markdown-enable-math (markdown-toggle-math t)) 10166 ;; Add a buffer-local hook to reload after file-local variables are read 10167 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) 10168 ;; For imenu support 10169 (setq imenu-create-index-function 10170 (if markdown-nested-imenu-heading-index 10171 #'markdown-imenu-create-nested-index 10172 #'markdown-imenu-create-flat-index)) 10173 10174 ;; Defun movement 10175 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) 10176 (setq-local end-of-defun-function #'markdown-end-of-defun) 10177 ;; Paragraph filling 10178 (setq-local fill-paragraph-function #'markdown-fill-paragraph) 10179 (setq-local paragraph-start 10180 ;; Should match start of lines that start or separate paragraphs 10181 (mapconcat #'identity 10182 '( 10183 "\f" ; starts with a literal line-feed 10184 "[ \t\f]*$" ; space-only line 10185 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10186 "[ \t]*[*+-][ \t]+" ; unordered list item 10187 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item 10188 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def 10189 "[ \t]*:[ \t]+" ; definition 10190 "^|" ; table or Pandoc line block 10191 ) 10192 "\\|")) 10193 (setq-local paragraph-separate 10194 ;; Should match lines that separate paragraphs without being 10195 ;; part of any paragraph: 10196 (mapconcat #'identity 10197 '("[ \t\f]*$" ; space-only line 10198 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote 10199 ;; The following is not ideal, but the Fill customization 10200 ;; options really only handle paragraph-starting prefixes, 10201 ;; not paragraph-ending suffixes: 10202 ".* $" ; line ending in two spaces 10203 "^#+" 10204 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext 10205 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def 10206 "\\|")) 10207 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") 10208 (setq-local adaptive-fill-regexp "\\s-*") 10209 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) 10210 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) 10211 ;; Outline mode 10212 (setq-local outline-regexp markdown-regex-header) 10213 (setq-local outline-level #'markdown-outline-level) 10214 ;; Cause use of ellipses for invisible text. 10215 (add-to-invisibility-spec '(outline . t)) 10216 ;; ElDoc support 10217 (if (boundp 'eldoc-documentation-functions) 10218 (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) 10219 (add-function :before-until (local 'eldoc-documentation-function) 10220 #'markdown-eldoc-function)) 10221 ;; Inhibiting line-breaking: 10222 ;; Separating out each condition into a separate function so that users can 10223 ;; override if desired (with remove-hook) 10224 (add-hook 'fill-nobreak-predicate 10225 #'markdown-line-is-reference-definition-p nil t) 10226 (add-hook 'fill-nobreak-predicate 10227 #'markdown-pipe-at-bol-p nil t) 10228 10229 ;; Indentation 10230 (setq-local indent-line-function markdown-indent-function) 10231 (setq-local indent-region-function #'markdown--indent-region) 10232 10233 ;; Flyspell 10234 (setq-local flyspell-generic-check-word-predicate 10235 #'markdown-flyspell-check-word-p) 10236 10237 ;; Electric quoting 10238 (add-hook 'electric-quote-inhibit-functions 10239 #'markdown--inhibit-electric-quote nil :local) 10240 10241 ;; drag and drop handler 10242 (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) 10243 dnd-protocol-alist)) 10244 10245 ;; media handler 10246 (when (version< "29" emacs-version) 10247 (yank-media-handler "image/.*" #'markdown--image-media-handler) 10248 ;; TODO support other than GNOME, like KDE etc 10249 (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) 10250 10251 ;; Make checkboxes buttons 10252 (when markdown-make-gfm-checkboxes-buttons 10253 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) 10254 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) 10255 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) 10256 10257 ;; edit-indirect 10258 (add-hook 'edit-indirect-after-commit-functions 10259 #'markdown--edit-indirect-after-commit-function 10260 nil 'local) 10261 10262 ;; Marginalized headings 10263 (when markdown-marginalize-headers 10264 (add-hook 'window-configuration-change-hook 10265 #'markdown-marginalize-update-current nil t)) 10266 10267 ;; add live preview export hook 10268 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) 10269 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) 10270 10271 ;; Add a custom keymap for `visual-line-mode' so that activating 10272 ;; this minor mode does not override markdown-mode's keybindings. 10273 ;; FIXME: Probably `visual-line-mode' should take care of this. 10274 (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) 10275 (newmap (make-sparse-keymap))) 10276 (set-keymap-parent newmap oldmap) 10277 (define-key newmap [remap move-beginning-of-line] nil) 10278 (define-key newmap [remap move-end-of-line] nil) 10279 (make-local-variable 'minor-mode-overriding-map-alist) 10280 (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) 10281 10282 ;;;###autoload 10283 (add-to-list 'auto-mode-alist 10284 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) 10285 10286 10287 ;;; GitHub Flavored Markdown Mode ============================================ 10288 10289 (defun gfm--electric-pair-fence-code-block () 10290 (when (and electric-pair-mode 10291 (not markdown-gfm-use-electric-backquote) 10292 (eql last-command-event ?`) 10293 (let ((count 0)) 10294 (while (eql (char-before (- (point) count)) ?`) 10295 (cl-incf count)) 10296 (= count 3)) 10297 (eql (char-after) ?`)) 10298 (save-excursion (insert (make-string 2 ?`))))) 10299 10300 (defvar gfm-mode-hook nil 10301 "Hook run when entering GFM mode.") 10302 10303 ;;;###autoload 10304 (define-derived-mode gfm-mode markdown-mode "GFM" 10305 "Major mode for editing GitHub Flavored Markdown files." 10306 (setq markdown-link-space-sub-char "-") 10307 (setq markdown-wiki-link-search-subdirectories t) 10308 (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) 10309 (setq-local paragraph-separate 10310 (concat paragraph-separate 10311 "\\|" 10312 ;; GFM alert syntax 10313 "^>\s-*\\[!\\(?:NOTE\\|TIP\\|IMPORTANT\\|WARNING\\|CAUTION\\)\\]")) 10314 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) 10315 (markdown-gfm-parse-buffer-for-languages)) 10316 10317 10318 ;;; Viewing modes ============================================================= 10319 10320 (defcustom markdown-hide-markup-in-view-modes t 10321 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." 10322 :group 'markdown 10323 :type 'boolean 10324 :safe #'booleanp) 10325 10326 (defvar markdown-view-mode-map 10327 (let ((map (make-sparse-keymap))) 10328 (define-key map (kbd "p") #'markdown-outline-previous) 10329 (define-key map (kbd "n") #'markdown-outline-next) 10330 (define-key map (kbd "f") #'markdown-outline-next-same-level) 10331 (define-key map (kbd "b") #'markdown-outline-previous-same-level) 10332 (define-key map (kbd "u") #'markdown-outline-up) 10333 (define-key map (kbd "DEL") #'scroll-down-command) 10334 (define-key map (kbd "SPC") #'scroll-up-command) 10335 (define-key map (kbd ">") #'end-of-buffer) 10336 (define-key map (kbd "<") #'beginning-of-buffer) 10337 (define-key map (kbd "q") #'kill-this-buffer) 10338 (define-key map (kbd "?") #'describe-mode) 10339 map) 10340 "Keymap for `markdown-view-mode'.") 10341 10342 (defun markdown--filter-visible (beg end &optional delete) 10343 (let ((result "") 10344 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) 10345 (while (< beg end) 10346 (when (markdown--face-p beg invisible-faces) 10347 (cl-incf beg) 10348 (while (and (markdown--face-p beg invisible-faces) (< beg end)) 10349 (cl-incf beg))) 10350 (let ((next (next-single-char-property-change beg 'invisible))) 10351 (unless (get-char-property beg 'invisible) 10352 (setq result (concat result (buffer-substring beg (min end next))))) 10353 (setq beg next))) 10354 (prog1 result 10355 (when delete 10356 (let ((inhibit-read-only t)) 10357 (delete-region beg end)))))) 10358 10359 ;;;###autoload 10360 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View" 10361 "Major mode for viewing Markdown content." 10362 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10363 (add-to-invisibility-spec 'markdown-markup) 10364 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10365 (read-only-mode 1)) 10366 10367 (defvar gfm-view-mode-map 10368 markdown-view-mode-map 10369 "Keymap for `gfm-view-mode'.") 10370 10371 ;;;###autoload 10372 (define-derived-mode gfm-view-mode gfm-mode "GFM-View" 10373 "Major mode for viewing GitHub Flavored Markdown content." 10374 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) 10375 (setq-local markdown-fontify-code-blocks-natively t) 10376 (setq-local filter-buffer-substring-function #'markdown--filter-visible) 10377 (add-to-invisibility-spec 'markdown-markup) 10378 (read-only-mode 1)) 10379 10380 10381 ;;; Live Preview Mode ======================================================== 10382 ;;;###autoload 10383 (define-minor-mode markdown-live-preview-mode 10384 "Toggle native previewing on save for a specific markdown file." 10385 :lighter " MD-Preview" 10386 (if markdown-live-preview-mode 10387 (if (markdown-live-preview-get-filename) 10388 (markdown-display-buffer-other-window (markdown-live-preview-export)) 10389 (markdown-live-preview-mode -1) 10390 (user-error "Buffer %s does not visit a file" (current-buffer))) 10391 (markdown-live-preview-remove))) 10392 10393 10394 (provide 'markdown-mode) 10395 10396 ;; Local Variables: 10397 ;; indent-tabs-mode: nil 10398 ;; coding: utf-8 10399 ;; End: 10400 ;;; markdown-mode.el ends here