Merge pull request #757 from jrblevin/improve/issue-753
[markdown-mode.git] / markdown-mode.el
blob6bdf03abb2c935945fc90f3dd9173fed4f2b9dc2
1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2007-2022 Jason R. Blevins and markdown-mode
4 ;; contributors (see the commit log for details).
6 ;; Author: Jason R. Blevins <jblevins@xbeta.org>
7 ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org>
8 ;; Created: May 24, 2007
9 ;; Version: 2.6-alpha
10 ;; Package-Requires: ((emacs "26.1"))
11 ;; Keywords: Markdown, GitHub Flavored Markdown, itex
12 ;; URL: https://jblevins.org/projects/markdown-mode/
14 ;; This file is not part of GNU Emacs.
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
29 ;;; Commentary:
31 ;; See the README.md file for details.
34 ;;; Code:
36 (require 'easymenu)
37 (require 'outline)
38 (require 'thingatpt)
39 (require 'cl-lib)
40 (require 'url-parse)
41 (require 'button)
42 (require 'color)
43 (require 'rx)
44 (require 'subr-x)
46 (defvar jit-lock-start)
47 (defvar jit-lock-end)
48 (defvar flyspell-generic-check-word-predicate)
49 (defvar electric-pair-pairs)
50 (defvar sh-ancestor-alist)
52 (declare-function project-roots "project")
53 (declare-function sh-set-shell "sh-script")
56 ;;; Constants =================================================================
58 (defconst markdown-mode-version "2.6-alpha"
59 "Markdown mode version number.")
61 (defconst markdown-output-buffer-name "*markdown-output*"
62 "Name of temporary buffer for markdown command output.")
65 ;;; Global Variables ==========================================================
67 (defvar markdown-reference-label-history nil
68 "History of used reference labels.")
70 (defvar markdown-live-preview-mode nil
71 "Sentinel variable for command `markdown-live-preview-mode'.")
73 (defvar markdown-gfm-language-history nil
74 "History list of languages used in the current buffer in GFM code blocks.")
77 ;;; Customizable Variables ====================================================
79 (defvar markdown-mode-hook nil
80 "Hook run when entering Markdown mode.")
82 (defvar markdown-before-export-hook nil
83 "Hook run before running Markdown to export XHTML output.
84 The hook may modify the buffer, which will be restored to it's
85 original state after exporting is complete.")
87 (defvar markdown-after-export-hook nil
88 "Hook run after XHTML output has been saved.
89 Any changes to the output buffer made by this hook will be saved.")
91 (defgroup markdown nil
92 "Major mode for editing text files in Markdown format."
93 :prefix "markdown-"
94 :group 'text
95 :link '(url-link "https://jblevins.org/projects/markdown-mode/"))
97 (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py")
98 when (executable-find cmd)
99 return (file-name-nondirectory it))))
100 (or command "markdown"))
101 "Command to run markdown."
102 :group 'markdown
103 :type '(choice (string :tag "Shell command") (repeat (string)) function))
105 (defcustom markdown-command-needs-filename nil
106 "Set to non-nil if `markdown-command' does not accept input from stdin.
107 Instead, it will be passed a filename as the final command line
108 option. As a result, you will only be able to run Markdown from
109 buffers which are visiting a file."
110 :group 'markdown
111 :type 'boolean)
113 (defcustom markdown-open-command nil
114 "Command used for opening Markdown files directly.
115 For example, a standalone Markdown previewer. This command will
116 be called with a single argument: the filename of the current
117 buffer. It can also be a function, which will be called without
118 arguments."
119 :group 'markdown
120 :type '(choice file function (const :tag "None" nil)))
122 (defcustom markdown-open-image-command nil
123 "Command used for opening image files directly.
124 This is used at `markdown-follow-link-at-point'."
125 :group 'markdown
126 :type '(choice file function (const :tag "None" nil)))
128 (defcustom markdown-hr-strings
129 '("-------------------------------------------------------------------------------"
130 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
131 "---------------------------------------"
132 "* * * * * * * * * * * * * * * * * * * *"
133 "---------"
134 "* * * * *")
135 "Strings to use when inserting horizontal rules.
136 The first string in the list will be the default when inserting a
137 horizontal rule. Strings should be listed in decreasing order of
138 prominence (as in headings from level one to six) for use with
139 promotion and demotion functions."
140 :group 'markdown
141 :type '(repeat string))
143 (defcustom markdown-bold-underscore nil
144 "Use two underscores when inserting bold text instead of two asterisks."
145 :group 'markdown
146 :type 'boolean)
148 (defcustom markdown-italic-underscore nil
149 "Use underscores when inserting italic text instead of asterisks."
150 :group 'markdown
151 :type 'boolean)
153 (defcustom markdown-marginalize-headers nil
154 "When non-nil, put opening atx header markup in a left margin.
156 This setting goes well with `markdown-asymmetric-header'. But
157 sadly it conflicts with `linum-mode' since they both use the
158 same margin."
159 :group 'markdown
160 :type 'boolean
161 :safe 'booleanp
162 :package-version '(markdown-mode . "2.4"))
164 (defcustom markdown-marginalize-headers-margin-width 6
165 "Character width of margin used for marginalized headers.
166 The default value is based on there being six heading levels
167 defined by Markdown and HTML. Increasing this produces extra
168 whitespace on the left. Decreasing it may be preferred when
169 fewer than six nested heading levels are used."
170 :group 'markdown
171 :type 'natnump
172 :safe 'natnump
173 :package-version '(markdown-mode . "2.4"))
175 (defcustom markdown-asymmetric-header nil
176 "Determines if atx header style will be asymmetric.
177 Set to a non-nil value to use asymmetric header styling, placing
178 header markup only at the beginning of the line. By default,
179 balanced markup will be inserted at the beginning and end of the
180 line around the header title."
181 :group 'markdown
182 :type 'boolean)
184 (defcustom markdown-indent-function 'markdown-indent-line
185 "Function to use to indent."
186 :group 'markdown
187 :type 'function)
189 (defcustom markdown-indent-on-enter t
190 "Determines indentation behavior when pressing \\[newline].
191 Possible settings are nil, t, and \\='indent-and-new-item.
193 When non-nil, pressing \\[newline] will call `newline-and-indent'
194 to indent the following line according to the context using
195 `markdown-indent-function'. In this case, note that
196 \\[electric-newline-and-maybe-indent] can still be used to insert
197 a newline without indentation.
199 When set to \\='indent-and-new-item and the point is in a list item
200 when \\[newline] is pressed, the list will be continued on the next
201 line, where a new item will be inserted.
203 When set to nil, simply call `newline' as usual. In this case,
204 you can still indent lines using \\[markdown-cycle] and continue
205 lists with \\[markdown-insert-list-item].
207 Note that this assumes the variable `electric-indent-mode' is
208 non-nil (enabled). When it is *disabled*, the behavior of
209 \\[newline] and `\\[electric-newline-and-maybe-indent]' are
210 reversed."
211 :group 'markdown
212 :type '(choice (const :tag "Don't automatically indent" nil)
213 (const :tag "Automatically indent" t)
214 (const :tag "Automatically indent and insert new list items" indent-and-new-item)))
216 (defcustom markdown-enable-wiki-links nil
217 "Syntax highlighting for wiki links.
218 Set this to a non-nil value to turn on wiki link support by default.
219 Support can be toggled later using the `markdown-toggle-wiki-links'
220 function or \\[markdown-toggle-wiki-links]."
221 :group 'markdown
222 :type 'boolean
223 :safe 'booleanp
224 :package-version '(markdown-mode . "2.2"))
226 (defcustom markdown-wiki-link-alias-first t
227 "When non-nil, treat aliased wiki links like [[alias text|PageName]].
228 Otherwise, they will be treated as [[PageName|alias text]]."
229 :group 'markdown
230 :type 'boolean
231 :safe 'booleanp)
233 (defcustom markdown-wiki-link-search-subdirectories nil
234 "When non-nil, search for wiki link targets in subdirectories.
235 This is the default search behavior for GitHub and is
236 automatically set to t in `gfm-mode'."
237 :group 'markdown
238 :type 'boolean
239 :safe 'booleanp
240 :package-version '(markdown-mode . "2.2"))
242 (defcustom markdown-wiki-link-search-parent-directories nil
243 "When non-nil, search for wiki link targets in parent directories.
244 This is the default search behavior of Ikiwiki."
245 :group 'markdown
246 :type 'boolean
247 :safe 'booleanp
248 :package-version '(markdown-mode . "2.2"))
250 (defcustom markdown-wiki-link-search-type nil
251 "Searching type for markdown wiki link.
253 sub-directories: search for wiki link targets in sub directories
254 parent-directories: search for wiki link targets in parent directories
255 project: search for wiki link targets under project root"
256 :group 'markdown
257 :type '(set
258 (const :tag "search wiki link from subdirectories" sub-directories)
259 (const :tag "search wiki link from parent directories" parent-directories)
260 (const :tag "search wiki link under project root" project))
261 :package-version '(markdown-mode . "2.5"))
263 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5")
264 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5")
266 (defcustom markdown-wiki-link-fontify-missing nil
267 "When non-nil, change wiki link face according to existence of target files.
268 This is expensive because it requires checking for the file each time the buffer
269 changes or the user switches windows. It is disabled by default because it may
270 cause lag when typing on slower machines."
271 :group 'markdown
272 :type 'boolean
273 :safe 'booleanp
274 :package-version '(markdown-mode . "2.2"))
276 (defcustom markdown-uri-types
277 '("acap" "cid" "data" "dav" "fax" "file" "ftp"
278 "geo" "gopher" "http" "https" "imap" "ldap" "mailto"
279 "mid" "message" "modem" "news" "nfs" "nntp"
280 "pop" "prospero" "rtsp" "service" "sip" "tel"
281 "telnet" "tip" "urn" "vemmi" "wais")
282 "Link types for syntax highlighting of URIs."
283 :group 'markdown
284 :type '(repeat (string :tag "URI scheme")))
286 (defcustom markdown-url-compose-char
287 '(?∞ ?… ?⋯ ?# ?★ ?⚓)
288 "Placeholder character for hidden URLs.
289 This may be a single character or a list of characters. In case
290 of a list, the first one that satisfies `char-displayable-p' will
291 be used."
292 :type '(choice
293 (character :tag "Single URL replacement character")
294 (repeat :tag "List of possible URL replacement characters"
295 character))
296 :package-version '(markdown-mode . "2.3"))
298 (defcustom markdown-blockquote-display-char
299 '("▌" "┃" ">")
300 "String to display when hiding blockquote markup.
301 This may be a single string or a list of string. In case of a
302 list, the first one that satisfies `char-displayable-p' will be
303 used."
304 :type 'string
305 :type '(choice
306 (string :tag "Single blockquote display string")
307 (repeat :tag "List of possible blockquote display strings" string))
308 :package-version '(markdown-mode . "2.3"))
310 (defcustom markdown-hr-display-char
311 '(?─ ?━ ?-)
312 "Character for hiding horizontal rule markup.
313 This may be a single character or a list of characters. In case
314 of a list, the first one that satisfies `char-displayable-p' will
315 be used."
316 :group 'markdown
317 :type '(choice
318 (character :tag "Single HR display character")
319 (repeat :tag "List of possible HR display characters" character))
320 :package-version '(markdown-mode . "2.3"))
322 (defcustom markdown-definition-display-char
323 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:)
324 "Character for replacing definition list markup.
325 This may be a single character or a list of characters. In case
326 of a list, the first one that satisfies `char-displayable-p' will
327 be used."
328 :type '(choice
329 (character :tag "Single definition list character")
330 (repeat :tag "List of possible definition list characters" character))
331 :package-version '(markdown-mode . "2.3"))
333 (defcustom markdown-enable-math nil
334 "Syntax highlighting for inline LaTeX and itex expressions.
335 Set this to a non-nil value to turn on math support by default.
336 Math support can be enabled, disabled, or toggled later using
337 `markdown-toggle-math' or \\[markdown-toggle-math]."
338 :group 'markdown
339 :type 'boolean
340 :safe 'booleanp)
341 (make-variable-buffer-local 'markdown-enable-math)
343 (defcustom markdown-enable-html t
344 "Enable font-lock support for HTML tags and attributes."
345 :group 'markdown
346 :type 'boolean
347 :safe 'booleanp
348 :package-version '(markdown-mode . "2.4"))
350 (defcustom markdown-enable-highlighting-syntax nil
351 "Enable highlighting syntax."
352 :group 'markdown
353 :type 'boolean
354 :safe 'booleanp
355 :package-version '(markdown-mode . "2.5"))
357 (defcustom markdown-css-paths nil
358 "List of URLs of CSS files to link to in the output XHTML."
359 :group 'markdown
360 :type '(repeat (string :tag "CSS File Path")))
362 (defcustom markdown-content-type "text/html"
363 "Content type string for the http-equiv header in XHTML output.
364 When set to an empty string, this attribute is omitted. Defaults to
365 `text/html'."
366 :group 'markdown
367 :type 'string)
369 (defcustom markdown-coding-system nil
370 "Character set string for the http-equiv header in XHTML output.
371 Defaults to `buffer-file-coding-system' (and falling back to
372 `utf-8' when not available). Common settings are `iso-8859-1'
373 and `iso-latin-1'. Use `list-coding-systems' for more choices."
374 :group 'markdown
375 :type 'coding-system)
377 (defcustom markdown-export-kill-buffer t
378 "Kill output buffer after HTML export.
379 When non-nil, kill the HTML output buffer after
380 exporting with `markdown-export'."
381 :group 'markdown
382 :type 'boolean
383 :safe 'booleanp
384 :package-version '(markdown-mode . "2.4"))
386 (defcustom markdown-xhtml-header-content ""
387 "Additional content to include in the XHTML <head> block."
388 :group 'markdown
389 :type 'string)
391 (defcustom markdown-xhtml-body-preamble ""
392 "Content to include in the XHTML <body> block, before the output."
393 :group 'markdown
394 :type 'string
395 :safe 'stringp
396 :package-version '(markdown-mode . "2.4"))
398 (defcustom markdown-xhtml-body-epilogue ""
399 "Content to include in the XHTML <body> block, after the output."
400 :group 'markdown
401 :type 'string
402 :safe 'stringp
403 :package-version '(markdown-mode . "2.4"))
405 (defcustom markdown-xhtml-standalone-regexp
406 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
407 "Regexp indicating whether `markdown-command' output is standalone XHTML."
408 :group 'markdown
409 :type 'regexp)
411 (defcustom markdown-link-space-sub-char "_"
412 "Character to use instead of spaces when mapping wiki links to filenames."
413 :group 'markdown
414 :type 'string)
416 (defcustom markdown-reference-location 'header
417 "Position where new reference definitions are inserted in the document."
418 :group 'markdown
419 :type '(choice (const :tag "At the end of the document" end)
420 (const :tag "Immediately after the current block" immediately)
421 (const :tag "At the end of the subtree" subtree)
422 (const :tag "Before next header" header)))
424 (defcustom markdown-footnote-location 'end
425 "Position where new footnotes are inserted in the document."
426 :group 'markdown
427 :type '(choice (const :tag "At the end of the document" end)
428 (const :tag "Immediately after the current block" immediately)
429 (const :tag "At the end of the subtree" subtree)
430 (const :tag "Before next header" header)))
432 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8))
433 "Display specification for footnote markers and inline footnotes.
434 By default, footnote text is reduced in size and raised. Set to
435 nil to disable this."
436 :group 'markdown
437 :type '(choice (sexp :tag "Display specification")
438 (const :tag "Don't set display property" nil))
439 :package-version '(markdown-mode . "2.4"))
441 (defcustom markdown-sub-superscript-display
442 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7)))
443 "Display specification for subscript and superscripts.
444 The car is used for subscript, the cdr is used for superscripts."
445 :group 'markdown
446 :type '(cons (choice (sexp :tag "Subscript form")
447 (const :tag "No lowering" nil))
448 (choice (sexp :tag "Superscript form")
449 (const :tag "No raising" nil)))
450 :package-version '(markdown-mode . "2.4"))
452 (defcustom markdown-unordered-list-item-prefix " * "
453 "String inserted before unordered list items."
454 :group 'markdown
455 :type 'string)
457 (defcustom markdown-ordered-list-enumeration t
458 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker.
459 While nil, always uses '1.' for the marker"
460 :group 'markdown
461 :type 'boolean
462 :package-version '(markdown-mode . "2.5"))
464 (defcustom markdown-nested-imenu-heading-index t
465 "Use nested or flat imenu heading index.
466 A nested index may provide more natural browsing from the menu,
467 but a flat list may allow for faster keyboard navigation via tab
468 completion."
469 :group 'markdown
470 :type 'boolean
471 :safe 'booleanp
472 :package-version '(markdown-mode . "2.2"))
474 (defcustom markdown-add-footnotes-to-imenu t
475 "Add footnotes to end of imenu heading index."
476 :group 'markdown
477 :type 'boolean
478 :safe 'booleanp
479 :package-version '(markdown-mode . "2.4"))
481 (defcustom markdown-make-gfm-checkboxes-buttons t
482 "When non-nil, make GFM checkboxes into buttons."
483 :group 'markdown
484 :type 'boolean)
486 (defcustom markdown-use-pandoc-style-yaml-metadata nil
487 "When non-nil, allow YAML metadata anywhere in the document."
488 :group 'markdown
489 :type 'boolean)
491 (defcustom markdown-split-window-direction 'any
492 "Preference for splitting windows for static and live preview.
493 The default value is \\='any, which instructs Emacs to use
494 `split-window-sensibly' to automatically choose how to split
495 windows based on the values of `split-width-threshold' and
496 `split-height-threshold' and the available windows. To force
497 vertically split (left and right) windows, set this to \\='vertical
498 or \\='right. To force horizontally split (top and bottom) windows,
499 set this to \\='horizontal or \\='below.
501 If this value is \\='any and `display-buffer-alist' is set then
502 `display-buffer' is used for open buffer function"
503 :group 'markdown
504 :type '(choice (const :tag "Automatic" any)
505 (const :tag "Right (vertical)" right)
506 (const :tag "Below (horizontal)" below))
507 :package-version '(markdown-mode . "2.2"))
509 (defcustom markdown-live-preview-window-function
510 #'markdown-live-preview-window-eww
511 "Function to display preview of Markdown output within Emacs.
512 Function must update the buffer containing the preview and return
513 the buffer."
514 :group 'markdown
515 :type 'function)
517 (defcustom markdown-live-preview-delete-export 'delete-on-destroy
518 "Delete exported HTML file when using `markdown-live-preview-export'.
519 If set to \\='delete-on-export, delete on every export. When set to
520 \\='delete-on-destroy delete when quitting from command
521 `markdown-live-preview-mode'. Never delete if set to nil."
522 :group 'markdown
523 :type '(choice
524 (const :tag "Delete on every export" delete-on-export)
525 (const :tag "Delete when quitting live preview" delete-on-destroy)
526 (const :tag "Never delete" nil)))
528 (defcustom markdown-list-indent-width 4
529 "Depth of indentation for markdown lists.
530 Used in `markdown-demote-list-item' and
531 `markdown-promote-list-item'."
532 :group 'markdown
533 :type 'integer)
535 (defcustom markdown-enable-prefix-prompts t
536 "Display prompts for certain prefix commands.
537 Set to nil to disable these prompts."
538 :group 'markdown
539 :type 'boolean
540 :safe 'booleanp
541 :package-version '(markdown-mode . "2.3"))
543 (defcustom markdown-gfm-additional-languages nil
544 "Extra languages made available when inserting GFM code blocks.
545 Language strings must have be trimmed of whitespace and not
546 contain any curly braces. They may be of arbitrary
547 capitalization, though."
548 :group 'markdown
549 :type '(repeat (string :validate markdown-validate-language-string)))
551 (defcustom markdown-gfm-use-electric-backquote t
552 "Use `markdown-electric-backquote' when backquote is hit three times."
553 :group 'markdown
554 :type 'boolean)
556 (defcustom markdown-gfm-downcase-languages t
557 "If non-nil, downcase suggested languages.
558 This applies to insertions done with
559 `markdown-electric-backquote'."
560 :group 'markdown
561 :type 'boolean)
563 (defcustom markdown-edit-code-block-default-mode 'normal-mode
564 "Default mode to use for editing code blocks.
565 This mode is used when automatic detection fails, such as for GFM
566 code blocks with no language specified."
567 :group 'markdown
568 :type '(choice function (const :tag "None" nil))
569 :package-version '(markdown-mode . "2.4"))
571 (defcustom markdown-gfm-uppercase-checkbox nil
572 "If non-nil, use [X] for completed checkboxes, [x] otherwise."
573 :group 'markdown
574 :type 'boolean
575 :safe 'booleanp)
577 (defcustom markdown-hide-urls nil
578 "Hide URLs of inline links and reference tags of reference links.
579 Such URLs will be replaced by a single customizable
580 character, defined by `markdown-url-compose-char', but are still part
581 of the buffer. Links can be edited interactively with
582 \\[markdown-insert-link] or, for example, by deleting the final
583 parenthesis to remove the invisibility property. You can also
584 hover your mouse pointer over the link text to see the URL.
585 Set this to a non-nil value to turn this feature on by default.
586 You can interactively set the value of this variable by calling
587 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
588 or from the menu Markdown > Links & Images menu."
589 :group 'markdown
590 :type 'boolean
591 :safe 'booleanp
592 :package-version '(markdown-mode . "2.3"))
593 (make-variable-buffer-local 'markdown-hide-urls)
595 (defcustom markdown-translate-filename-function #'identity
596 "Function to use to translate filenames when following links.
597 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
598 call this function with the filename as only argument whenever
599 they encounter a filename (instead of a URL) to be visited and
600 use its return value instead of the filename in the link. For
601 example, if absolute filenames are actually relative to a server
602 root directory, you can set
603 `markdown-translate-filename-function' to a function that
604 prepends the root directory to the given filename."
605 :group 'markdown
606 :type 'function
607 :risky t
608 :package-version '(markdown-mode . "2.4"))
610 (defcustom markdown-max-image-size nil
611 "Maximum width and height for displayed inline images.
612 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
613 When nil, use the actual size. Otherwise, use ImageMagick to
614 resize larger images to be of the given maximum dimensions. This
615 requires Emacs to be built with ImageMagick support."
616 :group 'markdown
617 :package-version '(markdown-mode . "2.4")
618 :type '(choice
619 (const :tag "Use actual image width" nil)
620 (cons (choice (sexp :tag "Maximum width in pixels")
621 (const :tag "No maximum width" nil))
622 (choice (sexp :tag "Maximum height in pixels")
623 (const :tag "No maximum height" nil)))))
625 (defcustom markdown-mouse-follow-link t
626 "Non-nil means mouse on a link will follow the link.
627 This variable must be set before loading markdown-mode."
628 :group 'markdown
629 :type 'boolean
630 :safe 'booleanp
631 :package-version '(markdown-mode . "2.5"))
633 (defcustom markdown-table-align-p t
634 "Non-nil means that table is aligned after table operation."
635 :group 'markdown
636 :type 'boolean
637 :safe 'booleanp
638 :package-version '(markdown-mode . "2.5"))
640 (defcustom markdown-fontify-whole-heading-line nil
641 "Non-nil means fontify the whole line for headings.
642 This is useful when setting a background color for the
643 markdown-header-face-* faces."
644 :group 'markdown
645 :type 'boolean
646 :safe 'booleanp
647 :package-version '(markdown-mode . "2.5"))
650 ;;; Markdown-Specific `rx' Macro ==============================================
652 ;; Based on python-rx from python.el.
653 (eval-and-compile
654 (defconst markdown-rx-constituents
655 `((newline . ,(rx "\n"))
656 ;; Note: #405 not consider markdown-list-indent-width however this is never used
657 (indent . ,(rx (or (repeat 4 " ") "\t")))
658 (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end))))
659 (numeral . ,(rx (and (one-or-more (any "0-9#")) ".")))
660 (bullet . ,(rx (any "*+:-")))
661 (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".")
662 (any "*+:-"))))
663 (checkbox . ,(rx "[" (any " xX") "]")))
664 "Markdown-specific sexps for `markdown-rx'")
666 (defun markdown-rx-to-string (form &optional no-group)
667 "Markdown mode specialized `rx-to-string' function.
668 This variant supports named Markdown expressions in FORM.
669 NO-GROUP non-nil means don't put shy groups around the result."
670 (let ((rx-constituents (append markdown-rx-constituents rx-constituents)))
671 (rx-to-string form no-group)))
673 (defmacro markdown-rx (&rest regexps)
674 "Markdown mode specialized rx macro.
675 This variant of `rx' supports common Markdown named REGEXPS."
676 (cond ((null regexps)
677 (error "No regexp"))
678 ((cdr regexps)
679 (markdown-rx-to-string `(and ,@regexps) t))
681 (markdown-rx-to-string (car regexps) t)))))
684 ;;; Regular Expressions =======================================================
686 (defconst markdown-regex-comment-start
687 "<!--"
688 "Regular expression matches HTML comment opening.")
690 (defconst markdown-regex-comment-end
691 "--[ \t]*>"
692 "Regular expression matches HTML comment closing.")
694 (defconst markdown-regex-link-inline
695 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)"
696 "Regular expression for a [text](file) or an image link ![text](file).
697 Group 1 matches the leading exclamation point (optional).
698 Group 2 matches the opening square bracket.
699 Group 3 matches the text inside the square brackets.
700 Group 4 matches the closing square bracket.
701 Group 5 matches the opening parenthesis.
702 Group 6 matches the URL.
703 Group 7 matches the title (optional).
704 Group 8 matches the closing parenthesis.")
706 (defconst markdown-regex-link-reference
707 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)"
708 "Regular expression for a reference link [text][id].
709 Group 1 matches the leading exclamation point (optional).
710 Group 2 matches the opening square bracket for the link text.
711 Group 3 matches the text inside the square brackets.
712 Group 4 matches the closing square bracket for the link text.
713 Group 5 matches the opening square bracket for the reference label.
714 Group 6 matches the reference label.
715 Group 7 matches the closing square bracket for the reference label.")
717 (defconst markdown-regex-reference-definition
718 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)"
719 "Regular expression for a reference definition.
720 Group 1 matches the opening square bracket.
721 Group 2 matches the reference label.
722 Group 3 matches the closing square bracket.
723 Group 4 matches the colon.
724 Group 5 matches the URL.
725 Group 6 matches the title attribute (optional).")
727 (defconst markdown-regex-footnote
728 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)"
729 "Regular expression for a footnote marker [^fn].
730 Group 1 matches the opening square bracket and carat.
731 Group 2 matches only the label, without the surrounding markup.
732 Group 3 matches the closing square bracket.")
734 (defconst markdown-regex-header
735 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$"
736 "Regexp identifying Markdown headings.
737 Group 1 matches the text of a setext heading.
738 Group 2 matches the underline of a level-1 setext heading.
739 Group 3 matches the underline of a level-2 setext heading.
740 Group 4 matches the opening hash marks of an atx heading and whitespace.
741 Group 5 matches the text, without surrounding whitespace, of an atx heading.
742 Group 6 matches the closing whitespace and hash marks of an atx heading.")
744 (defconst markdown-regex-header-setext
745 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
746 "Regular expression for generic setext-style (underline) headers.")
748 (defconst markdown-regex-header-atx
749 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
750 "Regular expression for generic atx-style (hash mark) headers.")
752 (defconst markdown-regex-hr
753 (rx line-start
754 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* ")))
755 (and (repeat 3 (and "-" (? " "))) (* (any "- ")))
756 (and (repeat 3 (and "_" (? " "))) (* (any "_ ")))))
757 line-end)
758 "Regular expression for matching Markdown horizontal rules.")
760 (defconst markdown-regex-code
761 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)"
762 "Regular expression for matching inline code fragments.
764 Group 1 matches the entire code fragment including the backquotes.
765 Group 2 matches the opening backquotes.
766 Group 3 matches the code fragment itself, without backquotes.
767 Group 4 matches the closing backquotes.
769 The leading, unnumbered group ensures that the leading backquote
770 character is not escaped.
771 The last group, also unnumbered, requires that the character
772 following the code fragment is not a backquote.
773 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
774 but not two newlines in a row.")
776 (defconst markdown-regex-kbd
777 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)"
778 "Regular expression for matching <kbd> tags.
779 Groups 1 and 3 match the opening and closing tags.
780 Group 2 matches the key sequence.")
782 (defconst markdown-regex-gfm-code-block-open
783 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$"
784 "Regular expression matching opening of GFM code blocks.
785 Group 1 matches the opening three backquotes and any following whitespace.
786 Group 2 matches the opening brace (optional) and surrounding whitespace.
787 Group 3 matches the language identifier (optional).
788 Group 4 matches the info string (optional).
789 Group 5 matches the closing brace (optional), whitespace, and newline.
790 Groups need to agree with `markdown-regex-tilde-fence-begin'.")
792 (defconst markdown-regex-gfm-code-block-close
793 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$"
794 "Regular expression matching closing of GFM code blocks.
795 Group 1 matches the closing three backquotes.
796 Group 2 matches any whitespace and the final newline.")
798 (defconst markdown-regex-pre
799 "^\\( \\|\t\\).*$"
800 "Regular expression for matching preformatted text sections.")
802 (defconst markdown-regex-list
803 (markdown-rx line-start
804 ;; 1. Leading whitespace
805 (group (* blank))
806 ;; 2. List marker: a numeral, bullet, or colon
807 (group list-marker)
808 ;; 3. Trailing whitespace
809 (group (+ blank))
810 ;; 4. Optional checkbox for GFM task list items
811 (opt (group (and checkbox (* blank)))))
812 "Regular expression for matching list items.")
814 (defconst markdown-regex-bold
815 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)"
816 "Regular expression for matching bold text.
817 Group 1 matches the character before the opening asterisk or
818 underscore, if any, ensuring that it is not a backslash escape.
819 Group 2 matches the entire expression, including delimiters.
820 Groups 3 and 5 matches the opening and closing delimiters.
821 Group 4 matches the text inside the delimiters.")
823 (defconst markdown-regex-italic
824 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)"
825 "Regular expression for matching italic text.
826 The leading unnumbered matches the character before the opening
827 asterisk or underscore, if any, ensuring that it is not a
828 backslash escape.
829 Group 1 matches the entire expression, including delimiters.
830 Groups 2 and 4 matches the opening and closing delimiters.
831 Group 3 matches the text inside the delimiters.")
833 (defconst markdown-regex-strike-through
834 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)"
835 "Regular expression for matching strike-through text.
836 Group 1 matches the character before the opening tilde, if any,
837 ensuring that it is not a backslash escape.
838 Group 2 matches the entire expression, including delimiters.
839 Groups 3 and 5 matches the opening and closing delimiters.
840 Group 4 matches the text inside the delimiters.")
842 (defconst markdown-regex-gfm-italic
843 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)"
844 "Regular expression for matching italic text in GitHub Flavored Markdown.
845 Underscores in words are not treated as special.
846 Group 1 matches the entire expression, including delimiters.
847 Groups 2 and 4 matches the opening and closing delimiters.
848 Group 3 matches the text inside the delimiters.")
850 (defconst markdown-regex-blockquote
851 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$"
852 "Regular expression for matching blockquote lines.
853 Also accounts for a potential capital letter preceding the angle
854 bracket, for use with Leanpub blocks (asides, warnings, info
855 blocks, etc.).
856 Group 1 matches the leading angle bracket.
857 Group 2 matches the separating whitespace.
858 Group 3 matches the text.")
860 (defconst markdown-regex-line-break
861 "[^ \n\t][ \t]*\\( \\)\n"
862 "Regular expression for matching line breaks.")
864 (defconst markdown-regex-escape
865 "\\(\\\\\\)."
866 "Regular expression for matching escape sequences.")
868 (defconst markdown-regex-wiki-link
869 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)"
870 "Regular expression for matching wiki links.
871 This matches typical bracketed [[WikiLinks]] as well as \\='aliased
872 wiki links of the form [[PageName|link text]].
873 The meanings of the first and second components depend
874 on the value of `markdown-wiki-link-alias-first'.
876 Group 1 matches the entire link.
877 Group 2 matches the opening square brackets.
878 Group 3 matches the first component of the wiki link.
879 Group 4 matches the pipe separator, when present.
880 Group 5 matches the second component of the wiki link, when present.
881 Group 6 matches the closing square brackets.")
883 (defconst markdown-regex-uri
884 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)")
885 "Regular expression for matching inline URIs.")
887 ;; CommanMark specification says scheme length is 2-32 characters
888 (defconst markdown-regex-angle-uri
889 (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)")
890 "Regular expression for matching inline URIs in angle brackets.")
892 (defconst markdown-regex-email
893 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
894 "Regular expression for matching inline email addresses.")
896 (defsubst markdown-make-regex-link-generic ()
897 "Make regular expression for matching any recognized link."
898 (concat "\\(?:" markdown-regex-link-inline
899 (when markdown-enable-wiki-links
900 (concat "\\|" markdown-regex-wiki-link))
901 "\\|" markdown-regex-link-reference
902 "\\|" markdown-regex-angle-uri "\\)"))
904 (defconst markdown-regex-gfm-checkbox
905 " \\(\\[[ xX]\\]\\) "
906 "Regular expression for matching GFM checkboxes.
907 Group 1 matches the text to become a button.")
909 (defconst markdown-regex-blank-line
910 "^[[:blank:]]*$"
911 "Regular expression that matches a blank line.")
913 (defconst markdown-regex-block-separator
914 "\n[\n\t\f ]*\n"
915 "Regular expression for matching block boundaries.")
917 (defconst markdown-regex-block-separator-noindent
918 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)")
919 "Regexp for block separators before lines with no indentation.")
921 (defconst markdown-regex-math-inline-single
922 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)"
923 "Regular expression for itex $..$ math mode expressions.
924 Groups 1 and 3 match the opening and closing dollar signs.
925 Group 2 matches the mathematical expression contained within.")
927 (defconst markdown-regex-math-inline-double
928 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)"
929 "Regular expression for itex $$..$$ math mode expressions.
930 Groups 1 and 3 match opening and closing dollar signs.
931 Group 2 matches the mathematical expression contained within.")
933 (defconst markdown-regex-math-display
934 (rx line-start (* blank)
935 (group (group (repeat 1 2 "\\")) "[")
936 (group (*? anything))
937 (group (backref 2) "]")
938 line-end)
939 "Regular expression for \[..\] or \\[..\\] display math.
940 Groups 1 and 4 match the opening and closing markup.
941 Group 3 matches the mathematical expression contained within.
942 Group 2 matches the opening slashes, and is used internally to
943 match the closing slashes.")
945 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line)
946 "Return regexp matching a tilde code fence at least NUM-TILDES long.
947 END-OF-LINE is the regexp construct to indicate end of line; $ if
948 missing."
949 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)"
950 (or end-of-line "$")))
952 (defconst markdown-regex-tilde-fence-begin
953 (markdown-make-tilde-fence-regex
954 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
955 "Regular expression for matching tilde-fenced code blocks.
956 Group 1 matches the opening tildes.
957 Group 2 matches (optional) opening brace and surrounding whitespace.
958 Group 3 matches the language identifier (optional).
959 Group 4 matches the info string (optional).
960 Group 5 matches the closing brace (optional) and any surrounding whitespace.
961 Groups need to agree with `markdown-regex-gfm-code-block-open'.")
963 (defconst markdown-regex-declarative-metadata
964 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
965 "Regular expression for matching declarative metadata statements.
966 This matches MultiMarkdown metadata as well as YAML and TOML
967 assignments such as the following:
969 variable: value
973 variable = value")
975 (defconst markdown-regex-pandoc-metadata
976 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
977 "Regular expression for matching Pandoc metadata.")
979 (defconst markdown-regex-yaml-metadata-border
980 "\\(-\\{3\\}\\)$"
981 "Regular expression for matching YAML metadata.")
983 (defconst markdown-regex-yaml-pandoc-metadata-end-border
984 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
985 "Regular expression for matching YAML metadata end borders.")
987 (defsubst markdown-get-yaml-metadata-start-border ()
988 "Return YAML metadata start border depending upon whether Pandoc is used."
989 (concat
990 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`")
991 markdown-regex-yaml-metadata-border))
993 (defsubst markdown-get-yaml-metadata-end-border (_)
994 "Return YAML metadata end border depending upon whether Pandoc is used."
995 (if markdown-use-pandoc-style-yaml-metadata
996 markdown-regex-yaml-pandoc-metadata-end-border
997 markdown-regex-yaml-metadata-border))
999 (defconst markdown-regex-inline-attributes
1000 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$"
1001 "Regular expression for matching inline identifiers or attribute lists.
1002 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
1004 (defconst markdown-regex-leanpub-sections
1005 (concat
1006 "^\\({\\)\\("
1007 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
1008 "\\)\\(}\\)[ \t]*\n")
1009 "Regular expression for Leanpub section markers and related syntax.")
1011 (defconst markdown-regex-sub-superscript
1012 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)"
1013 "The regular expression matching a sub- or superscript.
1014 The leading un-numbered group matches the character before the
1015 opening tilde or carat, if any, ensuring that it is not a
1016 backslash escape, carat, or tilde.
1017 Group 1 matches the entire expression, including markup.
1018 Group 2 matches the opening markup--a tilde or carat.
1019 Group 3 matches the text inside the delimiters.
1020 Group 4 matches the closing markup--a tilde or carat.")
1022 (defconst markdown-regex-include
1023 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$"
1024 "Regular expression matching common forms of include syntax.
1025 Marked 2, Leanpub, and other processors support some of these forms:
1027 <<[sections/section1.md]
1028 <<(folder/filename)
1029 <<[Code title](folder/filename)
1030 <<{folder/raw_file.html}
1032 Group 1 matches the opening two angle brackets.
1033 Groups 2-4 match the opening square bracket, the text inside,
1034 and the closing square bracket, respectively.
1035 Groups 5-7 match the opening parenthesis, the text inside, and
1036 the closing parenthesis.
1037 Groups 8-10 match the opening brace, the text inside, and the brace.")
1039 (defconst markdown-regex-pandoc-inline-footnote
1040 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)"
1041 "Regular expression for Pandoc inline footnote^[footnote text].
1042 Group 1 matches the opening caret.
1043 Group 2 matches the opening square bracket.
1044 Group 3 matches the footnote text, without the surrounding markup.
1045 Group 4 matches the closing square bracket.")
1047 (defconst markdown-regex-html-attr
1048 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
1049 "Regular expression for matching HTML attributes and values.
1050 Group 1 matches the attribute name.
1051 Group 2 matches the following whitespace, equals sign, and value, if any.
1052 Group 3 matches the equals sign, if any.
1053 Group 4 matches single-, double-, or un-quoted attribute values.")
1055 (defconst markdown-regex-html-tag
1056 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
1057 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
1058 "Regular expression for matching HTML tags.
1059 Groups 1 and 9 match the beginning and ending angle brackets and slashes.
1060 Group 2 matches the tag name.
1061 Group 3 matches all attributes and whitespace following the tag name.")
1063 (defconst markdown-regex-html-entity
1064 "\\(&#?[[:alnum:]]+;\\)"
1065 "Regular expression for matching HTML entities.")
1067 (defconst markdown-regex-highlighting
1068 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)"
1069 "Regular expression for matching highlighting text.
1070 Group 1 matches the character before the opening equal, if any,
1071 ensuring that it is not a backslash escape.
1072 Group 2 matches the entire expression, including delimiters.
1073 Groups 3 and 5 matches the opening and closing delimiters.
1074 Group 4 matches the text inside the delimiters.")
1077 ;;; Syntax ====================================================================
1079 (defvar markdown--syntax-properties
1080 (list 'markdown-tilde-fence-begin nil
1081 'markdown-tilde-fence-end nil
1082 'markdown-fenced-code nil
1083 'markdown-yaml-metadata-begin nil
1084 'markdown-yaml-metadata-end nil
1085 'markdown-yaml-metadata-section nil
1086 'markdown-gfm-block-begin nil
1087 'markdown-gfm-block-end nil
1088 'markdown-gfm-code nil
1089 'markdown-list-item nil
1090 'markdown-pre nil
1091 'markdown-blockquote nil
1092 'markdown-hr nil
1093 'markdown-comment nil
1094 'markdown-heading nil
1095 'markdown-heading-1-setext nil
1096 'markdown-heading-2-setext nil
1097 'markdown-heading-1-atx nil
1098 'markdown-heading-2-atx nil
1099 'markdown-heading-3-atx nil
1100 'markdown-heading-4-atx nil
1101 'markdown-heading-5-atx nil
1102 'markdown-heading-6-atx nil
1103 'markdown-metadata-key nil
1104 'markdown-metadata-value nil
1105 'markdown-metadata-markup nil)
1106 "Property list of all Markdown syntactic properties.")
1108 (defsubst markdown-in-comment-p (&optional pos)
1109 "Return non-nil if POS is in a comment.
1110 If POS is not given, use point instead."
1111 (get-text-property (or pos (point)) 'markdown-comment))
1113 (defun markdown--face-p (pos faces)
1114 "Return non-nil if face of POS contain FACES."
1115 (let ((face-prop (get-text-property pos 'face)))
1116 (if (listp face-prop)
1117 (cl-loop for face in face-prop
1118 thereis (memq face faces))
1119 (memq face-prop faces))))
1121 (defun markdown-syntax-propertize-extend-region (start end)
1122 "Extend START to END region to include an entire block of text.
1123 This helps improve syntax analysis for block constructs.
1124 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
1125 Function is called repeatedly until it returns nil. For details, see
1126 `syntax-propertize-extend-region-functions'."
1127 (save-match-data
1128 (save-excursion
1129 (let* ((new-start (progn (goto-char start)
1130 (skip-chars-forward "\n")
1131 (if (re-search-backward "\n\n" nil t)
1132 (min start (match-end 0))
1133 (point-min))))
1134 (new-end (progn (goto-char end)
1135 (skip-chars-backward "\n")
1136 (if (re-search-forward "\n\n" nil t)
1137 (max end (match-beginning 0))
1138 (point-max))))
1139 (code-match (markdown-code-block-at-pos new-start))
1140 ;; FIXME: The `code-match' can return bogus values
1141 ;; when text has been inserted/deleted!
1142 (new-start (min (or (and code-match (cl-first code-match))
1143 (point-max))
1144 new-start))
1145 (code-match (and (< end (point-max))
1146 (markdown-code-block-at-pos end)))
1147 (new-end (max (or (and code-match (cl-second code-match)) 0)
1148 new-end)))
1150 (unless (and (eq new-start start) (eq new-end end))
1151 (cons new-start (min new-end (point-max))))))))
1153 (defun markdown-font-lock-extend-region-function (start end _)
1154 "Used in `jit-lock-after-change-extend-region-functions'.
1155 Delegates to `markdown-syntax-propertize-extend-region'. START
1156 and END are the previous region to refontify."
1157 (let ((res (markdown-syntax-propertize-extend-region start end)))
1158 (when res
1159 ;; syntax-propertize-function is not called when character at
1160 ;; (point-max) is deleted, but font-lock-extend-region-functions
1161 ;; are called. Force a syntax property update in that case.
1162 (when (= end (point-max))
1163 ;; This function is called in a buffer modification hook.
1164 ;; `markdown-syntax-propertize' doesn't save the match data,
1165 ;; so we have to do it here.
1166 (save-match-data
1167 (markdown-syntax-propertize (car res) (cdr res))))
1168 (setq jit-lock-start (car res)
1169 jit-lock-end (cdr res)))))
1171 (defun markdown--cur-list-item-bounds ()
1172 "Return a list describing the list item at point.
1173 Assumes that match data is set for `markdown-regex-list'. See the
1174 documentation for `markdown-cur-list-item-bounds' for the format of
1175 the returned list."
1176 (save-excursion
1177 (let* ((begin (match-beginning 0))
1178 (indent (length (match-string-no-properties 1)))
1179 (nonlist-indent (- (match-end 3) (match-beginning 0)))
1180 (marker (buffer-substring-no-properties
1181 (match-beginning 2) (match-end 3)))
1182 (checkbox (match-string-no-properties 4))
1183 (match (butlast (match-data t)))
1184 (end (markdown-cur-list-item-end nonlist-indent)))
1185 (list begin end indent nonlist-indent marker checkbox match))))
1187 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds)
1188 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
1189 Here, MARKER is a string representing the type of list and INDENT
1190 is an integer giving the indentation, in spaces, of the current
1191 block. CUR-BOUNDS is a list of the form returned by
1192 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
1193 values for parent list items. When BOUNDS is nil, it means we are
1194 at baseline (not inside of a nested list)."
1195 (let ((prev-indent (or (cl-third (car bounds)) 0)))
1196 (cond
1197 ;; New list item at baseline.
1198 ((and marker (null bounds))
1199 (list cur-bounds))
1200 ;; List item with greater indentation (four or more spaces).
1201 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
1202 ((and marker (>= indent (+ prev-indent markdown-list-indent-width)))
1203 (cons cur-bounds bounds))
1204 ;; List item with greater or equal indentation (less than four spaces).
1205 ;; Keep list level the same by replacing the car of BOUNDS.
1206 ((and marker (>= indent prev-indent))
1207 (cons cur-bounds (cdr bounds)))
1208 ;; Lesser indentation level.
1209 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
1210 ;; indentation could move back more than one list level). Note
1211 ;; that this block need not be the beginning of list item.
1212 ((< indent prev-indent)
1213 (while (and (> (length bounds) 1)
1214 (setq prev-indent (cl-third (cadr bounds)))
1215 (< indent (+ prev-indent markdown-list-indent-width)))
1216 (setq bounds (cdr bounds)))
1217 (cons cur-bounds bounds))
1218 ;; Otherwise, do nothing.
1219 (t bounds))))
1221 (defun markdown-syntax-propertize-list-items (start end)
1222 "Propertize list items from START to END.
1223 Stores nested list item information in the `markdown-list-item'
1224 text property to make later syntax analysis easier. The value of
1225 this property is a list with elements of the form (begin . end)
1226 giving the bounds of the current and parent list items."
1227 (save-excursion
1228 (goto-char start)
1229 (let ((prev-list-line -100)
1230 bounds level pre-regexp)
1231 ;; Find a baseline point with zero list indentation
1232 (markdown-search-backward-baseline)
1233 ;; Search for all list items between baseline and END
1234 (while (and (< (point) end)
1235 (re-search-forward markdown-regex-list end 'limit))
1236 ;; Level of list nesting
1237 (setq level (length bounds))
1238 ;; Pre blocks need to be indented one level past the list level
1239 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level)))
1240 (beginning-of-line)
1241 (cond
1242 ;; Reset at headings, horizontal rules, and top-level blank lines.
1243 ;; Propertize baseline when in range.
1244 ((markdown-new-baseline)
1245 (setq bounds nil))
1246 ;; Make sure this is not a line from a pre block
1247 ((and (looking-at-p pre-regexp)
1248 ;; too indented line is also treated as list if previous line is list
1249 (>= (- (line-number-at-pos) prev-list-line) 2)))
1250 ;; If not, then update levels and propertize list item when in range.
1252 (let* ((indent (current-indentation))
1253 (cur-bounds (markdown--cur-list-item-bounds))
1254 (first (cl-first cur-bounds))
1255 (last (cl-second cur-bounds))
1256 (marker (cl-fifth cur-bounds)))
1257 (setq bounds (markdown--append-list-item-bounds
1258 marker indent cur-bounds bounds))
1259 (when (and (<= start (point)) (<= (point) end))
1260 (setq prev-list-line (line-number-at-pos first))
1261 (put-text-property first last 'markdown-list-item bounds)))))
1262 (end-of-line)))))
1264 (defun markdown-syntax-propertize-pre-blocks (start end)
1265 "Match preformatted text blocks from START to END."
1266 (save-excursion
1267 (goto-char start)
1268 (let (finish)
1269 ;; Use loop for avoiding too many recursive calls
1270 ;; https://github.com/jrblevin/markdown-mode/issues/512
1271 (while (not finish)
1272 (let ((levels (markdown-calculate-list-levels))
1273 indent pre-regexp close-regexp open close)
1274 (while (and (< (point) end) (not close))
1275 ;; Search for a region with sufficient indentation
1276 (if (null levels)
1277 (setq indent 1)
1278 (setq indent (1+ (length levels))))
1279 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent))
1280 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent)))
1282 (cond
1283 ;; If not at the beginning of a line, move forward
1284 ((not (bolp)) (forward-line))
1285 ;; Move past blank lines
1286 ((markdown-cur-line-blank-p) (forward-line))
1287 ;; At headers and horizontal rules, reset levels
1288 ((markdown-new-baseline) (forward-line) (setq levels nil))
1289 ;; If the current line has sufficient indentation, mark out pre block
1290 ;; The opening should be preceded by a blank line.
1291 ((and (markdown-prev-line-blank) (looking-at pre-regexp))
1292 (setq open (match-beginning 0))
1293 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p))
1294 (not (eobp)))
1295 (forward-line))
1296 (skip-syntax-backward "-")
1297 (setq close (point)))
1298 ;; If current line has a list marker, update levels, move to end of block
1299 ((looking-at markdown-regex-list)
1300 (setq levels (markdown-update-list-levels
1301 (match-string 2) (current-indentation) levels))
1302 (markdown-end-of-text-block))
1303 ;; If this is the end of the indentation level, adjust levels accordingly.
1304 ;; Only match end of indentation level if levels is not the empty list.
1305 ((and (car levels) (looking-at-p close-regexp))
1306 (setq levels (markdown-update-list-levels
1307 nil (current-indentation) levels))
1308 (markdown-end-of-text-block))
1309 (t (markdown-end-of-text-block))))
1311 (if (and open close)
1312 ;; Set text property data and continue to search
1313 (put-text-property open close 'markdown-pre (list open close))
1314 (setq finish t))))
1315 nil)))
1317 (defconst markdown-fenced-block-pairs
1318 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin)
1319 (markdown-make-tilde-fence-regex markdown-tilde-fence-end)
1320 markdown-fenced-code)
1321 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin)
1322 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end)
1323 markdown-yaml-metadata-section)
1324 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin)
1325 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end)
1326 markdown-gfm-code))
1327 "Mapping of regular expressions to \"fenced-block\" constructs.
1328 These constructs are distinguished by having a distinctive start
1329 and end pattern, both of which take up an entire line of text,
1330 but no special pattern to identify text within the fenced
1331 blocks (unlike blockquotes and indented-code sections).
1333 Each element within this list takes the form:
1335 ((START-REGEX-OR-FUN START-PROPERTY)
1336 (END-REGEX-OR-FUN END-PROPERTY)
1337 MIDDLE-PROPERTY)
1339 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
1340 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
1341 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
1342 which is the length of the first group of the START-REGEX-OR-FUN match, which
1343 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
1344 evaluate these into \"real\" regexps.
1346 The *-PROPERTY elements are the text properties applied to each part of the
1347 block construct when it is matched using
1348 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
1349 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
1350 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
1351 `match-data' when the regexp was matched to the text. In the case of
1352 MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with
1353 begin and end set to the edges of the \"middle\" text. This makes fontification
1354 easier.")
1356 (defun markdown-text-property-at-point (prop)
1357 (get-text-property (point) prop))
1359 (defsubst markdown-maybe-funcall-regexp (object &optional arg)
1360 (cond ((functionp object)
1361 (if arg (funcall object arg) (funcall object)))
1362 ((stringp object) object)
1363 (t (error "Object cannot be turned into regex"))))
1365 (defsubst markdown-get-start-fence-regexp ()
1366 "Return regexp to find all \"start\" sections of fenced block constructs.
1367 Which construct is actually contained in the match must be found separately."
1368 (mapconcat
1369 #'identity
1370 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry)))
1371 markdown-fenced-block-pairs)
1372 "\\|"))
1374 (defun markdown-get-fenced-block-begin-properties ()
1375 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs))
1377 (defun markdown-get-fenced-block-end-properties ()
1378 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs))
1380 (defun markdown-get-fenced-block-middle-properties ()
1381 (cl-mapcar #'cl-third markdown-fenced-block-pairs))
1383 (defun markdown-find-previous-prop (prop &optional lim)
1384 "Find previous place where property PROP is non-nil, up to LIM.
1385 Return a cons of (pos . property). pos is point if point contains
1386 non-nil PROP."
1387 (let ((res
1388 (if (get-text-property (point) prop) (point)
1389 (previous-single-property-change
1390 (point) prop nil (or lim (point-min))))))
1391 (when (and (not (get-text-property res prop))
1392 (> res (point-min))
1393 (get-text-property (1- res) prop))
1394 (cl-decf res))
1395 (when (and res (get-text-property res prop)) (cons res prop))))
1397 (defun markdown-find-next-prop (prop &optional lim)
1398 "Find next place where property PROP is non-nil, up to LIM.
1399 Return a cons of (POS . PROPERTY) where POS is point if point
1400 contains non-nil PROP."
1401 (let ((res
1402 (if (get-text-property (point) prop) (point)
1403 (next-single-property-change
1404 (point) prop nil (or lim (point-max))))))
1405 (when (and res (get-text-property res prop)) (cons res prop))))
1407 (defun markdown-min-of-seq (map-fn seq)
1408 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
1409 (cl-loop for el in seq
1410 with min = 1.0e+INF ; infinity
1411 with min-el = nil
1412 do (let ((res (funcall map-fn el)))
1413 (when (< res min)
1414 (setq min res)
1415 (setq min-el el)))
1416 finally return min-el))
1418 (defun markdown-max-of-seq (map-fn seq)
1419 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
1420 (cl-loop for el in seq
1421 with max = -1.0e+INF ; negative infinity
1422 with max-el = nil
1423 do (let ((res (funcall map-fn el)))
1424 (when (and res (> res max))
1425 (setq max res)
1426 (setq max-el el)))
1427 finally return max-el))
1429 (defun markdown-find-previous-block ()
1430 "Find previous block.
1431 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
1432 unable to propertize the entire block, but was able to propertize the beginning
1433 of the block. If so, return a cons of (pos . property) where the beginning of
1434 the block was propertized."
1435 (let ((start-pt (point))
1436 (closest-open
1437 (markdown-max-of-seq
1438 #'car
1439 (cl-remove-if
1440 #'null
1441 (cl-mapcar
1442 #'markdown-find-previous-prop
1443 (markdown-get-fenced-block-begin-properties))))))
1444 (when closest-open
1445 (let* ((length-of-open-match
1446 (let ((match-d
1447 (get-text-property (car closest-open) (cdr closest-open))))
1448 (- (cl-fourth match-d) (cl-third match-d))))
1449 (end-regexp
1450 (markdown-maybe-funcall-regexp
1451 (cl-caadr
1452 (cl-find-if
1453 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open)))
1454 markdown-fenced-block-pairs))
1455 length-of-open-match))
1456 (end-prop-loc
1457 (save-excursion
1458 (save-match-data
1459 (goto-char (car closest-open))
1460 (and (re-search-forward end-regexp start-pt t)
1461 (match-beginning 0))))))
1462 (and (not end-prop-loc) closest-open)))))
1464 (defun markdown-get-fenced-block-from-start (prop)
1465 "Return limits of an enclosing fenced block from its start, using PROP.
1466 Return value is a list usable as `match-data'."
1467 (catch 'no-rest-of-block
1468 (let* ((correct-entry
1469 (cl-find-if
1470 (lambda (entry) (eq (cl-cadar entry) prop))
1471 markdown-fenced-block-pairs))
1472 (begin-of-begin (cl-first (markdown-text-property-at-point prop)))
1473 (middle-prop (cl-third correct-entry))
1474 (end-prop (cl-cadadr correct-entry))
1475 (end-of-end
1476 (save-excursion
1477 (goto-char (match-end 0)) ; end of begin
1478 (unless (eobp) (forward-char))
1479 (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
1480 (if (not mid-prop-v) ; no middle
1481 (progn
1482 ;; try to find end by advancing one
1483 (let ((end-prop-v
1484 (markdown-text-property-at-point end-prop)))
1485 (if end-prop-v (cl-second end-prop-v)
1486 (throw 'no-rest-of-block nil))))
1487 (set-match-data mid-prop-v)
1488 (goto-char (match-end 0)) ; end of middle
1489 (beginning-of-line) ; into end
1490 (cl-second (markdown-text-property-at-point end-prop)))))))
1491 (list begin-of-begin end-of-end))))
1493 (defun markdown-get-fenced-block-from-middle (prop)
1494 "Return limits of an enclosing fenced block from its middle, using PROP.
1495 Return value is a list usable as `match-data'."
1496 (let* ((correct-entry
1497 (cl-find-if
1498 (lambda (entry) (eq (cl-third entry) prop))
1499 markdown-fenced-block-pairs))
1500 (begin-prop (cl-cadar correct-entry))
1501 (begin-of-begin
1502 (save-excursion
1503 (goto-char (match-beginning 0))
1504 (unless (bobp) (forward-line -1))
1505 (beginning-of-line)
1506 (cl-first (markdown-text-property-at-point begin-prop))))
1507 (end-prop (cl-cadadr correct-entry))
1508 (end-of-end
1509 (save-excursion
1510 (goto-char (match-end 0))
1511 (beginning-of-line)
1512 (cl-second (markdown-text-property-at-point end-prop)))))
1513 (list begin-of-begin end-of-end)))
1515 (defun markdown-get-fenced-block-from-end (prop)
1516 "Return limits of an enclosing fenced block from its end, using PROP.
1517 Return value is a list usable as `match-data'."
1518 (let* ((correct-entry
1519 (cl-find-if
1520 (lambda (entry) (eq (cl-cadadr entry) prop))
1521 markdown-fenced-block-pairs))
1522 (end-of-end (cl-second (markdown-text-property-at-point prop)))
1523 (middle-prop (cl-third correct-entry))
1524 (begin-prop (cl-cadar correct-entry))
1525 (begin-of-begin
1526 (save-excursion
1527 (goto-char (match-beginning 0)) ; beginning of end
1528 (unless (bobp) (backward-char)) ; into middle
1529 (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
1530 (if (not mid-prop-v)
1531 (progn
1532 (beginning-of-line)
1533 (cl-first (markdown-text-property-at-point begin-prop)))
1534 (set-match-data mid-prop-v)
1535 (goto-char (match-beginning 0)) ; beginning of middle
1536 (unless (bobp) (forward-line -1)) ; into beginning
1537 (beginning-of-line)
1538 (cl-first (markdown-text-property-at-point begin-prop)))))))
1539 (list begin-of-begin end-of-end)))
1541 (defun markdown-get-enclosing-fenced-block-construct (&optional pos)
1542 "Get \"fake\" match data for block enclosing POS.
1543 Returns fake match data which encloses the start, middle, and end
1544 of the block construct enclosing POS, if it exists. Used in
1545 `markdown-code-block-at-pos'."
1546 (save-excursion
1547 (when pos (goto-char pos))
1548 (beginning-of-line)
1549 (car
1550 (cl-remove-if
1551 #'null
1552 (cl-mapcar
1553 (lambda (fun-and-prop)
1554 (cl-destructuring-bind (fun prop) fun-and-prop
1555 (when prop
1556 (save-match-data
1557 (set-match-data (markdown-text-property-at-point prop))
1558 (funcall fun prop)))))
1559 `((markdown-get-fenced-block-from-start
1560 ,(cl-find-if
1561 #'markdown-text-property-at-point
1562 (markdown-get-fenced-block-begin-properties)))
1563 (markdown-get-fenced-block-from-middle
1564 ,(cl-find-if
1565 #'markdown-text-property-at-point
1566 (markdown-get-fenced-block-middle-properties)))
1567 (markdown-get-fenced-block-from-end
1568 ,(cl-find-if
1569 #'markdown-text-property-at-point
1570 (markdown-get-fenced-block-end-properties)))))))))
1572 (defun markdown-propertize-end-match (reg end fence-spec middle-begin)
1573 "Get match for REG up to END, if exists, and propertize appropriately.
1574 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
1575 MIDDLE-BEGIN is the start of the \"middle\" section of the block."
1576 (when (re-search-forward reg end t)
1577 (let ((close-begin (match-beginning 0)) ; Start of closing line.
1578 (close-end (match-end 0)) ; End of closing line.
1579 (close-data (match-data t))) ; Match data for closing line.
1580 ;; Propertize middle section of fenced block.
1581 (put-text-property middle-begin close-begin
1582 (cl-third fence-spec)
1583 (list middle-begin close-begin))
1584 ;; If the block is a YAML block, propertize the declarations inside
1585 (when (< middle-begin close-begin) ;; workaround #634
1586 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin))
1587 ;; Propertize closing line of fenced block.
1588 (put-text-property close-begin close-end
1589 (cl-cadadr fence-spec) close-data))))
1591 (defun markdown--triple-quote-single-line-p (begin)
1592 (save-excursion
1593 (goto-char begin)
1594 (save-match-data
1595 (and (search-forward "```" nil t)
1596 (search-forward "```" (line-end-position) t)))))
1598 (defun markdown-syntax-propertize-fenced-block-constructs (start end)
1599 "Propertize according to `markdown-fenced-block-pairs' from START to END.
1600 If unable to propertize an entire block (if the start of a block is within START
1601 and END, but the end of the block is not), propertize the start section of a
1602 block, then in a subsequent call propertize both middle and end by finding the
1603 start which was previously propertized."
1604 (let ((start-reg (markdown-get-start-fence-regexp)))
1605 (save-excursion
1606 (goto-char start)
1607 ;; start from previous unclosed block, if exists
1608 (let ((prev-begin-block (markdown-find-previous-block)))
1609 (when prev-begin-block
1610 (let* ((correct-entry
1611 (cl-find-if (lambda (entry)
1612 (eq (cdr prev-begin-block) (cl-cadar entry)))
1613 markdown-fenced-block-pairs))
1614 (enclosed-text-start (1+ (car prev-begin-block)))
1615 (start-length
1616 (save-excursion
1617 (goto-char (car prev-begin-block))
1618 (string-match
1619 (markdown-maybe-funcall-regexp
1620 (caar correct-entry))
1621 (buffer-substring
1622 (line-beginning-position) (line-end-position)))
1623 (- (match-end 1) (match-beginning 1))))
1624 (end-reg (markdown-maybe-funcall-regexp
1625 (cl-caadr correct-entry) start-length)))
1626 (markdown-propertize-end-match
1627 end-reg end correct-entry enclosed-text-start))))
1628 ;; find all new blocks within region
1629 (while (re-search-forward start-reg end t)
1630 ;; we assume the opening constructs take up (only) an entire line,
1631 ;; so we re-check the current line
1632 (let* ((block-start (match-beginning 0))
1633 (cur-line (buffer-substring (line-beginning-position) (line-end-position)))
1634 ;; find entry in `markdown-fenced-block-pairs' corresponding
1635 ;; to regex which was matched
1636 (correct-entry
1637 (cl-find-if
1638 (lambda (fenced-pair)
1639 (string-match-p
1640 (markdown-maybe-funcall-regexp (caar fenced-pair))
1641 cur-line))
1642 markdown-fenced-block-pairs))
1643 (enclosed-text-start
1644 (save-excursion (1+ (line-end-position))))
1645 (end-reg
1646 (markdown-maybe-funcall-regexp
1647 (cl-caadr correct-entry)
1648 (if (and (match-beginning 1) (match-end 1))
1649 (- (match-end 1) (match-beginning 1))
1650 0)))
1651 (prop (cl-cadar correct-entry)))
1652 (when (or (not (eq prop 'markdown-gfm-block-begin))
1653 (not (markdown--triple-quote-single-line-p block-start)))
1654 ;; get correct match data
1655 (save-excursion
1656 (beginning-of-line)
1657 (re-search-forward
1658 (markdown-maybe-funcall-regexp (caar correct-entry))
1659 (line-end-position)))
1660 ;; mark starting, even if ending is outside of region
1661 (put-text-property (match-beginning 0) (match-end 0) prop (match-data t))
1662 (markdown-propertize-end-match
1663 end-reg end correct-entry enclosed-text-start)))))))
1665 (defun markdown-syntax-propertize-blockquotes (start end)
1666 "Match blockquotes from START to END."
1667 (save-excursion
1668 (goto-char start)
1669 (while (and (re-search-forward markdown-regex-blockquote end t)
1670 (not (markdown-code-block-at-pos (match-beginning 0))))
1671 (put-text-property (match-beginning 0) (match-end 0)
1672 'markdown-blockquote
1673 (match-data t)))))
1675 (defun markdown-syntax-propertize-hrs (start end)
1676 "Match horizontal rules from START to END."
1677 (save-excursion
1678 (goto-char start)
1679 (while (re-search-forward markdown-regex-hr end t)
1680 (let ((beg (match-beginning 0))
1681 (end (match-end 0)))
1682 (goto-char beg)
1683 (unless (or (markdown-on-heading-p)
1684 (markdown-code-block-at-point-p))
1685 (put-text-property beg end 'markdown-hr (match-data t)))
1686 (goto-char end)))))
1688 (defun markdown-syntax-propertize-yaml-metadata (start end)
1689 "Propertize elements inside YAML metadata blocks from START to END.
1690 Assumes region from START and END is already known to be the interior
1691 region of a YAML metadata block as propertized by
1692 `markdown-syntax-propertize-fenced-block-constructs'."
1693 (save-excursion
1694 (goto-char start)
1695 (cl-loop
1696 while (re-search-forward markdown-regex-declarative-metadata end t)
1697 do (progn
1698 (put-text-property (match-beginning 1) (match-end 1)
1699 'markdown-metadata-key (match-data t))
1700 (put-text-property (match-beginning 2) (match-end 2)
1701 'markdown-metadata-markup (match-data t))
1702 (put-text-property (match-beginning 3) (match-end 3)
1703 'markdown-metadata-value (match-data t))))))
1705 (defun markdown-syntax-propertize-headings (start end)
1706 "Match headings of type SYMBOL with REGEX from START to END."
1707 (goto-char start)
1708 (while (re-search-forward markdown-regex-header end t)
1709 (unless (markdown-code-block-at-pos (match-beginning 0))
1710 (put-text-property
1711 (match-beginning 0) (match-end 0) 'markdown-heading
1712 (match-data t))
1713 (put-text-property
1714 (match-beginning 0) (match-end 0)
1715 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext)
1716 ((match-string-no-properties 3) 'markdown-heading-2-setext)
1717 (t (let ((atx-level (length (markdown-trim-whitespace
1718 (match-string-no-properties 4)))))
1719 (intern (format "markdown-heading-%d-atx" atx-level)))))
1720 (match-data t)))))
1722 (defun markdown-syntax-propertize-comments (start end)
1723 "Match HTML comments from the START to END."
1724 ;; Implement by loop instead of recursive call for avoiding
1725 ;; exceed max-lisp-eval-depth issue
1726 ;; https://github.com/jrblevin/markdown-mode/issues/536
1727 (let (finish)
1728 (goto-char start)
1729 (while (not finish)
1730 (let* ((in-comment (nth 4 (syntax-ppss)))
1731 (comment-begin (nth 8 (syntax-ppss))))
1732 (cond
1733 ;; Comment start
1734 ((and (not in-comment)
1735 (re-search-forward markdown-regex-comment-start end t)
1736 (not (markdown-inline-code-at-point-p))
1737 (not (markdown-code-block-at-point-p)))
1738 (let ((open-beg (match-beginning 0)))
1739 (put-text-property open-beg (1+ open-beg)
1740 'syntax-table (string-to-syntax "<"))
1741 (goto-char (min (1+ (match-end 0)) end (point-max)))))
1742 ;; Comment end
1743 ((and in-comment comment-begin
1744 (re-search-forward markdown-regex-comment-end end t))
1745 (let ((comment-end (match-end 0)))
1746 (put-text-property (1- comment-end) comment-end
1747 'syntax-table (string-to-syntax ">"))
1748 ;; Remove any other text properties inside the comment
1749 (remove-text-properties comment-begin comment-end
1750 markdown--syntax-properties)
1751 (put-text-property comment-begin comment-end
1752 'markdown-comment (list comment-begin comment-end))
1753 (goto-char (min comment-end end (point-max)))))
1754 ;; Nothing found
1755 (t (setq finish t)))))
1756 nil))
1758 (defun markdown-syntax-propertize (start end)
1759 "Function used as `syntax-propertize-function'.
1760 START and END delimit region to propertize."
1761 (with-silent-modifications
1762 (save-excursion
1763 (remove-text-properties start end markdown--syntax-properties)
1764 (markdown-syntax-propertize-fenced-block-constructs start end)
1765 (markdown-syntax-propertize-list-items start end)
1766 (markdown-syntax-propertize-pre-blocks start end)
1767 (markdown-syntax-propertize-blockquotes start end)
1768 (markdown-syntax-propertize-headings start end)
1769 (markdown-syntax-propertize-hrs start end)
1770 (markdown-syntax-propertize-comments start end))))
1773 ;;; Markup Hiding =============================================================
1775 (defconst markdown-markup-properties
1776 '(face markdown-markup-face invisible markdown-markup)
1777 "List of properties and values to apply to markup.")
1779 (defconst markdown-language-keyword-properties
1780 '(face markdown-language-keyword-face invisible markdown-markup)
1781 "List of properties and values to apply to code block language names.")
1783 (defconst markdown-language-info-properties
1784 '(face markdown-language-info-face invisible markdown-markup)
1785 "List of properties and values to apply to code block language info strings.")
1787 (defconst markdown-include-title-properties
1788 '(face markdown-link-title-face invisible markdown-markup)
1789 "List of properties and values to apply to included code titles.")
1791 (defcustom markdown-hide-markup nil
1792 "Determines whether markup in the buffer will be hidden.
1793 When set to nil, all markup is displayed in the buffer as it
1794 appears in the file. An exception is when `markdown-hide-urls'
1795 is non-nil.
1796 Set this to a non-nil value to turn this feature on by default.
1797 You can interactively toggle the value of this variable with
1798 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
1799 or from the Markdown > Show & Hide menu.
1801 Markup hiding works by adding text properties to positions in the
1802 buffer---either the `invisible' property or the `display' property
1803 in cases where alternative glyphs are used (e.g., list bullets).
1804 This does not, however, affect printing or other output.
1805 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
1806 not honor these text properties. For printing, it would be better
1807 to first convert to HTML or PDF (e.g,. using Pandoc)."
1808 :group 'markdown
1809 :type 'boolean
1810 :safe 'booleanp
1811 :package-version '(markdown-mode . "2.3"))
1812 (make-variable-buffer-local 'markdown-hide-markup)
1814 (defun markdown-toggle-markup-hiding (&optional arg)
1815 "Toggle the display or hiding of markup.
1816 With a prefix argument ARG, enable markup hiding if ARG is positive,
1817 and disable it otherwise.
1818 See `markdown-hide-markup' for additional details."
1819 (interactive (list (or current-prefix-arg 'toggle)))
1820 (setq markdown-hide-markup
1821 (if (eq arg 'toggle)
1822 (not markdown-hide-markup)
1823 (> (prefix-numeric-value arg) 0)))
1824 (if markdown-hide-markup
1825 (progn (add-to-invisibility-spec 'markdown-markup)
1826 (message "markdown-mode markup hiding enabled"))
1827 (progn (remove-from-invisibility-spec 'markdown-markup)
1828 (message "markdown-mode markup hiding disabled")))
1829 (markdown-reload-extensions))
1832 ;;; Font Lock =================================================================
1834 (require 'font-lock)
1836 (defgroup markdown-faces nil
1837 "Faces used in Markdown Mode."
1838 :group 'markdown
1839 :group 'faces)
1841 (defface markdown-italic-face
1842 '((t (:inherit italic)))
1843 "Face for italic text."
1844 :group 'markdown-faces)
1846 (defface markdown-bold-face
1847 '((t (:inherit bold)))
1848 "Face for bold text."
1849 :group 'markdown-faces)
1851 (defface markdown-strike-through-face
1852 '((t (:strike-through t)))
1853 "Face for strike-through text."
1854 :group 'markdown-faces)
1856 (defface markdown-markup-face
1857 '((t (:inherit shadow :slant normal :weight normal)))
1858 "Face for markup elements."
1859 :group 'markdown-faces)
1861 (defface markdown-header-rule-face
1862 '((t (:inherit markdown-markup-face)))
1863 "Base face for headers rules."
1864 :group 'markdown-faces)
1866 (defface markdown-header-delimiter-face
1867 '((t (:inherit markdown-markup-face)))
1868 "Base face for headers hash delimiter."
1869 :group 'markdown-faces)
1871 (defface markdown-list-face
1872 '((t (:inherit markdown-markup-face)))
1873 "Face for list item markers."
1874 :group 'markdown-faces)
1876 (defface markdown-blockquote-face
1877 '((t (:inherit font-lock-doc-face)))
1878 "Face for blockquote sections."
1879 :group 'markdown-faces)
1881 (defface markdown-code-face
1882 '((t (:inherit fixed-pitch)))
1883 "Face for inline code, pre blocks, and fenced code blocks.
1884 This may be used, for example, to add a contrasting background to
1885 inline code fragments and code blocks."
1886 :group 'markdown-faces)
1888 (defface markdown-inline-code-face
1889 '((t (:inherit (markdown-code-face font-lock-constant-face))))
1890 "Face for inline code."
1891 :group 'markdown-faces)
1893 (defface markdown-pre-face
1894 '((t (:inherit (markdown-code-face font-lock-constant-face))))
1895 "Face for preformatted text."
1896 :group 'markdown-faces)
1898 (defface markdown-table-face
1899 '((t (:inherit (markdown-code-face))))
1900 "Face for tables."
1901 :group 'markdown-faces)
1903 (defface markdown-language-keyword-face
1904 '((t (:inherit font-lock-type-face)))
1905 "Face for programming language identifiers."
1906 :group 'markdown-faces)
1908 (defface markdown-language-info-face
1909 '((t (:inherit font-lock-string-face)))
1910 "Face for programming language info strings."
1911 :group 'markdown-faces)
1913 (defface markdown-link-face
1914 '((t (:inherit link)))
1915 "Face for links."
1916 :group 'markdown-faces)
1918 (defface markdown-missing-link-face
1919 '((t (:inherit font-lock-warning-face)))
1920 "Face for missing links."
1921 :group 'markdown-faces)
1923 (defface markdown-reference-face
1924 '((t (:inherit markdown-markup-face)))
1925 "Face for link references."
1926 :group 'markdown-faces)
1928 (defface markdown-footnote-marker-face
1929 '((t (:inherit markdown-markup-face)))
1930 "Face for footnote markers."
1931 :group 'markdown-faces)
1933 (defface markdown-footnote-text-face
1934 '((t (:inherit font-lock-comment-face)))
1935 "Face for footnote text."
1936 :group 'markdown-faces)
1938 (defface markdown-url-face
1939 '((t (:inherit font-lock-string-face)))
1940 "Face for URLs that are part of markup.
1941 For example, this applies to URLs in inline links:
1942 [link text](http://example.com/)."
1943 :group 'markdown-faces)
1945 (defface markdown-plain-url-face
1946 '((t (:inherit markdown-link-face)))
1947 "Face for URLs that are also links.
1948 For example, this applies to plain angle bracket URLs:
1949 <http://example.com/>."
1950 :group 'markdown-faces)
1952 (defface markdown-link-title-face
1953 '((t (:inherit font-lock-comment-face)))
1954 "Face for reference link titles."
1955 :group 'markdown-faces)
1957 (defface markdown-line-break-face
1958 '((t (:inherit font-lock-constant-face :underline t)))
1959 "Face for hard line breaks."
1960 :group 'markdown-faces)
1962 (defface markdown-comment-face
1963 '((t (:inherit font-lock-comment-face)))
1964 "Face for HTML comments."
1965 :group 'markdown-faces)
1967 (defface markdown-math-face
1968 '((t (:inherit font-lock-string-face)))
1969 "Face for LaTeX expressions."
1970 :group 'markdown-faces)
1972 (defface markdown-metadata-key-face
1973 '((t (:inherit font-lock-variable-name-face)))
1974 "Face for metadata keys."
1975 :group 'markdown-faces)
1977 (defface markdown-metadata-value-face
1978 '((t (:inherit font-lock-string-face)))
1979 "Face for metadata values."
1980 :group 'markdown-faces)
1982 (defface markdown-gfm-checkbox-face
1983 '((t (:inherit font-lock-builtin-face)))
1984 "Face for GFM checkboxes."
1985 :group 'markdown-faces)
1987 (defface markdown-highlight-face
1988 '((t (:inherit highlight)))
1989 "Face for mouse highlighting."
1990 :group 'markdown-faces)
1992 (defface markdown-hr-face
1993 '((t (:inherit markdown-markup-face)))
1994 "Face for horizontal rules."
1995 :group 'markdown-faces)
1997 (defface markdown-html-tag-name-face
1998 '((t (:inherit font-lock-type-face)))
1999 "Face for HTML tag names."
2000 :group 'markdown-faces)
2002 (defface markdown-html-tag-delimiter-face
2003 '((t (:inherit markdown-markup-face)))
2004 "Face for HTML tag delimiters."
2005 :group 'markdown-faces)
2007 (defface markdown-html-attr-name-face
2008 '((t (:inherit font-lock-variable-name-face)))
2009 "Face for HTML attribute names."
2010 :group 'markdown-faces)
2012 (defface markdown-html-attr-value-face
2013 '((t (:inherit font-lock-string-face)))
2014 "Face for HTML attribute values."
2015 :group 'markdown-faces)
2017 (defface markdown-html-entity-face
2018 '((t (:inherit font-lock-variable-name-face)))
2019 "Face for HTML entities."
2020 :group 'markdown-faces)
2022 (defface markdown-highlighting-face
2023 '((t (:background "yellow" :foreground "black")))
2024 "Face for highlighting."
2025 :group 'markdown-faces)
2027 (defcustom markdown-header-scaling nil
2028 "Whether to use variable-height faces for headers.
2029 When non-nil, `markdown-header-face' will inherit from
2030 `variable-pitch' and the scaling values in
2031 `markdown-header-scaling-values' will be applied to
2032 headers of levels one through six respectively."
2033 :type 'boolean
2034 :initialize #'custom-initialize-default
2035 :set (lambda (symbol value)
2036 (set-default symbol value)
2037 (markdown-update-header-faces value))
2038 :group 'markdown-faces
2039 :package-version '(markdown-mode . "2.2"))
2041 (defcustom markdown-header-scaling-values
2042 '(2.0 1.7 1.4 1.1 1.0 1.0)
2043 "List of scaling values for headers of level one through six.
2044 Used when `markdown-header-scaling' is non-nil."
2045 :type 'list
2046 :initialize #'custom-initialize-default
2047 :set (lambda (symbol value)
2048 (set-default symbol value)
2049 (markdown-update-header-faces markdown-header-scaling value)))
2051 (defmacro markdown--dotimes-when-compile (i-n body)
2052 (declare (indent 1) (debug ((symbolp form) form)))
2053 (let ((var (car i-n))
2054 (n (cadr i-n))
2055 (code ()))
2056 (dotimes (i (eval n t))
2057 (push (eval body `((,var . ,i))) code))
2058 `(progn ,@(nreverse code))))
2060 (defface markdown-header-face
2061 `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch))
2062 font-lock-function-name-face)
2063 :weight bold)))
2064 "Base face for headers.")
2066 (markdown--dotimes-when-compile (num 6)
2067 (let* ((num1 (1+ num))
2068 (face-name (intern (format "markdown-header-face-%s" num1))))
2069 `(defface ,face-name
2070 (,'\` ((t (:inherit markdown-header-face
2071 :height
2072 (,'\, (if markdown-header-scaling
2073 (float (nth ,num markdown-header-scaling-values))
2074 1.0))))))
2075 (format "Face for level %s headers.
2076 You probably don't want to customize this face directly. Instead
2077 you can customize the base face `markdown-header-face' or the
2078 variable-height variable `markdown-header-scaling'." ,num1))))
2080 (defun markdown-update-header-faces (&optional scaling scaling-values)
2081 "Update header faces, depending on if header SCALING is desired.
2082 If so, use given list of SCALING-VALUES relative to the baseline
2083 size of `markdown-header-face'."
2084 (dotimes (num 6)
2085 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num))))
2086 (scale (cond ((not scaling) 1.0)
2087 (scaling-values (float (nth num scaling-values)))
2088 (t (float (nth num markdown-header-scaling-values))))))
2089 (unless (get face-name 'saved-face) ; Don't update customized faces
2090 (set-face-attribute face-name nil :height scale)))))
2092 (defun markdown-syntactic-face (state)
2093 "Return font-lock face for characters with given STATE.
2094 See `font-lock-syntactic-face-function' for details."
2095 (let ((in-comment (nth 4 state)))
2096 (cond
2097 (in-comment 'markdown-comment-face)
2098 (t nil))))
2100 (defcustom markdown-list-item-bullets
2101 '("●" "◎" "○" "◆" "◇" "►" "•")
2102 "List of bullets to use for unordered lists.
2103 It can contain any number of symbols, which will be repeated.
2104 Depending on your font, some reasonable choices are:
2105 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸."
2106 :group 'markdown
2107 :type '(repeat (string :tag "Bullet character"))
2108 :package-version '(markdown-mode . "2.3"))
2110 (defun markdown--footnote-marker-properties ()
2111 "Return a font-lock facespec expression for footnote marker text."
2112 `(face markdown-footnote-marker-face
2113 ,@(when markdown-hide-markup
2114 `(display ,markdown-footnote-display))))
2116 (defun markdown--pandoc-inline-footnote-properties ()
2117 "Return a font-lock facespec expression for Pandoc inline footnote text."
2118 `(face markdown-footnote-text-face
2119 ,@(when markdown-hide-markup
2120 `(display ,markdown-footnote-display))))
2122 (defvar markdown-mode-font-lock-keywords
2123 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face)))
2124 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face)))
2125 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face)
2126 (2 'markdown-markup-face)
2127 (3 'markdown-metadata-value-face)))
2128 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties)
2129 (2 markdown-markup-properties nil t)
2130 (3 markdown-language-keyword-properties nil t)
2131 (4 markdown-language-info-properties nil t)
2132 (5 markdown-markup-properties nil t)))
2133 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties)))
2134 (markdown-fontify-gfm-code-blocks)
2135 (markdown-fontify-tables)
2136 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties)
2137 (2 markdown-markup-properties nil t)
2138 (3 markdown-language-keyword-properties nil t)
2139 (4 markdown-language-info-properties nil t)
2140 (5 markdown-markup-properties nil t)))
2141 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties)))
2142 (markdown-fontify-fenced-code-blocks)
2143 (markdown-match-pre-blocks . ((0 'markdown-pre-face)))
2144 (markdown-fontify-headings)
2145 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face)
2146 (2 'markdown-markup-face)
2147 (3 'markdown-metadata-value-face)))
2148 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face)
2149 (2 'markdown-markup-face)
2150 (3 'markdown-metadata-value-face)))
2151 (markdown-fontify-hrs)
2152 (markdown-match-code . ((1 markdown-markup-properties prepend)
2153 (2 'markdown-inline-code-face prepend)
2154 (3 markdown-markup-properties prepend)))
2155 (,markdown-regex-kbd . ((1 markdown-markup-properties)
2156 (2 'markdown-inline-code-face)
2157 (3 markdown-markup-properties)))
2158 (markdown-fontify-angle-uris)
2159 (,markdown-regex-email . 'markdown-plain-url-face)
2160 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t)
2161 (2 'markdown-html-tag-name-face t)
2162 (3 'markdown-html-tag-delimiter-face t)
2163 ;; Anchored matcher for HTML tag attributes
2164 (,markdown-regex-html-attr
2165 ;; Before searching, move past tag
2166 ;; name; set limit at tag close.
2167 (progn
2168 (goto-char (match-end 2)) (match-end 3))
2170 . ((1 'markdown-html-attr-name-face)
2171 (3 'markdown-html-tag-delimiter-face nil t)
2172 (4 'markdown-html-attr-value-face nil t)))))
2173 (,markdown-regex-html-entity . 'markdown-html-entity-face)
2174 (markdown-fontify-list-items)
2175 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^
2176 (2 (markdown--footnote-marker-properties)) ; label
2177 (3 markdown-markup-properties))) ; ]
2178 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^
2179 (2 markdown-markup-properties) ; [
2180 (3 (markdown--pandoc-inline-footnote-properties)) ; text
2181 (4 markdown-markup-properties))) ; ]
2182 (markdown-match-includes . ((1 markdown-markup-properties)
2183 (2 markdown-markup-properties nil t)
2184 (3 markdown-include-title-properties nil t)
2185 (4 markdown-markup-properties nil t)
2186 (5 markdown-markup-properties)
2187 (6 'markdown-url-face)
2188 (7 markdown-markup-properties)))
2189 (markdown-fontify-inline-links)
2190 (markdown-fontify-reference-links)
2191 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [
2192 (2 'markdown-reference-face) ; label
2193 (3 'markdown-markup-face) ; ]
2194 (4 'markdown-markup-face) ; :
2195 (5 'markdown-url-face) ; url
2196 (6 'markdown-link-title-face))) ; "title" (optional)
2197 (markdown-fontify-plain-uris)
2198 ;; Math mode $..$
2199 (markdown-match-math-single . ((1 'markdown-markup-face prepend)
2200 (2 'markdown-math-face append)
2201 (3 'markdown-markup-face prepend)))
2202 ;; Math mode $$..$$
2203 (markdown-match-math-double . ((1 'markdown-markup-face prepend)
2204 (2 'markdown-math-face append)
2205 (3 'markdown-markup-face prepend)))
2206 ;; Math mode \[..\] and \\[..\\]
2207 (markdown-match-math-display . ((1 'markdown-markup-face prepend)
2208 (3 'markdown-math-face append)
2209 (4 'markdown-markup-face prepend)))
2210 (markdown-match-bold . ((1 markdown-markup-properties prepend)
2211 (2 'markdown-bold-face append)
2212 (3 markdown-markup-properties prepend)))
2213 (markdown-match-italic . ((1 markdown-markup-properties prepend)
2214 (2 'markdown-italic-face append)
2215 (3 markdown-markup-properties prepend)))
2216 (,markdown-regex-strike-through . ((3 markdown-markup-properties)
2217 (4 'markdown-strike-through-face)
2218 (5 markdown-markup-properties)))
2219 (markdown--match-highlighting . ((3 markdown-markup-properties)
2220 (4 'markdown-highlighting-face)
2221 (5 markdown-markup-properties)))
2222 (,markdown-regex-line-break . (1 'markdown-line-break-face prepend))
2223 (,markdown-regex-escape . ((1 markdown-markup-properties prepend)))
2224 (markdown-fontify-sub-superscripts)
2225 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend)))
2226 (markdown-match-leanpub-sections . ((0 markdown-markup-properties)))
2227 (markdown-fontify-blockquotes)
2228 (markdown-match-wiki-link . ((0 'markdown-link-face prepend))))
2229 "Syntax highlighting for Markdown files.")
2231 ;; Footnotes
2232 (defvar-local markdown-footnote-counter 0
2233 "Counter for footnote numbers.")
2235 (defconst markdown-footnote-chars
2236 "[[:alnum:]-]"
2237 "Regular expression matching any character for a footnote identifier.")
2239 (defconst markdown-regex-footnote-definition
2240 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)")
2241 "Regular expression matching a footnote definition, capturing the label.")
2244 ;;; Compatibility =============================================================
2246 (defun markdown--pandoc-reference-p ()
2247 (let ((bounds (bounds-of-thing-at-point 'word)))
2248 (when (and bounds (char-before (car bounds)))
2249 (= (char-before (car bounds)) ?@))))
2251 (defun markdown-flyspell-check-word-p ()
2252 "Return t if `flyspell' should check word just before point.
2253 Used for `flyspell-generic-check-word-predicate'."
2254 (save-excursion
2255 (goto-char (1- (point)))
2256 ;; https://github.com/jrblevin/markdown-mode/issues/560
2257 ;; enable spell check YAML meta data
2258 (if (or (and (markdown-code-block-at-point-p)
2259 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section)))
2260 (markdown-inline-code-at-point-p)
2261 (markdown-in-comment-p)
2262 (markdown--face-p (point) '(markdown-reference-face
2263 markdown-markup-face
2264 markdown-plain-url-face
2265 markdown-inline-code-face
2266 markdown-url-face))
2267 (markdown--pandoc-reference-p))
2268 (prog1 nil
2269 ;; If flyspell overlay is put, then remove it
2270 (let ((bounds (bounds-of-thing-at-point 'word)))
2271 (when bounds
2272 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds))
2273 when (overlay-get ov 'flyspell-overlay)
2275 (delete-overlay ov)))))
2276 t)))
2279 ;;; Markdown Parsing Functions ================================================
2281 (defun markdown-cur-line-blank-p ()
2282 "Return t if the current line is blank and nil otherwise."
2283 (save-excursion
2284 (beginning-of-line)
2285 (looking-at-p markdown-regex-blank-line)))
2287 (defun markdown-prev-line-blank ()
2288 "Return t if the previous line is blank and nil otherwise.
2289 If we are at the first line, then consider the previous line to be blank."
2290 (or (= (line-beginning-position) (point-min))
2291 (save-excursion
2292 (forward-line -1)
2293 (looking-at markdown-regex-blank-line))))
2295 (defun markdown-prev-line-blank-p ()
2296 "Like `markdown-prev-line-blank', but preserve `match-data'."
2297 (save-match-data (markdown-prev-line-blank)))
2299 (defun markdown-next-line-blank-p ()
2300 "Return t if the next line is blank and nil otherwise.
2301 If we are at the last line, then consider the next line to be blank."
2302 (or (= (line-end-position) (point-max))
2303 (save-excursion
2304 (forward-line 1)
2305 (markdown-cur-line-blank-p))))
2307 (defun markdown-prev-line-indent ()
2308 "Return the number of leading whitespace characters in the previous line.
2309 Return 0 if the current line is the first line in the buffer."
2310 (save-excursion
2311 (if (= (line-beginning-position) (point-min))
2313 (forward-line -1)
2314 (current-indentation))))
2316 (defun markdown-next-line-indent ()
2317 "Return the number of leading whitespace characters in the next line.
2318 Return 0 if line is the last line in the buffer."
2319 (save-excursion
2320 (if (= (line-end-position) (point-max))
2322 (forward-line 1)
2323 (current-indentation))))
2325 (defun markdown-new-baseline ()
2326 "Determine if the current line begins a new baseline level.
2327 Assume point is positioned at beginning of line."
2328 (or (looking-at markdown-regex-header)
2329 (looking-at markdown-regex-hr)
2330 (and (= (current-indentation) 0)
2331 (not (looking-at markdown-regex-list))
2332 (markdown-prev-line-blank))))
2334 (defun markdown-search-backward-baseline ()
2335 "Search backward baseline point with no indentation and not a list item."
2336 (end-of-line)
2337 (let (stop)
2338 (while (not (or stop (bobp)))
2339 (re-search-backward markdown-regex-block-separator-noindent nil t)
2340 (when (match-end 2)
2341 (goto-char (match-end 2))
2342 (cond
2343 ((markdown-new-baseline)
2344 (setq stop t))
2345 ((looking-at-p markdown-regex-list)
2346 (setq stop nil))
2347 (t (setq stop t)))))))
2349 (defun markdown-update-list-levels (marker indent levels)
2350 "Update list levels given list MARKER, block INDENT, and current LEVELS.
2351 Here, MARKER is a string representing the type of list, INDENT is an integer
2352 giving the indentation, in spaces, of the current block, and LEVELS is a
2353 list of the indentation levels of parent list items. When LEVELS is nil,
2354 it means we are at baseline (not inside of a nested list)."
2355 (cond
2356 ;; New list item at baseline.
2357 ((and marker (null levels))
2358 (setq levels (list indent)))
2359 ;; List item with greater indentation (four or more spaces).
2360 ;; Increase list level.
2361 ((and marker (>= indent (+ (car levels) markdown-list-indent-width)))
2362 (setq levels (cons indent levels)))
2363 ;; List item with greater or equal indentation (less than four spaces).
2364 ;; Do not increase list level.
2365 ((and marker (>= indent (car levels)))
2366 levels)
2367 ;; Lesser indentation level.
2368 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
2369 ;; indentation could move back more than one list level). Note
2370 ;; that this block need not be the beginning of list item.
2371 ((< indent (car levels))
2372 (while (and (> (length levels) 1)
2373 (< indent (+ (cadr levels) markdown-list-indent-width)))
2374 (setq levels (cdr levels)))
2375 levels)
2376 ;; Otherwise, do nothing.
2377 (t levels)))
2379 (defun markdown-calculate-list-levels ()
2380 "Calculate list levels at point.
2381 Return a list of the form (n1 n2 n3 ...) where n1 is the
2382 indentation of the deepest nested list item in the branch of
2383 the list at the point, n2 is the indentation of the parent
2384 list item, and so on. The depth of the list item is therefore
2385 the length of the returned list. If the point is not at or
2386 immediately after a list item, return nil."
2387 (save-excursion
2388 (let ((first (point)) levels indent pre-regexp)
2389 ;; Find a baseline point with zero list indentation
2390 (markdown-search-backward-baseline)
2391 ;; Search for all list items between baseline and LOC
2392 (while (and (< (point) first)
2393 (re-search-forward markdown-regex-list first t))
2394 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels))))
2395 (beginning-of-line)
2396 (cond
2397 ;; Make sure this is not a header or hr
2398 ((markdown-new-baseline) (setq levels nil))
2399 ;; Make sure this is not a line from a pre block
2400 ((looking-at-p pre-regexp))
2401 ;; If not, then update levels
2403 (setq indent (current-indentation))
2404 (setq levels (markdown-update-list-levels (match-string 2)
2405 indent levels))))
2406 (end-of-line))
2407 levels)))
2409 (defun markdown-prev-list-item (level)
2410 "Search backward from point for a list item with indentation LEVEL.
2411 Set point to the beginning of the item, and return point, or nil
2412 upon failure."
2413 (let (bounds indent prev)
2414 (setq prev (point))
2415 (forward-line -1)
2416 (setq indent (current-indentation))
2417 (while
2418 (cond
2419 ;; List item
2420 ((and (looking-at-p markdown-regex-list)
2421 (setq bounds (markdown-cur-list-item-bounds)))
2422 (cond
2423 ;; Stop and return point at item of equal indentation
2424 ((= (nth 3 bounds) level)
2425 (setq prev (point))
2426 nil)
2427 ;; Stop and return nil at item with lesser indentation
2428 ((< (nth 3 bounds) level)
2429 (setq prev nil)
2430 nil)
2431 ;; Stop at beginning of buffer
2432 ((bobp) (setq prev nil))
2433 ;; Continue at item with greater indentation
2434 ((> (nth 3 bounds) level) t)))
2435 ;; Stop at beginning of buffer
2436 ((bobp) (setq prev nil))
2437 ;; Continue if current line is blank
2438 ((markdown-cur-line-blank-p) t)
2439 ;; Continue while indentation is the same or greater
2440 ((>= indent level) t)
2441 ;; Stop if current indentation is less than list item
2442 ;; and the next is blank
2443 ((and (< indent level)
2444 (markdown-next-line-blank-p))
2445 (setq prev nil))
2446 ;; Stop at a header
2447 ((looking-at-p markdown-regex-header) (setq prev nil))
2448 ;; Stop at a horizontal rule
2449 ((looking-at-p markdown-regex-hr) (setq prev nil))
2450 ;; Otherwise, continue.
2451 (t t))
2452 (forward-line -1)
2453 (setq indent (current-indentation)))
2454 prev))
2456 (defun markdown-next-list-item (level)
2457 "Search forward from point for the next list item with indentation LEVEL.
2458 Set point to the beginning of the item, and return point, or nil
2459 upon failure."
2460 (let (bounds indent next)
2461 (setq next (point))
2462 (if (looking-at markdown-regex-header-setext)
2463 (goto-char (match-end 0)))
2464 (forward-line)
2465 (setq indent (current-indentation))
2466 (while
2467 (cond
2468 ;; Stop at end of the buffer.
2469 ((eobp) nil)
2470 ;; Continue if the current line is blank
2471 ((markdown-cur-line-blank-p) t)
2472 ;; List item
2473 ((and (looking-at-p markdown-regex-list)
2474 (setq bounds (markdown-cur-list-item-bounds)))
2475 (cond
2476 ;; Continue at item with greater indentation
2477 ((> (nth 3 bounds) level) t)
2478 ;; Stop and return point at item of equal indentation
2479 ((= (nth 3 bounds) level)
2480 (setq next (point))
2481 nil)
2482 ;; Stop and return nil at item with lesser indentation
2483 ((< (nth 3 bounds) level)
2484 (setq next nil)
2485 nil)))
2486 ;; Continue while indentation is the same or greater
2487 ((>= indent level) t)
2488 ;; Stop if current indentation is less than list item
2489 ;; and the previous line was blank.
2490 ((and (< indent level)
2491 (markdown-prev-line-blank-p))
2492 (setq next nil))
2493 ;; Stop at a header
2494 ((looking-at-p markdown-regex-header) (setq next nil))
2495 ;; Stop at a horizontal rule
2496 ((looking-at-p markdown-regex-hr) (setq next nil))
2497 ;; Otherwise, continue.
2498 (t t))
2499 (forward-line)
2500 (setq indent (current-indentation)))
2501 next))
2503 (defun markdown-cur-list-item-end (level)
2504 "Move to end of list item with pre-marker indentation LEVEL.
2505 Return the point at the end when a list item was found at the
2506 original point. If the point is not in a list item, do nothing."
2507 (let (indent)
2508 (forward-line)
2509 (setq indent (current-indentation))
2510 (while
2511 (cond
2512 ;; Stop at end of the buffer.
2513 ((eobp) nil)
2514 ;; Continue while indentation is the same or greater
2515 ((>= indent level) t)
2516 ;; Continue if the current line is blank
2517 ((looking-at markdown-regex-blank-line) t)
2518 ;; Stop if current indentation is less than list item
2519 ;; and the previous line was blank.
2520 ((and (< indent level)
2521 (markdown-prev-line-blank))
2522 nil)
2523 ;; Stop at a new list items of the same or lesser
2524 ;; indentation, headings, and horizontal rules.
2525 ((looking-at (concat "\\(?:" markdown-regex-list
2526 "\\|" markdown-regex-header
2527 "\\|" markdown-regex-hr "\\)"))
2528 nil)
2529 ;; Otherwise, continue.
2530 (t t))
2531 (forward-line)
2532 (setq indent (current-indentation)))
2533 ;; Don't skip over whitespace for empty list items (marker and
2534 ;; whitespace only), just move to end of whitespace.
2535 (if (save-excursion
2536 (beginning-of-line)
2537 (looking-at (concat markdown-regex-list "[ \t]*$")))
2538 (goto-char (match-end 3))
2539 (skip-chars-backward " \t\n"))
2540 (end-of-line)
2541 (point)))
2543 (defun markdown-cur-list-item-bounds ()
2544 "Return bounds for list item at point.
2545 Return a list of the following form:
2547 (begin end indent nonlist-indent marker checkbox match)
2549 The named components are:
2551 - begin: Position of beginning of list item, including leading indentation.
2552 - end: Position of the end of the list item, including list item text.
2553 - indent: Number of characters of indentation before list marker (an integer).
2554 - nonlist-indent: Number characters of indentation, list
2555 marker, and whitespace following list marker (an integer).
2556 - marker: String containing the list marker and following whitespace
2557 (e.g., \"- \" or \"* \").
2558 - checkbox: String containing the GFM checkbox portion, if any,
2559 including any trailing whitespace before the text
2560 begins (e.g., \"[x] \").
2561 - match: match data for markdown-regex-list
2563 As an example, for the following unordered list item
2565 - item
2567 the returned list would be
2569 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
2571 If the point is not inside a list item, return nil."
2572 (car (get-text-property (line-beginning-position) 'markdown-list-item)))
2574 (defun markdown-list-item-at-point-p ()
2575 "Return t if there is a list item at the point and nil otherwise."
2576 (save-match-data (markdown-cur-list-item-bounds)))
2578 (defun markdown-prev-list-item-bounds ()
2579 "Return bounds of previous item in the same list of any level.
2580 The return value has the same form as that of
2581 `markdown-cur-list-item-bounds'."
2582 (save-excursion
2583 (let ((cur-bounds (markdown-cur-list-item-bounds))
2584 (beginning-of-list (save-excursion (markdown-beginning-of-list)))
2585 stop)
2586 (when cur-bounds
2587 (goto-char (nth 0 cur-bounds))
2588 (while (and (not stop) (not (bobp))
2589 (re-search-backward markdown-regex-list
2590 beginning-of-list t))
2591 (unless (or (looking-at markdown-regex-hr)
2592 (markdown-code-block-at-point-p))
2593 (setq stop (point))))
2594 (markdown-cur-list-item-bounds)))))
2596 (defun markdown-next-list-item-bounds ()
2597 "Return bounds of next item in the same list of any level.
2598 The return value has the same form as that of
2599 `markdown-cur-list-item-bounds'."
2600 (save-excursion
2601 (let ((cur-bounds (markdown-cur-list-item-bounds))
2602 (end-of-list (save-excursion (markdown-end-of-list)))
2603 stop)
2604 (when cur-bounds
2605 (goto-char (nth 0 cur-bounds))
2606 (end-of-line)
2607 (while (and (not stop) (not (eobp))
2608 (re-search-forward markdown-regex-list
2609 end-of-list t))
2610 (unless (or (looking-at markdown-regex-hr)
2611 (markdown-code-block-at-point-p))
2612 (setq stop (point))))
2613 (when stop
2614 (markdown-cur-list-item-bounds))))))
2616 (defun markdown-beginning-of-list ()
2617 "Move point to beginning of list at point, if any."
2618 (interactive)
2619 (let ((orig-point (point))
2620 (list-begin (save-excursion
2621 (markdown-search-backward-baseline)
2622 ;; Stop at next list item, regardless of the indentation.
2623 (markdown-next-list-item (point-max))
2624 (when (looking-at markdown-regex-list)
2625 (point)))))
2626 (when (and list-begin (<= list-begin orig-point))
2627 (goto-char list-begin))))
2629 (defun markdown-end-of-list ()
2630 "Move point to end of list at point, if any."
2631 (interactive)
2632 (let ((start (point))
2633 (end (save-excursion
2634 (when (markdown-beginning-of-list)
2635 ;; Items can't have nonlist-indent <= 1, so this
2636 ;; moves past all list items.
2637 (markdown-next-list-item 1)
2638 (skip-syntax-backward "-")
2639 (unless (eobp) (forward-char 1))
2640 (point)))))
2641 (when (and end (>= end start))
2642 (goto-char end))))
2644 (defun markdown-up-list ()
2645 "Move point to beginning of parent list item."
2646 (interactive)
2647 (let ((cur-bounds (markdown-cur-list-item-bounds)))
2648 (when cur-bounds
2649 (markdown-prev-list-item (1- (nth 3 cur-bounds)))
2650 (let ((up-bounds (markdown-cur-list-item-bounds)))
2651 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds)))
2652 (point))))))
2654 (defun markdown-bounds-of-thing-at-point (thing)
2655 "Call `bounds-of-thing-at-point' for THING with slight modifications.
2656 Does not include trailing newlines when THING is \\='line. Handles the
2657 end of buffer case by setting both endpoints equal to the value of
2658 `point-max', since an empty region will trigger empty markup insertion.
2659 Return bounds of form (beg . end) if THING is found, or nil otherwise."
2660 (let* ((bounds (bounds-of-thing-at-point thing))
2661 (a (car bounds))
2662 (b (cdr bounds)))
2663 (when bounds
2664 (when (eq thing 'line)
2665 (cond ((and (eobp) (markdown-cur-line-blank-p))
2666 (setq a b))
2667 ((char-equal (char-before b) ?\^J)
2668 (setq b (1- b)))))
2669 (cons a b))))
2671 (defun markdown-reference-definition (reference)
2672 "Find out whether Markdown REFERENCE is defined.
2673 REFERENCE should not include the square brackets.
2674 When REFERENCE is defined, return a list of the form (text start end)
2675 containing the definition text itself followed by the start and end
2676 locations of the text. Otherwise, return nil.
2677 Leave match data for `markdown-regex-reference-definition'
2678 intact additional processing."
2679 (let ((reference (downcase reference)))
2680 (save-excursion
2681 (goto-char (point-min))
2682 (catch 'found
2683 (while (re-search-forward markdown-regex-reference-definition nil t)
2684 (when (string= reference (downcase (match-string-no-properties 2)))
2685 (throw 'found
2686 (list (match-string-no-properties 5)
2687 (match-beginning 5) (match-end 5)))))))))
2689 (defun markdown-get-defined-references ()
2690 "Return all defined reference labels and their line numbers.
2691 They does not include square brackets)."
2692 (save-excursion
2693 (goto-char (point-min))
2694 (let (refs)
2695 (while (re-search-forward markdown-regex-reference-definition nil t)
2696 (let ((target (match-string-no-properties 2)))
2697 (cl-pushnew
2698 (cons (downcase target)
2699 (markdown-line-number-at-pos (match-beginning 2)))
2700 refs :test #'equal :key #'car)))
2701 (reverse refs))))
2703 (defun markdown-get-used-uris ()
2704 "Return a list of all used URIs in the buffer."
2705 (save-excursion
2706 (goto-char (point-min))
2707 (let (uris)
2708 (while (re-search-forward
2709 (concat "\\(?:" markdown-regex-link-inline
2710 "\\|" markdown-regex-angle-uri
2711 "\\|" markdown-regex-uri
2712 "\\|" markdown-regex-email
2713 "\\)")
2714 nil t)
2715 (unless (or (markdown-inline-code-at-point-p)
2716 (markdown-code-block-at-point-p))
2717 (cl-pushnew (or (match-string-no-properties 6)
2718 (match-string-no-properties 10)
2719 (match-string-no-properties 12)
2720 (match-string-no-properties 13))
2721 uris :test #'equal)))
2722 (reverse uris))))
2724 (defun markdown-inline-code-at-pos (pos)
2725 "Return non-nil if there is an inline code fragment at POS.
2726 Return nil otherwise. Set match data according to
2727 `markdown-match-code' upon success.
2728 This function searches the block for a code fragment that
2729 contains the point using `markdown-match-code'. We do this
2730 because `thing-at-point-looking-at' does not work reliably with
2731 `markdown-regex-code'.
2733 The match data is set as follows:
2734 Group 1 matches the opening backquotes.
2735 Group 2 matches the code fragment itself, without backquotes.
2736 Group 3 matches the closing backquotes."
2737 (save-excursion
2738 (goto-char pos)
2739 (let ((old-point (point))
2740 (end-of-block (progn (markdown-end-of-text-block) (point)))
2741 found)
2742 (markdown-beginning-of-text-block)
2743 (while (and (markdown-match-code end-of-block)
2744 (setq found t)
2745 (< (match-end 0) old-point)))
2746 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1)))
2747 (and found ; matched something
2748 (<= (match-beginning match-group) old-point) ; match contains old-point
2749 (> (match-end 0) old-point))))))
2751 (defun markdown-inline-code-at-pos-p (pos)
2752 "Return non-nil if there is an inline code fragment at POS.
2753 Like `markdown-inline-code-at-pos`, but preserves match data."
2754 (save-match-data (markdown-inline-code-at-pos pos)))
2756 (defun markdown-inline-code-at-point ()
2757 "Return non-nil if the point is at an inline code fragment.
2758 See `markdown-inline-code-at-pos' for details."
2759 (markdown-inline-code-at-pos (point)))
2761 (defun markdown-inline-code-at-point-p (&optional pos)
2762 "Return non-nil if there is inline code at the POS.
2763 This is a predicate function counterpart to
2764 `markdown-inline-code-at-point' which does not modify the match
2765 data. See `markdown-code-block-at-point-p' for code blocks."
2766 (save-match-data (markdown-inline-code-at-pos (or pos (point)))))
2768 (defun markdown-code-block-at-pos (pos)
2769 "Return match data list if there is a code block at POS.
2770 Uses text properties at the beginning of the line position.
2771 This includes pre blocks, tilde-fenced code blocks, and GFM
2772 quoted code blocks. Return nil otherwise."
2773 (let ((bol (save-excursion (goto-char pos) (line-beginning-position))))
2774 (or (get-text-property bol 'markdown-pre)
2775 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos))
2776 (second (cl-second bounds)))
2777 (if second
2778 ;; chunks are right open
2779 (when (< pos second)
2780 bounds)
2781 bounds)))))
2783 ;; Function was renamed to emphasize that it does not modify match-data.
2784 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p)
2786 (defun markdown-code-block-at-point-p (&optional pos)
2787 "Return non-nil if there is a code block at the POS.
2788 This includes pre blocks, tilde-fenced code blocks, and GFM
2789 quoted code blocks. This function does not modify the match
2790 data. See `markdown-inline-code-at-point-p' for inline code."
2791 (save-match-data (markdown-code-block-at-pos (or pos (point)))))
2793 (defun markdown-heading-at-point (&optional pos)
2794 "Return non-nil if there is a heading at the POS.
2795 Set match data for `markdown-regex-header'."
2796 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading)))
2797 (when match-data
2798 (set-match-data match-data)
2799 t)))
2801 (defun markdown-pipe-at-bol-p ()
2802 "Return non-nil if the line begins with a pipe symbol.
2803 This may be useful for tables and Pandoc's line_blocks extension."
2804 (char-equal (char-after (line-beginning-position)) ?|))
2807 ;;; Markdown Font Lock Matching Functions =====================================
2809 (defun markdown-range-property-any (begin end prop prop-values)
2810 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
2811 Also returns t if PROP is a list containing one of the PROP-VALUES.
2812 Return nil otherwise."
2813 (let (props)
2814 (catch 'found
2815 (dolist (loc (number-sequence begin end))
2816 (when (setq props (get-text-property loc prop))
2817 (cond ((listp props)
2818 ;; props is a list, check for membership
2819 (dolist (val prop-values)
2820 (when (memq val props) (throw 'found loc))))
2822 ;; props is a scalar, check for equality
2823 (dolist (val prop-values)
2824 (when (eq val props) (throw 'found loc))))))))))
2826 (defun markdown-range-properties-exist (begin end props)
2827 (cl-loop
2828 for loc in (number-sequence begin end)
2829 with result = nil
2830 while (not
2831 (setq result
2832 (cl-some (lambda (prop) (get-text-property loc prop)) props)))
2833 finally return result))
2835 (defun markdown-match-inline-generic (regex last &optional faceless)
2836 "Match inline REGEX from the point to LAST.
2837 When FACELESS is non-nil, do not return matches where faces have been applied."
2838 (when (re-search-forward regex last t)
2839 (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
2840 (face (and faceless (text-property-not-all
2841 (match-beginning 0) (match-end 0) 'face nil))))
2842 (cond
2843 ;; In code block: move past it and recursively search again
2844 (bounds
2845 (when (< (goto-char (cl-second bounds)) last)
2846 (markdown-match-inline-generic regex last faceless)))
2847 ;; When faces are found in the match range, skip over the match and
2848 ;; recursively search again.
2849 (face
2850 (when (< (goto-char (match-end 0)) last)
2851 (markdown-match-inline-generic regex last faceless)))
2852 ;; Keep match data and return t when in bounds.
2854 (<= (match-end 0) last))))))
2856 (defun markdown-match-code (last)
2857 "Match inline code fragments from point to LAST."
2858 (unless (bobp)
2859 (backward-char 1))
2860 (when (markdown-search-until-condition
2861 (lambda ()
2862 (and
2863 ;; Advance point in case of failure, but without exceeding last.
2864 (goto-char (min (1+ (match-beginning 1)) last))
2865 (not (markdown-in-comment-p (match-beginning 1)))
2866 (not (markdown-in-comment-p (match-end 1)))
2867 (not (markdown-code-block-at-pos (match-beginning 1)))))
2868 markdown-regex-code last t)
2869 (set-match-data (list (match-beginning 1) (match-end 1)
2870 (match-beginning 2) (match-end 2)
2871 (match-beginning 3) (match-end 3)
2872 (match-beginning 4) (match-end 4)))
2873 (goto-char (min (1+ (match-end 0)) last (point-max)))
2876 (defun markdown--gfm-markup-underscore-p (begin end)
2877 (let ((is-underscore (eql (char-after begin) ?_)))
2878 (if (not is-underscore)
2880 (save-excursion
2881 (save-match-data
2882 (goto-char begin)
2883 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin))
2884 (progn
2885 (goto-char end)
2886 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)"))))))))
2888 (defun markdown-match-bold (last)
2889 "Match inline bold from the point to LAST."
2890 (when (markdown-match-inline-generic markdown-regex-bold last)
2891 (let ((is-gfm (derived-mode-p 'gfm-mode))
2892 (begin (match-beginning 2))
2893 (end (match-end 2)))
2894 (if (or (markdown-inline-code-at-pos-p begin)
2895 (markdown-inline-code-at-pos-p end)
2896 (markdown-in-comment-p)
2897 (markdown-range-property-any
2898 begin begin 'face '(markdown-url-face
2899 markdown-plain-url-face))
2900 (markdown-range-property-any
2901 begin end 'face '(markdown-hr-face
2902 markdown-math-face))
2903 (and is-gfm (not (markdown--gfm-markup-underscore-p begin end))))
2904 (progn (goto-char (min (1+ begin) last))
2905 (when (< (point) last)
2906 (markdown-match-bold last)))
2907 (set-match-data (list (match-beginning 2) (match-end 2)
2908 (match-beginning 3) (match-end 3)
2909 (match-beginning 4) (match-end 4)
2910 (match-beginning 5) (match-end 5)))
2911 t))))
2913 (defun markdown-match-italic (last)
2914 "Match inline italics from the point to LAST."
2915 (let* ((is-gfm (derived-mode-p 'gfm-mode))
2916 (regex (if is-gfm
2917 markdown-regex-gfm-italic
2918 markdown-regex-italic)))
2919 (when (and (markdown-match-inline-generic regex last)
2920 (not (markdown--face-p
2921 (match-beginning 1)
2922 '(markdown-html-attr-name-face markdown-html-attr-value-face))))
2923 (let ((begin (match-beginning 1))
2924 (end (match-end 1))
2925 (close-end (match-end 4)))
2926 (if (or (eql (char-before begin) (char-after begin))
2927 (markdown-inline-code-at-pos-p begin)
2928 (markdown-inline-code-at-pos-p (1- end))
2929 (markdown-in-comment-p)
2930 (markdown-range-property-any
2931 begin begin 'face '(markdown-url-face
2932 markdown-plain-url-face
2933 markdown-markup-face))
2934 (markdown-range-property-any
2935 begin end 'face '(markdown-bold-face
2936 markdown-list-face
2937 markdown-hr-face
2938 markdown-math-face))
2939 (and is-gfm
2940 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case
2941 (not (markdown--gfm-markup-underscore-p begin close-end)))))
2942 (progn (goto-char (min (1+ begin) last))
2943 (when (< (point) last)
2944 (markdown-match-italic last)))
2945 (set-match-data (list (match-beginning 1) (match-end 1)
2946 (match-beginning 2) (match-end 2)
2947 (match-beginning 3) (match-end 3)
2948 (match-beginning 4) (match-end 4)))
2949 t)))))
2951 (defun markdown--match-highlighting (last)
2952 (when markdown-enable-highlighting-syntax
2953 (re-search-forward markdown-regex-highlighting last t)))
2955 (defun markdown-match-math-generic (regex last)
2956 "Match REGEX from point to LAST.
2957 REGEX is either `markdown-regex-math-inline-single' for matching
2958 $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
2959 (when (markdown-match-inline-generic regex last)
2960 (let ((begin (match-beginning 1)) (end (match-end 1)))
2961 (prog1
2962 (if (or (markdown-range-property-any
2963 begin end 'face
2964 '(markdown-inline-code-face markdown-bold-face))
2965 (markdown-range-properties-exist
2966 begin end
2967 (markdown-get-fenced-block-middle-properties)))
2968 (markdown-match-math-generic regex last)
2970 (goto-char (1+ (match-end 0)))))))
2972 (defun markdown-match-list-items (last)
2973 "Match list items from point to LAST."
2974 (let* ((first (point))
2975 (pos first)
2976 (prop 'markdown-list-item)
2977 (bounds (car (get-text-property pos prop))))
2978 (while
2979 (and (or (null (setq bounds (car (get-text-property pos prop))))
2980 (< (cl-first bounds) pos))
2981 (< (point) last)
2982 (setq pos (next-single-property-change pos prop nil last))
2983 (goto-char pos)))
2984 (when bounds
2985 (set-match-data (cl-seventh bounds))
2986 ;; Step at least one character beyond point. Otherwise
2987 ;; `font-lock-fontify-keywords-region' infloops.
2988 (goto-char (min (1+ (max (line-end-position) first))
2989 (point-max)))
2990 t)))
2992 (defun markdown-match-math-single (last)
2993 "Match single quoted $..$ math from point to LAST."
2994 (when markdown-enable-math
2995 (when (and (char-equal (char-after) ?$)
2996 (not (bolp))
2997 (not (char-equal (char-before) ?\\))
2998 (not (char-equal (char-before) ?$)))
2999 (forward-char -1))
3000 (markdown-match-math-generic markdown-regex-math-inline-single last)))
3002 (defun markdown-match-math-double (last)
3003 "Match double quoted $$..$$ math from point to LAST."
3004 (when markdown-enable-math
3005 (when (and (< (1+ (point)) (point-max))
3006 (char-equal (char-after) ?$)
3007 (char-equal (char-after (1+ (point))) ?$)
3008 (not (bolp))
3009 (not (char-equal (char-before) ?\\))
3010 (not (char-equal (char-before) ?$)))
3011 (forward-char -1))
3012 (markdown-match-math-generic markdown-regex-math-inline-double last)))
3014 (defun markdown-match-math-display (last)
3015 "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
3016 (when markdown-enable-math
3017 (markdown-match-math-generic markdown-regex-math-display last)))
3019 (defun markdown-match-propertized-text (property last)
3020 "Match text with PROPERTY from point to LAST.
3021 Restore match data previously stored in PROPERTY."
3022 (let ((saved (get-text-property (point) property))
3023 pos)
3024 (unless saved
3025 (setq pos (next-single-property-change (point) property nil last))
3026 (unless (= pos last)
3027 (setq saved (get-text-property pos property))))
3028 (when saved
3029 (set-match-data saved)
3030 ;; Step at least one character beyond point. Otherwise
3031 ;; `font-lock-fontify-keywords-region' infloops.
3032 (goto-char (min (1+ (max (match-end 0) (point)))
3033 (point-max)))
3034 saved)))
3036 (defun markdown-match-pre-blocks (last)
3037 "Match preformatted blocks from point to LAST.
3038 Use data stored in \\='markdown-pre text property during syntax
3039 analysis."
3040 (markdown-match-propertized-text 'markdown-pre last))
3042 (defun markdown-match-gfm-code-blocks (last)
3043 "Match GFM quoted code blocks from point to LAST.
3044 Use data stored in \\='markdown-gfm-code text property during syntax
3045 analysis."
3046 (markdown-match-propertized-text 'markdown-gfm-code last))
3048 (defun markdown-match-gfm-open-code-blocks (last)
3049 (markdown-match-propertized-text 'markdown-gfm-block-begin last))
3051 (defun markdown-match-gfm-close-code-blocks (last)
3052 (markdown-match-propertized-text 'markdown-gfm-block-end last))
3054 (defun markdown-match-fenced-code-blocks (last)
3055 "Match fenced code blocks from the point to LAST."
3056 (markdown-match-propertized-text 'markdown-fenced-code last))
3058 (defun markdown-match-fenced-start-code-block (last)
3059 (markdown-match-propertized-text 'markdown-tilde-fence-begin last))
3061 (defun markdown-match-fenced-end-code-block (last)
3062 (markdown-match-propertized-text 'markdown-tilde-fence-end last))
3064 (defun markdown-match-blockquotes (last)
3065 "Match blockquotes from point to LAST.
3066 Use data stored in \\='markdown-blockquote text property during syntax
3067 analysis."
3068 (markdown-match-propertized-text 'markdown-blockquote last))
3070 (defun markdown-match-hr (last)
3071 "Match horizontal rules comments from the point to LAST."
3072 (markdown-match-propertized-text 'markdown-hr last))
3074 (defun markdown-match-comments (last)
3075 "Match HTML comments from the point to LAST."
3076 (when (and (skip-syntax-forward "^<" last))
3077 (let ((beg (point)))
3078 (when (and (skip-syntax-forward "^>" last) (< (point) last))
3079 (forward-char)
3080 (set-match-data (list beg (point)))
3081 t))))
3083 (defun markdown-match-generic-links (last ref)
3084 "Match inline links from point to LAST.
3085 When REF is non-nil, match reference links instead of standard
3086 links with URLs.
3087 This function should only be used during font-lock, as it
3088 determines syntax based on the presence of faces for previously
3089 processed elements."
3090 ;; Search for the next potential link (not in a code block).
3091 (let ((prohibited-faces '(markdown-pre-face
3092 markdown-code-face
3093 markdown-inline-code-face
3094 markdown-comment-face))
3095 found)
3096 (while
3097 (and (not found) (< (point) last)
3098 (progn
3099 ;; Clear match data to test for a match after functions returns.
3100 (set-match-data nil)
3101 ;; Preliminary regular expression search so we can return
3102 ;; quickly upon failure. This doesn't handle malformed links
3103 ;; or nested square brackets well, so if it passes we back up
3104 ;; continue with a more precise search.
3105 (re-search-forward
3106 (if ref
3107 markdown-regex-link-reference
3108 markdown-regex-link-inline)
3109 last 'limit)))
3110 ;; Keep searching if this is in a code block, inline code, or a
3111 ;; comment, or if it is include syntax. The link text portion
3112 ;; (group 3) may contain inline code or comments, but the
3113 ;; markup, URL, and title should not be part of such elements.
3114 (if (or (markdown-range-property-any
3115 (match-beginning 0) (match-end 2) 'face prohibited-faces)
3116 (markdown-range-property-any
3117 (match-beginning 4) (match-end 0) 'face prohibited-faces)
3118 (and (char-equal (char-after (line-beginning-position)) ?<)
3119 (char-equal (char-after (1+ (line-beginning-position))) ?<)))
3120 (set-match-data nil)
3121 (setq found t))))
3122 ;; Match opening exclamation point (optional) and left bracket.
3123 (when (match-beginning 2)
3124 (let* ((bang (match-beginning 1))
3125 (first-begin (match-beginning 2))
3126 ;; Find end of block to prevent matching across blocks.
3127 (end-of-block (save-excursion
3128 (progn
3129 (goto-char (match-beginning 2))
3130 (markdown-end-of-text-block)
3131 (point))))
3132 ;; Move over balanced expressions to closing right bracket.
3133 ;; Catch unbalanced expression errors and return nil.
3134 (first-end (condition-case nil
3135 (and (goto-char first-begin)
3136 (scan-sexps (point) 1))
3137 (error nil)))
3138 ;; Continue with point at CONT-POINT upon failure.
3139 (cont-point (min (1+ first-begin) last))
3140 second-begin second-end url-begin url-end
3141 title-begin title-end)
3142 ;; When bracket found, in range, and followed by a left paren/bracket...
3143 (when (and first-end (< first-end end-of-block) (goto-char first-end)
3144 (char-equal (char-after (point)) (if ref ?\[ ?\()))
3145 ;; Scan across balanced expressions for closing parenthesis/bracket.
3146 (setq second-begin (point)
3147 second-end (condition-case nil
3148 (scan-sexps (point) 1)
3149 (error nil)))
3150 ;; Check that closing parenthesis/bracket is in range.
3151 (if (and second-end (<= second-end end-of-block) (<= second-end last))
3152 (progn
3153 ;; Search for (optional) title inside closing parenthesis
3154 (when (and (not ref) (search-forward "\"" second-end t))
3155 (setq title-begin (1- (point))
3156 title-end (and (goto-char second-end)
3157 (search-backward "\"" (1+ title-begin) t))
3158 title-end (and title-end (1+ title-end))))
3159 ;; Store URL/reference range
3160 (setq url-begin (1+ second-begin)
3161 url-end (1- (or title-begin second-end)))
3162 ;; Set match data, move point beyond link, and return
3163 (set-match-data
3164 (list (or bang first-begin) second-end ; 0 - all
3165 bang (and bang (1+ bang)) ; 1 - bang
3166 first-begin (1+ first-begin) ; 2 - markup
3167 (1+ first-begin) (1- first-end) ; 3 - link text
3168 (1- first-end) first-end ; 4 - markup
3169 second-begin (1+ second-begin) ; 5 - markup
3170 url-begin url-end ; 6 - url/reference
3171 title-begin title-end ; 7 - title
3172 (1- second-end) second-end)) ; 8 - markup
3173 ;; Nullify cont-point and leave point at end and
3174 (setq cont-point nil)
3175 (goto-char second-end))
3176 ;; If no closing parenthesis in range, update continuation point
3177 (setq cont-point (min end-of-block second-begin))))
3178 (cond
3179 ;; On failure, continue searching at cont-point
3180 ((and cont-point (< cont-point last))
3181 (goto-char cont-point)
3182 (markdown-match-generic-links last ref))
3183 ;; No more text, return nil
3184 ((and cont-point (= cont-point last))
3185 nil)
3186 ;; Return t if a match occurred
3187 (t t)))))
3189 (defun markdown-match-angle-uris (last)
3190 "Match angle bracket URIs from point to LAST."
3191 (when (markdown-match-inline-generic markdown-regex-angle-uri last)
3192 (goto-char (1+ (match-end 0)))))
3194 (defun markdown-match-plain-uris (last)
3195 "Match plain URIs from point to LAST."
3196 (when (markdown-match-inline-generic markdown-regex-uri last t)
3197 (goto-char (1+ (match-end 0)))))
3199 (defvar markdown-conditional-search-function #'re-search-forward
3200 "Conditional search function used in `markdown-search-until-condition'.
3201 Made into a variable to allow for dynamic let-binding.")
3203 (defun markdown-search-until-condition (condition &rest args)
3204 (let (ret)
3205 (while (and (not ret) (apply markdown-conditional-search-function args))
3206 (setq ret (funcall condition)))
3207 ret))
3209 (defun markdown-metadata-line-p (pos regexp)
3210 (save-excursion
3211 (or (= (line-number-at-pos pos) 1)
3212 (progn
3213 (forward-line -1)
3214 ;; skip multi-line metadata
3215 (while (and (looking-at-p "^\\s-+[[:alpha:]]")
3216 (> (line-number-at-pos (point)) 1))
3217 (forward-line -1))
3218 (looking-at-p regexp)))))
3220 (defun markdown-match-generic-metadata (regexp last)
3221 "Match metadata declarations specified by REGEXP from point to LAST.
3222 These declarations must appear inside a metadata block that begins at
3223 the beginning of the buffer and ends with a blank line (or the end of
3224 the buffer)."
3225 (let* ((first (point))
3226 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
3227 (block-begin (goto-char 1))
3228 (block-end (re-search-forward end-re nil t)))
3229 (if (and block-end (> first block-end))
3230 ;; Don't match declarations if there is no metadata block or if
3231 ;; the point is beyond the block. Move point to point-max to
3232 ;; prevent additional searches and return return nil since nothing
3233 ;; was found.
3234 (progn (goto-char (point-max)) nil)
3235 ;; If a block was found that begins before LAST and ends after
3236 ;; point, search for declarations inside it. If the starting is
3237 ;; before the beginning of the block, start there. Otherwise,
3238 ;; move back to FIRST.
3239 (goto-char (if (< first block-begin) block-begin first))
3240 (if (and (re-search-forward regexp (min last block-end) t)
3241 (markdown-metadata-line-p (point) regexp))
3242 ;; If a metadata declaration is found, set match-data and return t.
3243 (let ((key-beginning (match-beginning 1))
3244 (key-end (match-end 1))
3245 (markup-begin (match-beginning 2))
3246 (markup-end (match-end 2))
3247 (value-beginning (match-beginning 3)))
3248 (set-match-data (list key-beginning (point) ; complete metadata
3249 key-beginning key-end ; key
3250 markup-begin markup-end ; markup
3251 value-beginning (point))) ; value
3253 ;; Otherwise, move the point to last and return nil
3254 (goto-char last)
3255 nil))))
3257 (defun markdown-match-declarative-metadata (last)
3258 "Match declarative metadata from the point to LAST."
3259 (markdown-match-generic-metadata markdown-regex-declarative-metadata last))
3261 (defun markdown-match-pandoc-metadata (last)
3262 "Match Pandoc metadata from the point to LAST."
3263 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last))
3265 (defun markdown-match-yaml-metadata-begin (last)
3266 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last))
3268 (defun markdown-match-yaml-metadata-end (last)
3269 (markdown-match-propertized-text 'markdown-yaml-metadata-end last))
3271 (defun markdown-match-yaml-metadata-key (last)
3272 (markdown-match-propertized-text 'markdown-metadata-key last))
3274 (defun markdown-match-wiki-link (last)
3275 "Match wiki links from point to LAST."
3276 (when (and markdown-enable-wiki-links
3277 (not markdown-wiki-link-fontify-missing)
3278 (markdown-match-inline-generic markdown-regex-wiki-link last))
3279 (let ((begin (match-beginning 1)) (end (match-end 1)))
3280 (if (or (markdown-in-comment-p begin)
3281 (markdown-in-comment-p end)
3282 (markdown-inline-code-at-pos-p begin)
3283 (markdown-inline-code-at-pos-p end)
3284 (markdown-code-block-at-pos begin))
3285 (progn (goto-char (min (1+ begin) last))
3286 (when (< (point) last)
3287 (markdown-match-wiki-link last)))
3288 (set-match-data (list begin end))
3289 t))))
3291 (defun markdown-match-inline-attributes (last)
3292 "Match inline attributes from point to LAST."
3293 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow.
3294 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes
3295 ;; against matched string.
3296 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last)
3297 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0)))
3298 (markdown-match-inline-attributes last)
3299 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3300 (markdown-inline-code-at-pos-p (match-end 0))
3301 (markdown-in-comment-p))
3302 t))))
3304 (defun markdown-match-leanpub-sections (last)
3305 "Match Leanpub section markers from point to LAST."
3306 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last)
3307 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3308 (markdown-inline-code-at-pos-p (match-end 0))
3309 (markdown-in-comment-p))
3310 t)))
3312 (defun markdown-match-includes (last)
3313 "Match include statements from point to LAST.
3314 Sets match data for the following seven groups:
3315 Group 1: opening two angle brackets
3316 Group 2: opening title delimiter (optional)
3317 Group 3: title text (optional)
3318 Group 4: closing title delimiter (optional)
3319 Group 5: opening filename delimiter
3320 Group 6: filename
3321 Group 7: closing filename delimiter"
3322 (when (markdown-match-inline-generic markdown-regex-include last)
3323 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
3324 (markdown-in-comment-p (match-end 0))
3325 (markdown-code-block-at-pos (match-beginning 0))))))
3326 (cond
3327 ;; Parentheses and maybe square brackets, but no curly braces:
3328 ;; match optional title in square brackets and file in parentheses.
3329 ((and valid (match-beginning 5)
3330 (not (match-beginning 8)))
3331 (set-match-data (list (match-beginning 1) (match-end 7)
3332 (match-beginning 1) (match-end 1)
3333 (match-beginning 2) (match-end 2)
3334 (match-beginning 3) (match-end 3)
3335 (match-beginning 4) (match-end 4)
3336 (match-beginning 5) (match-end 5)
3337 (match-beginning 6) (match-end 6)
3338 (match-beginning 7) (match-end 7))))
3339 ;; Only square brackets present: match file in square brackets.
3340 ((and valid (match-beginning 2)
3341 (not (match-beginning 5))
3342 (not (match-beginning 7)))
3343 (set-match-data (list (match-beginning 1) (match-end 4)
3344 (match-beginning 1) (match-end 1)
3345 nil nil
3346 nil nil
3347 nil nil
3348 (match-beginning 2) (match-end 2)
3349 (match-beginning 3) (match-end 3)
3350 (match-beginning 4) (match-end 4))))
3351 ;; Only curly braces present: match file in curly braces.
3352 ((and valid (match-beginning 8)
3353 (not (match-beginning 2))
3354 (not (match-beginning 5)))
3355 (set-match-data (list (match-beginning 1) (match-end 10)
3356 (match-beginning 1) (match-end 1)
3357 nil nil
3358 nil nil
3359 nil nil
3360 (match-beginning 8) (match-end 8)
3361 (match-beginning 9) (match-end 9)
3362 (match-beginning 10) (match-end 10))))
3364 ;; Not a valid match, move to next line and search again.
3365 (forward-line)
3366 (when (< (point) last)
3367 (setq valid (markdown-match-includes last)))))
3368 valid)))
3370 (defun markdown-match-html-tag (last)
3371 "Match HTML tags from point to LAST."
3372 (when (and markdown-enable-html
3373 (markdown-match-inline-generic markdown-regex-html-tag last t))
3374 (set-match-data (list (match-beginning 0) (match-end 0)
3375 (match-beginning 1) (match-end 1)
3376 (match-beginning 2) (match-end 2)
3377 (match-beginning 9) (match-end 9)))
3381 ;;; Markdown Font Fontification Functions =====================================
3383 (defvar markdown--first-displayable-cache (make-hash-table :test #'equal))
3385 (defun markdown--first-displayable (seq)
3386 "Return the first displayable character or string in SEQ.
3387 SEQ may be an atom or a sequence."
3388 (let ((c (gethash seq markdown--first-displayable-cache t)))
3389 (if (not (eq c t))
3391 (puthash seq
3392 (let ((seq (if (listp seq) seq (list seq))))
3393 (cond ((stringp (car seq))
3394 (cl-find-if
3395 (lambda (str)
3396 (and (mapcar #'char-displayable-p (string-to-list str))))
3397 seq))
3398 ((characterp (car seq))
3399 (cl-find-if #'char-displayable-p seq))))
3400 markdown--first-displayable-cache))))
3402 (defun markdown--marginalize-string (level)
3403 "Generate atx markup string of given LEVEL for left margin."
3404 (let ((margin-left-space-count
3405 (- markdown-marginalize-headers-margin-width level)))
3406 (concat (make-string margin-left-space-count ? )
3407 (make-string level ?#))))
3409 (defun markdown-marginalize-update-current ()
3410 "Update the window configuration to create a left margin."
3411 (if window-system
3412 (let* ((header-delimiter-font-width
3413 (window-font-width nil 'markdown-header-delimiter-face))
3414 (margin-pixel-width (* markdown-marginalize-headers-margin-width
3415 header-delimiter-font-width))
3416 (margin-char-width (/ margin-pixel-width (default-font-width))))
3417 (set-window-margins nil margin-char-width))
3418 ;; As a fallback, simply set margin based on character count.
3419 (set-window-margins nil (1+ markdown-marginalize-headers-margin-width))))
3421 (defun markdown-fontify-headings (last)
3422 "Add text properties to headings from point to LAST."
3423 (when (markdown-match-propertized-text 'markdown-heading last)
3424 (let* ((level (markdown-outline-level))
3425 (heading-face
3426 (intern (format "markdown-header-face-%d" level)))
3427 (heading-props `(face ,heading-face))
3428 (left-markup-props
3429 `(face markdown-header-delimiter-face
3430 ,@(cond
3431 (markdown-hide-markup
3432 `(display ""))
3433 (markdown-marginalize-headers
3434 `(display ((margin left-margin)
3435 ,(markdown--marginalize-string level)))))))
3436 (right-markup-props
3437 `(face markdown-header-delimiter-face
3438 ,@(when markdown-hide-markup `(display ""))))
3439 (rule-props `(face markdown-header-rule-face
3440 ,@(when markdown-hide-markup `(display "")))))
3441 (if (match-end 1)
3442 ;; Setext heading
3443 (progn (add-text-properties
3444 (match-beginning 1) (match-end 1) heading-props)
3445 (if (= level 1)
3446 (add-text-properties
3447 (match-beginning 2) (match-end 2) rule-props)
3448 (add-text-properties
3449 (match-beginning 3) (match-end 3) rule-props)))
3450 ;; atx heading
3451 (if markdown-fontify-whole-heading-line
3452 (let ((header-end (min (point-max) (1+ (match-end 0)))))
3453 (add-text-properties
3454 (match-beginning 0) header-end heading-props))
3455 (add-text-properties
3456 (match-beginning 4) (match-end 4) left-markup-props)
3457 (add-text-properties
3458 (match-beginning 5) (match-end 5) heading-props)
3459 (when (match-end 6)
3460 (add-text-properties
3461 (match-beginning 6) (match-end 6) right-markup-props)))))
3464 (defun markdown-fontify-tables (last)
3465 (when (re-search-forward "|" last t)
3466 (when (markdown-table-at-point-p)
3467 (font-lock-append-text-property
3468 (line-beginning-position) (min (1+ (line-end-position)) (point-max))
3469 'face 'markdown-table-face))
3470 (forward-line 1)
3473 (defun markdown-fontify-blockquotes (last)
3474 "Apply font-lock properties to blockquotes from point to LAST."
3475 (when (markdown-match-blockquotes last)
3476 (let ((display-string
3477 (markdown--first-displayable markdown-blockquote-display-char)))
3478 (add-text-properties
3479 (match-beginning 1) (match-end 1)
3480 (if markdown-hide-markup
3481 `(face markdown-blockquote-face display ,display-string)
3482 `(face markdown-markup-face)))
3483 (font-lock-append-text-property
3484 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face)
3485 t)))
3487 (defun markdown-fontify-list-items (last)
3488 "Apply font-lock properties to list markers from point to LAST."
3489 (when (markdown-match-list-items last)
3490 (when (not (markdown-code-block-at-point-p (match-beginning 2)))
3491 (let* ((indent (length (match-string-no-properties 1)))
3492 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ...
3493 (bullet (nth (mod level (length markdown-list-item-bullets))
3494 markdown-list-item-bullets)))
3495 (add-text-properties
3496 (match-beginning 2) (match-end 2) '(face markdown-list-face))
3497 (when markdown-hide-markup
3498 (cond
3499 ;; Unordered lists
3500 ((string-match-p "[\\*\\+-]" (match-string 2))
3501 (add-text-properties
3502 (match-beginning 2) (match-end 2) `(display ,bullet)))
3503 ;; Definition lists
3504 ((string-equal ":" (match-string 2))
3505 (let ((display-string
3506 (char-to-string (markdown--first-displayable
3507 markdown-definition-display-char))))
3508 (add-text-properties (match-beginning 2) (match-end 2)
3509 `(display ,display-string))))))))
3512 (defun markdown--fontify-hrs-view-mode (hr-char)
3513 (if (and hr-char (display-supports-face-attributes-p '(:extend t)))
3514 (add-text-properties
3515 (match-beginning 0) (match-end 0)
3516 `(face
3517 (:inherit markdown-hr-face :underline t :extend t)
3518 font-lock-multiline t
3519 display "\n"))
3520 (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char)))))
3521 (add-text-properties
3522 (match-beginning 0) (match-end 0)
3523 `(face
3524 markdown-hr-face font-lock-multiline t
3525 display ,(make-string hr-len hr-char))))))
3527 (defun markdown-fontify-hrs (last)
3528 "Add text properties to horizontal rules from point to LAST."
3529 (when (markdown-match-hr last)
3530 (let ((hr-char (markdown--first-displayable markdown-hr-display-char)))
3531 (if (and markdown-hide-markup hr-char)
3532 (markdown--fontify-hrs-view-mode hr-char)
3533 (add-text-properties
3534 (match-beginning 0) (match-end 0)
3535 `(face markdown-hr-face font-lock-multiline t)))
3536 t)))
3538 (defun markdown-fontify-sub-superscripts (last)
3539 "Apply text properties to sub- and superscripts from point to LAST."
3540 (when (markdown-search-until-condition
3541 (lambda () (and (not (markdown-code-block-at-point-p))
3542 (not (markdown-inline-code-at-point-p))
3543 (not (markdown-in-comment-p))))
3544 markdown-regex-sub-superscript last t)
3545 (let* ((subscript-p (string= (match-string 2) "~"))
3546 (props
3547 (if subscript-p
3548 (car markdown-sub-superscript-display)
3549 (cdr markdown-sub-superscript-display)))
3550 (mp (list 'face 'markdown-markup-face
3551 'invisible 'markdown-markup)))
3552 (when markdown-hide-markup
3553 (put-text-property (match-beginning 3) (match-end 3)
3554 'display props))
3555 (add-text-properties (match-beginning 2) (match-end 2) mp)
3556 (add-text-properties (match-beginning 4) (match-end 4) mp)
3557 t)))
3560 ;;; Syntax Table ==============================================================
3562 (defvar markdown-mode-syntax-table
3563 (let ((tab (make-syntax-table text-mode-syntax-table)))
3564 (modify-syntax-entry ?\" "." tab)
3565 tab)
3566 "Syntax table for `markdown-mode'.")
3569 ;;; Element Insertion =========================================================
3571 (defun markdown-ensure-blank-line-before ()
3572 "If previous line is not already blank, insert a blank line before point."
3573 (unless (bolp) (insert "\n"))
3574 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n")))
3576 (defun markdown-ensure-blank-line-after ()
3577 "If following line is not already blank, insert a blank line after point.
3578 Return the point where it was originally."
3579 (save-excursion
3580 (unless (eolp) (insert "\n"))
3581 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
3583 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end)
3584 "Insert the strings S1 and S2, wrapping around region or THING.
3585 If a region is specified by the optional BEG and END arguments,
3586 wrap the strings S1 and S2 around that region.
3587 If there is an active region, wrap the strings S1 and S2 around
3588 the region. If there is not an active region but the point is at
3589 THING, wrap that thing (which defaults to word). Otherwise, just
3590 insert S1 and S2 and place the point in between. Return the
3591 bounds of the entire wrapped string, or nil if nothing was wrapped
3592 and S1 and S2 were only inserted."
3593 (let (a b bounds new-point)
3594 (cond
3595 ;; Given region
3596 ((and beg end)
3597 (setq a beg
3598 b end
3599 new-point (+ (point) (length s1))))
3600 ;; Active region
3601 ((use-region-p)
3602 (setq a (region-beginning)
3603 b (region-end)
3604 new-point (+ (point) (length s1))))
3605 ;; Thing (word) at point
3606 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word)))
3607 (setq a (car bounds)
3608 b (cdr bounds)
3609 new-point (+ (point) (length s1))))
3610 ;; No active region and no word
3612 (setq a (point)
3613 b (point))))
3614 (goto-char b)
3615 (insert s2)
3616 (goto-char a)
3617 (insert s1)
3618 (when new-point (goto-char new-point))
3619 (if (= a b)
3621 (setq b (+ b (length s1) (length s2)))
3622 (cons a b))))
3624 (defun markdown-point-after-unwrap (cur prefix suffix)
3625 "Return desired position of point after an unwrapping operation.
3626 CUR gives the position of the point before the operation.
3627 Additionally, two cons cells must be provided. PREFIX gives the
3628 bounds of the prefix string and SUFFIX gives the bounds of the
3629 suffix string."
3630 (cond ((< cur (cdr prefix)) (car prefix))
3631 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix))))
3632 ((<= cur (cdr suffix))
3633 (- cur (+ (- (cdr prefix) (car prefix))
3634 (- cur (car suffix)))))
3635 (t cur)))
3637 (defun markdown-unwrap-thing-at-point (regexp all text)
3638 "Remove prefix and suffix of thing at point and reposition the point.
3639 When the thing at point matches REGEXP, replace the subexpression
3640 ALL with the string in subexpression TEXT. Reposition the point
3641 in an appropriate location accounting for the removal of prefix
3642 and suffix strings. Return new bounds of string from group TEXT.
3643 When REGEXP is nil, assumes match data is already set."
3644 (when (or (null regexp)
3645 (thing-at-point-looking-at regexp))
3646 (let ((cur (point))
3647 (prefix (cons (match-beginning all) (match-beginning text)))
3648 (suffix (cons (match-end text) (match-end all)))
3649 (bounds (cons (match-beginning text) (match-end text))))
3650 ;; Replace the thing at point
3651 (replace-match (match-string text) t t nil all)
3652 ;; Reposition the point
3653 (goto-char (markdown-point-after-unwrap cur prefix suffix))
3654 ;; Adjust bounds
3655 (setq bounds (cons (car prefix)
3656 (- (cdr bounds) (- (cdr prefix) (car prefix))))))))
3658 (defun markdown-unwrap-things-in-region (beg end regexp all text)
3659 "Remove prefix and suffix of all things in region from BEG to END.
3660 When a thing in the region matches REGEXP, replace the
3661 subexpression ALL with the string in subexpression TEXT.
3662 Return a cons cell containing updated bounds for the region."
3663 (save-excursion
3664 (goto-char beg)
3665 (let ((removed 0) len-all len-text)
3666 (while (re-search-forward regexp (- end removed) t)
3667 (setq len-all (length (match-string-no-properties all)))
3668 (setq len-text (length (match-string-no-properties text)))
3669 (setq removed (+ removed (- len-all len-text)))
3670 (replace-match (match-string text) t t nil all))
3671 (cons beg (- end removed)))))
3673 (defun markdown-insert-hr (arg)
3674 "Insert or replace a horizontal rule.
3675 By default, use the first element of `markdown-hr-strings'. When
3676 ARG is non-nil, as when given a prefix, select a different
3677 element as follows. When prefixed with \\[universal-argument],
3678 use the last element of `markdown-hr-strings' instead. When
3679 prefixed with an integer from 1 to the length of
3680 `markdown-hr-strings', use the element in that position instead."
3681 (interactive "*P")
3682 (when (thing-at-point-looking-at markdown-regex-hr)
3683 (delete-region (match-beginning 0) (match-end 0)))
3684 (markdown-ensure-blank-line-before)
3685 (cond ((equal arg '(4))
3686 (insert (car (reverse markdown-hr-strings))))
3687 ((and (integerp arg) (> arg 0)
3688 (<= arg (length markdown-hr-strings)))
3689 (insert (nth (1- arg) markdown-hr-strings)))
3691 (insert (car markdown-hr-strings))))
3692 (markdown-ensure-blank-line-after))
3694 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face
3695 &optional skip-space)
3696 (if (use-region-p)
3697 ;; Active region
3698 (let* ((bounds (markdown-unwrap-things-in-region
3699 (region-beginning) (region-end)
3700 regex start-group end-group))
3701 (beg (car bounds))
3702 (end (cdr bounds)))
3703 (when (and beg skip-space)
3704 (save-excursion
3705 (goto-char beg)
3706 (skip-chars-forward "[ \t]")
3707 (setq beg (point))))
3708 (when (and end skip-space)
3709 (save-excursion
3710 (goto-char end)
3711 (skip-chars-backward "[ \t]")
3712 (setq end (point))))
3713 (markdown-wrap-or-insert start-delim end-delim nil beg end))
3714 (if (markdown--face-p (point) (list face))
3715 (save-excursion
3716 (while (and (markdown--face-p (point) (list face)) (not (bobp)))
3717 (forward-char -1))
3718 (forward-char (- (1- (length start-delim)))) ;; for delimiter
3719 (unless (bolp)
3720 (forward-char -1))
3721 (when (looking-at regex)
3722 (markdown-unwrap-thing-at-point nil start-group end-group)))
3723 (if (thing-at-point-looking-at regex)
3724 (markdown-unwrap-thing-at-point nil start-group end-group)
3725 (markdown-wrap-or-insert start-delim end-delim 'word nil nil)))))
3727 (defun markdown-insert-bold ()
3728 "Insert markup to make a region or word bold.
3729 If there is an active region, make the region bold. If the point
3730 is at a non-bold word, make the word bold. If the point is at a
3731 bold word or phrase, remove the bold markup. Otherwise, simply
3732 insert bold delimiters and place the point in between them."
3733 (interactive)
3734 (let ((delim (if markdown-bold-underscore "__" "**")))
3735 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t)))
3737 (defun markdown-insert-italic ()
3738 "Insert markup to make a region or word italic.
3739 If there is an active region, make the region italic. If the point
3740 is at a non-italic word, make the word italic. If the point is at an
3741 italic word or phrase, remove the italic markup. Otherwise, simply
3742 insert italic delimiters and place the point in between them."
3743 (interactive)
3744 (let ((delim (if markdown-italic-underscore "_" "*")))
3745 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t)))
3747 (defun markdown-insert-strike-through ()
3748 "Insert markup to make a region or word strikethrough.
3749 If there is an active region, make the region strikethrough. If the point
3750 is at a non-bold word, make the word strikethrough. If the point is at a
3751 strikethrough word or phrase, remove the strikethrough markup. Otherwise,
3752 simply insert bold delimiters and place the point in between them."
3753 (interactive)
3754 (markdown--insert-common
3755 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t))
3757 (defun markdown-insert-code ()
3758 "Insert markup to make a region or word an inline code fragment.
3759 If there is an active region, make the region an inline code
3760 fragment. If the point is at a word, make the word an inline
3761 code fragment. Otherwise, simply insert code delimiters and
3762 place the point in between them."
3763 (interactive)
3764 (if (use-region-p)
3765 ;; Active region
3766 (let ((bounds (markdown-unwrap-things-in-region
3767 (region-beginning) (region-end)
3768 markdown-regex-code 1 3)))
3769 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds)))
3770 ;; Code markup removal, code markup for word, or empty markup insertion
3771 (if (markdown-inline-code-at-point)
3772 (markdown-unwrap-thing-at-point nil 0 2)
3773 (markdown-wrap-or-insert "`" "`" 'word nil nil))))
3775 (defun markdown-insert-kbd ()
3776 "Insert markup to wrap region or word in <kbd> tags.
3777 If there is an active region, use the region. If the point is at
3778 a word, use the word. Otherwise, simply insert <kbd> tags and
3779 place the point in between them."
3780 (interactive)
3781 (if (use-region-p)
3782 ;; Active region
3783 (let ((bounds (markdown-unwrap-things-in-region
3784 (region-beginning) (region-end)
3785 markdown-regex-kbd 0 2)))
3786 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds)))
3787 ;; Markup removal, markup for word, or empty markup insertion
3788 (if (thing-at-point-looking-at markdown-regex-kbd)
3789 (markdown-unwrap-thing-at-point nil 0 2)
3790 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil))))
3792 (defun markdown-insert-inline-link (text url &optional title)
3793 "Insert an inline link with TEXT pointing to URL.
3794 Optionally, the user can provide a TITLE."
3795 (let ((cur (point)))
3796 (setq title (and title (concat " \"" title "\"")))
3797 (insert (concat "[" text "](" url title ")"))
3798 (cond ((not text) (goto-char (+ 1 cur)))
3799 ((not url) (goto-char (+ 3 (length text) cur))))))
3801 (defun markdown-insert-inline-image (text url &optional title)
3802 "Insert an inline link with alt TEXT pointing to URL.
3803 Optionally, also provide a TITLE."
3804 (let ((cur (point)))
3805 (setq title (and title (concat " \"" title "\"")))
3806 (insert (concat "![" text "](" url title ")"))
3807 (cond ((not text) (goto-char (+ 2 cur)))
3808 ((not url) (goto-char (+ 4 (length text) cur))))))
3810 (defun markdown-insert-reference-link (text label &optional url title)
3811 "Insert a reference link and, optionally, a reference definition.
3812 The link TEXT will be inserted followed by the optional LABEL.
3813 If a URL is given, also insert a definition for the reference
3814 LABEL according to `markdown-reference-location'. If a TITLE is
3815 given, it will be added to the end of the reference definition
3816 and will be used to populate the title attribute when converted
3817 to XHTML. If URL is nil, insert only the link portion (for
3818 example, when a reference label is already defined)."
3819 (insert (concat "[" text "][" label "]"))
3820 (when url
3821 (markdown-insert-reference-definition
3822 (if (string-equal label "") text label)
3823 url title)))
3825 (defun markdown-insert-reference-image (text label &optional url title)
3826 "Insert a reference image and, optionally, a reference definition.
3827 The alt TEXT will be inserted followed by the optional LABEL.
3828 If a URL is given, also insert a definition for the reference
3829 LABEL according to `markdown-reference-location'. If a TITLE is
3830 given, it will be added to the end of the reference definition
3831 and will be used to populate the title attribute when converted
3832 to XHTML. If URL is nil, insert only the link portion (for
3833 example, when a reference label is already defined)."
3834 (insert (concat "![" text "][" label "]"))
3835 (when url
3836 (markdown-insert-reference-definition
3837 (if (string-equal label "") text label)
3838 url title)))
3840 (defun markdown-insert-reference-definition (label &optional url title)
3841 "Add definition for reference LABEL with URL and TITLE.
3842 LABEL is a Markdown reference label without square brackets.
3843 URL and TITLE are optional. When given, the TITLE will
3844 be used to populate the title attribute when converted to XHTML."
3845 ;; END specifies where to leave the point upon return
3846 (let ((end (point)))
3847 (cl-case markdown-reference-location
3848 (end (goto-char (point-max)))
3849 (immediately (markdown-end-of-text-block))
3850 (subtree (markdown-end-of-subtree))
3851 (header (markdown-end-of-defun)))
3852 ;; Skip backwards over local variables. This logic is similar to the one
3853 ;; used in ‘hack-local-variables’.
3854 (when (and enable-local-variables (eobp))
3855 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move)
3856 (when (let ((case-fold-search t))
3857 (search-forward "Local Variables:" nil :move))
3858 (beginning-of-line 0)
3859 (when (eq (char-before) ?\n) (backward-char))))
3860 (unless (or (markdown-cur-line-blank-p)
3861 (thing-at-point-looking-at markdown-regex-reference-definition))
3862 (insert "\n"))
3863 (insert "\n[" label "]: ")
3864 (if url
3865 (insert url)
3866 ;; When no URL is given, leave point at END following the colon
3867 (setq end (point)))
3868 (when (> (length title) 0)
3869 (insert " \"" title "\""))
3870 (unless (looking-at-p "\n")
3871 (insert "\n"))
3872 (goto-char end)
3873 (when url
3874 (message
3875 (markdown--substitute-command-keys
3876 "Reference [%s] was defined, press \\[markdown-do] to jump there")
3877 label))))
3879 (defcustom markdown-link-make-text-function nil
3880 "Function that automatically generates a link text for a URL.
3882 If non-nil, this function will be called by
3883 `markdown--insert-link-or-image' and the result will be the
3884 default link text. The function should receive exactly one
3885 argument that corresponds to the link URL."
3886 :group 'markdown
3887 :type 'function
3888 :package-version '(markdown-mode . "2.5"))
3890 (defcustom markdown-disable-tooltip-prompt nil
3891 "Disable prompt for tooltip when inserting a link or image.
3893 If non-nil, `markdown-insert-link' and `markdown-insert-link'
3894 will not prompt the user to insert a tooltip text for the given
3895 link or image."
3896 :group 'markdown
3897 :type 'boolean
3898 :safe 'booleanp
3899 :package-version '(markdown-mode . "2.5"))
3901 (defun markdown--insert-link-or-image (image)
3902 "Interactively insert new or update an existing link or image.
3903 When IMAGE is non-nil, insert an image. Otherwise, insert a link.
3904 This is an internal function called by
3905 `markdown-insert-link' and `markdown-insert-image'."
3906 (cl-multiple-value-bind (begin end text uri ref title)
3907 (if (use-region-p)
3908 ;; Use region as either link text or URL as appropriate.
3909 (let ((region (buffer-substring-no-properties
3910 (region-beginning) (region-end))))
3911 (if (string-match markdown-regex-uri region)
3912 ;; Region contains a URL; use it as such.
3913 (list (region-beginning) (region-end)
3914 nil (match-string 0 region) nil nil)
3915 ;; Region doesn't contain a URL, so use it as text.
3916 (list (region-beginning) (region-end)
3917 region nil nil nil)))
3918 ;; Extract and use properties of existing link, if any.
3919 (markdown-link-at-pos (point)))
3920 (let* ((ref (when ref (concat "[" ref "]")))
3921 (defined-refs (mapcar #'car (markdown-get-defined-references)))
3922 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs))
3923 (used-uris (markdown-get-used-uris))
3924 (uri-or-ref (completing-read
3925 "URL or [reference]: "
3926 (append defined-ref-cands used-uris)
3927 nil nil (or uri ref)))
3928 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref)
3929 (match-string 1 uri-or-ref))
3930 ((string-equal "" uri-or-ref)
3931 "")))
3932 (uri (unless ref uri-or-ref))
3933 (text-prompt (if image
3934 "Alt text: "
3935 (if ref
3936 "Link text: "
3937 "Link text (blank for plain URL): ")))
3938 (text (or text (and markdown-link-make-text-function uri
3939 (funcall markdown-link-make-text-function uri))))
3940 (text (completing-read text-prompt defined-refs nil nil text))
3941 (text (if (= (length text) 0) nil text))
3942 (plainp (and uri (not text)))
3943 (implicitp (string-equal ref ""))
3944 (ref (if implicitp text ref))
3945 (definedp (and ref (markdown-reference-definition ref)))
3946 (ref-url (unless (or uri definedp)
3947 (completing-read "Reference URL: " used-uris)))
3948 (title (unless (or plainp definedp markdown-disable-tooltip-prompt)
3949 (read-string "Title (tooltip text, optional): " title)))
3950 (title (if (= (length title) 0) nil title)))
3951 (when (and image implicitp)
3952 (user-error "Reference required: implicit image references are invalid"))
3953 (when (and begin end)
3954 (delete-region begin end))
3955 (cond
3956 ((and (not image) uri text)
3957 (markdown-insert-inline-link text uri title))
3958 ((and image uri text)
3959 (markdown-insert-inline-image text uri title))
3960 ((and ref text)
3961 (if image
3962 (markdown-insert-reference-image text (unless implicitp ref) nil title)
3963 (markdown-insert-reference-link text (unless implicitp ref) nil title))
3964 (unless definedp
3965 (markdown-insert-reference-definition ref ref-url title)))
3966 ((and (not image) uri)
3967 (markdown-insert-uri uri))))))
3969 (defun markdown-insert-link ()
3970 "Insert new or update an existing link, with interactive prompt.
3971 If the point is at an existing link or URL, update the link text,
3972 URL, reference label, and/or title. Otherwise, insert a new link.
3973 The type of link inserted (inline, reference, or plain URL)
3974 depends on which values are provided:
3976 * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
3977 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
3978 * If only TEXT is given, insert an implicit reference link: [TEXT][].
3979 * If only a URL is given, insert a plain link: <URL>.
3981 In other words, to create an implicit reference link, leave the
3982 URL prompt empty and to create a plain URL link, leave the link
3983 text empty.
3985 If there is an active region, use the text as the default URL, if
3986 it seems to be a URL, or link text value otherwise.
3988 If a given reference is not defined, this function will
3989 additionally prompt for the URL and optional title. In this case,
3990 the reference definition is placed at the location determined by
3991 `markdown-reference-location'. In addition, it is possible to
3992 have the `markdown-link-make-text-function' function, if non-nil,
3993 define the default link text before prompting the user for it.
3995 If `markdown-disable-tooltip-prompt' is non-nil, the user will
3996 not be prompted to add or modify a tooltip text.
3998 Through updating the link, this function can be used to convert a
3999 link of one type (inline, reference, or plain) to another type by
4000 selectively adding or removing information via the prompts."
4001 (interactive)
4002 (markdown--insert-link-or-image nil))
4004 (defun markdown-insert-image ()
4005 "Insert new or update an existing image, with interactive prompt.
4006 If the point is at an existing image, update the alt text, URL,
4007 reference label, and/or title. Otherwise, insert a new image.
4008 The type of image inserted (inline or reference) depends on which
4009 values are provided:
4011 * If a URL and ALT-TEXT are given, insert an inline image:
4012 ![ALT-TEXT](URL).
4013 * If [REF] and ALT-TEXT are given, insert a reference image:
4014 ![ALT-TEXT][REF].
4016 If there is an active region, use the text as the default URL, if
4017 it seems to be a URL, or alt text value otherwise.
4019 If a given reference is not defined, this function will
4020 additionally prompt for the URL and optional title. In this case,
4021 the reference definition is placed at the location determined by
4022 `markdown-reference-location'.
4024 Through updating the image, this function can be used to convert an
4025 image of one type (inline or reference) to another type by
4026 selectively adding or removing information via the prompts."
4027 (interactive)
4028 (markdown--insert-link-or-image t))
4030 (defun markdown-insert-uri (&optional uri)
4031 "Insert markup for an inline URI.
4032 If there is an active region, use it as the URI. If the point is
4033 at a URI, wrap it with angle brackets. If the point is at an
4034 inline URI, remove the angle brackets. Otherwise, simply insert
4035 angle brackets place the point between them."
4036 (interactive)
4037 (if (use-region-p)
4038 ;; Active region
4039 (let ((bounds (markdown-unwrap-things-in-region
4040 (region-beginning) (region-end)
4041 markdown-regex-angle-uri 0 2)))
4042 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds)))
4043 ;; Markup removal, URI at point, new URI, or empty markup insertion
4044 (if (thing-at-point-looking-at markdown-regex-angle-uri)
4045 (markdown-unwrap-thing-at-point nil 0 2)
4046 (if uri
4047 (insert "<" uri ">")
4048 (markdown-wrap-or-insert "<" ">" 'url nil nil)))))
4050 (defun markdown-insert-wiki-link ()
4051 "Insert a wiki link of the form [[WikiLink]].
4052 If there is an active region, use the region as the link text.
4053 If the point is at a word, use the word as the link text. If
4054 there is no active region and the point is not at word, simply
4055 insert link markup."
4056 (interactive)
4057 (if (use-region-p)
4058 ;; Active region
4059 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end))
4060 ;; Markup removal, wiki link at at point, or empty markup insertion
4061 (if (thing-at-point-looking-at markdown-regex-wiki-link)
4062 (if (or markdown-wiki-link-alias-first
4063 (null (match-string 5)))
4064 (markdown-unwrap-thing-at-point nil 1 3)
4065 (markdown-unwrap-thing-at-point nil 1 5))
4066 (markdown-wrap-or-insert "[[" "]]"))))
4068 (defun markdown-remove-header ()
4069 "Remove header markup if point is at a header.
4070 Return bounds of remaining header text if a header was removed
4071 and nil otherwise."
4072 (interactive "*")
4073 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2)
4074 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1)))
4076 (defun markdown-insert-header (&optional level text setext)
4077 "Insert or replace header markup.
4078 The level of the header is specified by LEVEL and header text is
4079 given by TEXT. LEVEL must be an integer from 1 and 6, and the
4080 default value is 1.
4081 When TEXT is nil, the header text is obtained as follows.
4082 If there is an active region, it is used as the header text.
4083 Otherwise, the current line will be used as the header text.
4084 If there is not an active region and the point is at a header,
4085 remove the header markup and replace with level N header.
4086 Otherwise, insert empty header markup and place the point in
4087 between.
4088 The style of the header will be atx (hash marks) unless
4089 SETEXT is non-nil, in which case a setext-style (underlined)
4090 header will be inserted."
4091 (interactive "p\nsHeader text: ")
4092 (setq level (min (max (or level 1) 1) (if setext 2 6)))
4093 ;; Determine header text if not given
4094 (when (null text)
4095 (if (use-region-p)
4096 ;; Active region
4097 (setq text (delete-and-extract-region (region-beginning) (region-end)))
4098 ;; No active region
4099 (markdown-remove-header)
4100 (setq text (delete-and-extract-region
4101 (line-beginning-position) (line-end-position)))
4102 (when (and setext (string-match-p "^[ \t]*$" text))
4103 (setq text (read-string "Header text: "))))
4104 (setq text (markdown-compress-whitespace-string text)))
4105 ;; Insertion with given text
4106 (markdown-ensure-blank-line-before)
4107 (let (hdr)
4108 (cond (setext
4109 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=)))
4110 (insert text "\n" hdr))
4112 (setq hdr (make-string level ?#))
4113 (insert hdr " " text)
4114 (when (null markdown-asymmetric-header) (insert " " hdr)))))
4115 (markdown-ensure-blank-line-after)
4116 ;; Leave point at end of text
4117 (cond (setext
4118 (backward-char (1+ (string-width text))))
4119 ((null markdown-asymmetric-header)
4120 (backward-char (1+ level)))))
4122 (defun markdown-insert-header-dwim (&optional arg setext)
4123 "Insert or replace header markup.
4124 The level and type of the header are determined automatically by
4125 the type and level of the previous header, unless a prefix
4126 argument is given via ARG.
4127 With a numeric prefix valued 1 to 6, insert a header of the given
4128 level, with the type being determined automatically (note that
4129 only level 1 or 2 setext headers are possible).
4131 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
4132 promote the heading by one level.
4133 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
4134 demote the heading by one level.
4135 When SETEXT is non-nil, prefer setext-style headers when
4136 possible (levels one and two).
4138 When there is an active region, use it for the header text. When
4139 the point is at an existing header, change the type and level
4140 according to the rules above.
4141 Otherwise, if the line is not empty, create a header using the
4142 text on the current line as the header text.
4143 Finally, if the point is on a blank line, insert empty header
4144 markup (atx) or prompt for text (setext).
4145 See `markdown-insert-header' for more details about how the
4146 header text is determined."
4147 (interactive "*P")
4148 (let (level)
4149 (save-excursion
4150 (when (or (thing-at-point-looking-at markdown-regex-header)
4151 (re-search-backward markdown-regex-header nil t))
4152 ;; level of current or previous header
4153 (setq level (markdown-outline-level))
4154 ;; match group 1 indicates a setext header
4155 (setq setext (match-end 1))))
4156 ;; check prefix argument
4157 (cond
4158 ((and (equal arg '(4)) level (> level 1)) ;; C-u
4159 (cl-decf level))
4160 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u
4161 (cl-incf level))
4162 (arg ;; numeric prefix
4163 (setq level (prefix-numeric-value arg))))
4164 ;; setext headers must be level one or two
4165 (and level (setq setext (and setext (<= level 2))))
4166 ;; insert the heading
4167 (markdown-insert-header level nil setext)))
4169 (defun markdown-insert-header-setext-dwim (&optional arg)
4170 "Insert or replace header markup, with preference for setext.
4171 See `markdown-insert-header-dwim' for details, including how ARG is handled."
4172 (interactive "*P")
4173 (markdown-insert-header-dwim arg t))
4175 (defun markdown-insert-header-atx-1 ()
4176 "Insert a first level atx-style (hash mark) header.
4177 See `markdown-insert-header'."
4178 (interactive "*")
4179 (markdown-insert-header 1 nil nil))
4181 (defun markdown-insert-header-atx-2 ()
4182 "Insert a level two atx-style (hash mark) header.
4183 See `markdown-insert-header'."
4184 (interactive "*")
4185 (markdown-insert-header 2 nil nil))
4187 (defun markdown-insert-header-atx-3 ()
4188 "Insert a level three atx-style (hash mark) header.
4189 See `markdown-insert-header'."
4190 (interactive "*")
4191 (markdown-insert-header 3 nil nil))
4193 (defun markdown-insert-header-atx-4 ()
4194 "Insert a level four atx-style (hash mark) header.
4195 See `markdown-insert-header'."
4196 (interactive "*")
4197 (markdown-insert-header 4 nil nil))
4199 (defun markdown-insert-header-atx-5 ()
4200 "Insert a level five atx-style (hash mark) header.
4201 See `markdown-insert-header'."
4202 (interactive "*")
4203 (markdown-insert-header 5 nil nil))
4205 (defun markdown-insert-header-atx-6 ()
4206 "Insert a sixth level atx-style (hash mark) header.
4207 See `markdown-insert-header'."
4208 (interactive "*")
4209 (markdown-insert-header 6 nil nil))
4211 (defun markdown-insert-header-setext-1 ()
4212 "Insert a setext-style (underlined) first-level header.
4213 See `markdown-insert-header'."
4214 (interactive "*")
4215 (markdown-insert-header 1 nil t))
4217 (defun markdown-insert-header-setext-2 ()
4218 "Insert a setext-style (underlined) second-level header.
4219 See `markdown-insert-header'."
4220 (interactive "*")
4221 (markdown-insert-header 2 nil t))
4223 (defun markdown-blockquote-indentation (loc)
4224 "Return string containing necessary indentation for a blockquote at LOC.
4225 Also see `markdown-pre-indentation'."
4226 (save-excursion
4227 (goto-char loc)
4228 (let* ((list-level (length (markdown-calculate-list-levels)))
4229 (indent ""))
4230 (dotimes (_ list-level indent)
4231 (setq indent (concat indent " "))))))
4233 (defun markdown-insert-blockquote ()
4234 "Start a blockquote section (or blockquote the region).
4235 If Transient Mark mode is on and a region is active, it is used as
4236 the blockquote text."
4237 (interactive)
4238 (if (use-region-p)
4239 (markdown-blockquote-region (region-beginning) (region-end))
4240 (markdown-ensure-blank-line-before)
4241 (insert (markdown-blockquote-indentation (point)) "> ")
4242 (markdown-ensure-blank-line-after)))
4244 (defun markdown-block-region (beg end prefix)
4245 "Format the region using a block prefix.
4246 Arguments BEG and END specify the beginning and end of the
4247 region. The characters PREFIX will appear at the beginning
4248 of each line."
4249 (save-excursion
4250 (let* ((end-marker (make-marker))
4251 (beg-marker (make-marker))
4252 (prefix-without-trailing-whitespace
4253 (replace-regexp-in-string (rx (+ blank) eos) "" prefix)))
4254 ;; Ensure blank line after and remove extra whitespace
4255 (goto-char end)
4256 (skip-syntax-backward "-")
4257 (set-marker end-marker (point))
4258 (delete-horizontal-space)
4259 (markdown-ensure-blank-line-after)
4260 ;; Ensure blank line before and remove extra whitespace
4261 (goto-char beg)
4262 (skip-syntax-forward "-")
4263 (delete-horizontal-space)
4264 (markdown-ensure-blank-line-before)
4265 (set-marker beg-marker (point))
4266 ;; Insert PREFIX before each line
4267 (goto-char beg-marker)
4268 (while (and (< (line-beginning-position) end-marker)
4269 (not (eobp)))
4270 ;; Don’t insert trailing whitespace.
4271 (insert (if (eolp) prefix-without-trailing-whitespace prefix))
4272 (forward-line)))))
4274 (defun markdown-blockquote-region (beg end)
4275 "Blockquote the region.
4276 Arguments BEG and END specify the beginning and end of the region."
4277 (interactive "*r")
4278 (markdown-block-region
4279 beg end (concat (markdown-blockquote-indentation
4280 (max (point-min) (1- beg))) "> ")))
4282 (defun markdown-pre-indentation (loc)
4283 "Return string containing necessary whitespace for a pre block at LOC.
4284 Also see `markdown-blockquote-indentation'."
4285 (save-excursion
4286 (goto-char loc)
4287 (let* ((list-level (length (markdown-calculate-list-levels)))
4288 indent)
4289 (dotimes (_ (1+ list-level) indent)
4290 (setq indent (concat indent " "))))))
4292 (defun markdown-insert-pre ()
4293 "Start a preformatted section (or apply to the region).
4294 If Transient Mark mode is on and a region is active, it is marked
4295 as preformatted text."
4296 (interactive)
4297 (if (use-region-p)
4298 (markdown-pre-region (region-beginning) (region-end))
4299 (markdown-ensure-blank-line-before)
4300 (insert (markdown-pre-indentation (point)))
4301 (markdown-ensure-blank-line-after)))
4303 (defun markdown-pre-region (beg end)
4304 "Format the region as preformatted text.
4305 Arguments BEG and END specify the beginning and end of the region."
4306 (interactive "*r")
4307 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg)))))
4308 (markdown-block-region beg end indent)))
4310 (defun markdown-electric-backquote (arg)
4311 "Insert a backquote.
4312 The numeric prefix argument ARG says how many times to repeat the insertion.
4313 Call `markdown-insert-gfm-code-block' interactively
4314 if three backquotes inserted at the beginning of line."
4315 (interactive "*P")
4316 (self-insert-command (prefix-numeric-value arg))
4317 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil))
4318 (replace-match "")
4319 (call-interactively #'markdown-insert-gfm-code-block)))
4321 (defconst markdown-gfm-recognized-languages
4322 ;; To reproduce/update, evaluate the let-form in
4323 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
4324 ;; but with appropriate use of a keyboard macro, indenting and filling it
4325 ;; properly is pretty fast.
4326 '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
4327 "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada"
4328 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer"
4329 "AngelScript" "Ant-Build-System" "ApacheConf" "Apex"
4330 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly"
4331 "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile"
4332 "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax"
4333 "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump"
4334 "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb"
4335 "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
4336 "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
4337 "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript"
4338 "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language"
4339 "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound"
4340 "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump"
4341 "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch"
4342 "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript"
4343 "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild"
4344 "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm"
4345 "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor"
4346 "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth"
4347 "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS"
4348 "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN"
4349 "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass"
4350 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config"
4351 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu"
4352 "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL"
4353 "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML"
4354 "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP"
4355 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC"
4356 "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7"
4357 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON"
4358 "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java"
4359 "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison"
4360 "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout"
4361 "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE"
4362 "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
4363 "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
4364 "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript"
4365 "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB"
4366 "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako"
4367 "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki"
4368 "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah"
4369 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode"
4370 "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL"
4371 "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
4372 "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
4373 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C"
4374 "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal"
4375 "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript"
4376 "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox"
4377 "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus"
4378 "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn"
4379 "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod"
4380 "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell"
4381 "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer"
4382 "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
4383 "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc"
4384 "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket"
4385 "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol"
4386 "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript"
4387 "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage"
4388 "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
4389 "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass"
4390 "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
4391 "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity"
4392 "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark"
4393 "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift"
4394 "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh"
4395 "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle"
4396 "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
4397 "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL"
4398 "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue"
4399 "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly"
4400 "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok"
4401 "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap"
4402 "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS"
4403 "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL"
4404 "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors"
4405 "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc"
4406 "reStructuredText" "sed" "wdl" "wisp" "xBase")
4407 "Language specifiers recognized by GitHub's syntax highlighting features.")
4409 (defvar-local markdown-gfm-used-languages nil
4410 "Language names used in GFM code blocks.")
4412 (defun markdown-trim-whitespace (str)
4413 (replace-regexp-in-string
4414 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str))
4416 (defun markdown-clean-language-string (str)
4417 (replace-regexp-in-string
4418 "{\\.?\\|}" "" (markdown-trim-whitespace str)))
4420 (defun markdown-validate-language-string (widget)
4421 (let ((str (widget-value widget)))
4422 (unless (string= str (markdown-clean-language-string str))
4423 (widget-put widget :error (format "Invalid language spec: '%s'" str))
4424 widget)))
4426 (defun markdown-gfm-get-corpus ()
4427 "Create corpus of recognized GFM code block languages for the given buffer."
4428 (let ((given-corpus (append markdown-gfm-additional-languages
4429 markdown-gfm-recognized-languages)))
4430 (append
4431 markdown-gfm-used-languages
4432 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus)
4433 given-corpus))))
4435 (defun markdown-gfm-add-used-language (lang)
4436 "Clean LANG and add to list of used languages."
4437 (setq markdown-gfm-used-languages
4438 (cons lang (remove lang markdown-gfm-used-languages))))
4440 (defcustom markdown-spaces-after-code-fence 1
4441 "Number of space characters to insert after a code fence.
4442 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
4443 opening code fence and an info string."
4444 :group 'markdown
4445 :type 'integer
4446 :safe #'natnump
4447 :package-version '(markdown-mode . "2.3"))
4449 (defcustom markdown-code-block-braces nil
4450 "When non-nil, automatically insert braces for GFM code blocks."
4451 :group 'markdown
4452 :type 'boolean)
4454 (defun markdown-insert-gfm-code-block (&optional lang edit)
4455 "Insert GFM code block for language LANG.
4456 If LANG is nil, the language will be queried from user. If a
4457 region is active, wrap this region with the markup instead. If
4458 the region boundaries are not on empty lines, these are added
4459 automatically in order to have the correct markup. When EDIT is
4460 non-nil (e.g., when \\[universal-argument] is given), edit the
4461 code block in an indirect buffer after insertion."
4462 (interactive
4463 (list (let ((completion-ignore-case nil))
4464 (condition-case nil
4465 (markdown-clean-language-string
4466 (completing-read
4467 "Programming language: "
4468 (markdown-gfm-get-corpus)
4469 nil 'confirm (car markdown-gfm-used-languages)
4470 'markdown-gfm-language-history))
4471 (quit "")))
4472 current-prefix-arg))
4473 (unless (string= lang "") (markdown-gfm-add-used-language lang))
4474 (when (and (> (length lang) 0)
4475 (not markdown-code-block-braces))
4476 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s)
4477 lang)))
4478 (let ((gfm-open-brace (if markdown-code-block-braces "{" ""))
4479 (gfm-close-brace (if markdown-code-block-braces "}" "")))
4480 (if (use-region-p)
4481 (let* ((b (region-beginning)) (e (region-end)) end
4482 (indent (progn (goto-char b) (current-indentation))))
4483 (goto-char e)
4484 ;; if we're on a blank line, don't newline, otherwise the ```
4485 ;; should go on its own line
4486 (unless (looking-back "\n" nil)
4487 (newline))
4488 (indent-to indent)
4489 (insert "```")
4490 (markdown-ensure-blank-line-after)
4491 (setq end (point))
4492 (goto-char b)
4493 ;; if we're on a blank line, insert the quotes here, otherwise
4494 ;; add a new line first
4495 (unless (looking-at-p "\n")
4496 (newline)
4497 (forward-line -1))
4498 (markdown-ensure-blank-line-before)
4499 (indent-to indent)
4500 (insert "```" gfm-open-brace lang gfm-close-brace)
4501 (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end))
4502 (let ((indent (current-indentation))
4503 start-bol)
4504 (delete-horizontal-space :backward-only)
4505 (markdown-ensure-blank-line-before)
4506 (indent-to indent)
4507 (setq start-bol (line-beginning-position))
4508 (insert "```" gfm-open-brace lang gfm-close-brace "\n")
4509 (indent-to indent)
4510 (unless edit (insert ?\n))
4511 (indent-to indent)
4512 (insert "```")
4513 (markdown-ensure-blank-line-after)
4514 (markdown-syntax-propertize-fenced-block-constructs start-bol (point)))
4515 (end-of-line 0)
4516 (when edit (markdown-edit-code-block)))))
4518 (defun markdown-code-block-lang (&optional pos-prop)
4519 "Return the language name for a GFM or tilde fenced code block.
4520 The beginning of the block may be described by POS-PROP,
4521 a cons of (pos . prop) giving the position and property
4522 at the beginning of the block."
4523 (or pos-prop
4524 (setq pos-prop
4525 (markdown-max-of-seq
4526 #'car
4527 (cl-remove-if
4528 #'null
4529 (cl-mapcar
4530 #'markdown-find-previous-prop
4531 (markdown-get-fenced-block-begin-properties))))))
4532 (when pos-prop
4533 (goto-char (car pos-prop))
4534 (set-match-data (get-text-property (point) (cdr pos-prop)))
4535 ;; Note: Hard-coded group number assumes tilde
4536 ;; and GFM fenced code regexp groups agree.
4537 (let ((begin (match-beginning 3))
4538 (end (match-end 3)))
4539 (when (and begin end)
4540 ;; Fix language strings beginning with periods, like ".ruby".
4541 (when (eq (char-after begin) ?.)
4542 (setq begin (1+ begin)))
4543 (buffer-substring-no-properties begin end)))))
4545 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer)
4546 (with-current-buffer (or buffer (current-buffer))
4547 (save-excursion
4548 (goto-char (point-min))
4549 (cl-loop
4550 with prop = 'markdown-gfm-block-begin
4551 for pos-prop = (markdown-find-next-prop prop)
4552 while pos-prop
4553 for lang = (markdown-code-block-lang pos-prop)
4554 do (progn (when lang (markdown-gfm-add-used-language lang))
4555 (goto-char (next-single-property-change (point) prop)))))))
4557 (defun markdown-insert-foldable-block ()
4558 "Insert details disclosure element to make content foldable.
4559 If a region is active, wrap this region with the disclosure
4560 element. More detais here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details."
4561 (interactive)
4562 (let ((details-open-tag "<details>")
4563 (details-close-tag "</details>")
4564 (summary-open-tag "<summary>")
4565 (summary-close-tag " </summary>"))
4566 (if (use-region-p)
4567 (let* ((b (region-beginning))
4568 (e (region-end))
4569 (indent (progn (goto-char b) (current-indentation))))
4570 (goto-char e)
4571 ;; if we're on a blank line, don't newline, otherwise the tags
4572 ;; should go on its own line
4573 (unless (looking-back "\n" nil)
4574 (newline))
4575 (indent-to indent)
4576 (insert details-close-tag)
4577 (markdown-ensure-blank-line-after)
4578 (goto-char b)
4579 ;; if we're on a blank line, insert the quotes here, otherwise
4580 ;; add a new line first
4581 (unless (looking-at-p "\n")
4582 (newline)
4583 (forward-line -1))
4584 (markdown-ensure-blank-line-before)
4585 (indent-to indent)
4586 (insert details-open-tag "\n")
4587 (insert summary-open-tag summary-close-tag)
4588 (search-backward summary-close-tag))
4589 (let ((indent (current-indentation)))
4590 (delete-horizontal-space :backward-only)
4591 (markdown-ensure-blank-line-before)
4592 (indent-to indent)
4593 (insert details-open-tag "\n")
4594 (insert summary-open-tag summary-close-tag "\n")
4595 (insert details-close-tag)
4596 (indent-to indent)
4597 (markdown-ensure-blank-line-after)
4598 (search-backward summary-close-tag)))))
4601 ;;; Footnotes =================================================================
4603 (defun markdown-footnote-counter-inc ()
4604 "Increment `markdown-footnote-counter' and return the new value."
4605 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet.
4606 (save-excursion
4607 (goto-char (point-min))
4608 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:")
4609 (point-max) t)
4610 (let ((fn (string-to-number (match-string 1))))
4611 (when (> fn markdown-footnote-counter)
4612 (setq markdown-footnote-counter fn))))))
4613 (cl-incf markdown-footnote-counter))
4615 (defun markdown-insert-footnote ()
4616 "Insert footnote with a new number and move point to footnote definition."
4617 (interactive)
4618 (let ((fn (markdown-footnote-counter-inc)))
4619 (insert (format "[^%d]" fn))
4620 (markdown-footnote-text-find-new-location)
4621 (markdown-ensure-blank-line-before)
4622 (unless (markdown-cur-line-blank-p)
4623 (insert "\n"))
4624 (insert (format "[^%d]: " fn))
4625 (markdown-ensure-blank-line-after)))
4627 (defun markdown-footnote-text-find-new-location ()
4628 "Position the point at the proper location for a new footnote text."
4629 (cond
4630 ((eq markdown-footnote-location 'end) (goto-char (point-max)))
4631 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block))
4632 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree))
4633 ((eq markdown-footnote-location 'header) (markdown-end-of-defun))))
4635 (defun markdown-footnote-kill ()
4636 "Kill the footnote at point.
4637 The footnote text is killed (and added to the kill ring), the
4638 footnote marker is deleted. Point has to be either at the
4639 footnote marker or in the footnote text."
4640 (interactive)
4641 (let ((marker-pos nil)
4642 (skip-deleting-marker nil)
4643 (starting-footnote-text-positions
4644 (markdown-footnote-text-positions)))
4645 (when starting-footnote-text-positions
4646 ;; We're starting in footnote text, so mark our return position and jump
4647 ;; to the marker if possible.
4648 (let ((marker-pos (markdown-footnote-find-marker
4649 (cl-first starting-footnote-text-positions))))
4650 (if marker-pos
4651 (goto-char (1- marker-pos))
4652 ;; If there isn't a marker, we still want to kill the text.
4653 (setq skip-deleting-marker t))))
4654 ;; Either we didn't start in the text, or we started in the text and jumped
4655 ;; to the marker. We want to assume we're at the marker now and error if
4656 ;; we're not.
4657 (unless skip-deleting-marker
4658 (let ((marker (markdown-footnote-delete-marker)))
4659 (unless marker
4660 (error "Not at a footnote"))
4661 ;; Even if we knew the text position before, it changed when we deleted
4662 ;; the label.
4663 (setq marker-pos (cl-second marker))
4664 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker))))
4665 (unless new-text-pos
4666 (error "No text for footnote `%s'" (cl-first marker)))
4667 (goto-char new-text-pos))))
4668 (let ((pos (markdown-footnote-kill-text)))
4669 (goto-char (if starting-footnote-text-positions
4671 marker-pos)))))
4673 (defun markdown-footnote-delete-marker ()
4674 "Delete a footnote marker at point.
4675 Returns a list (ID START) containing the footnote ID and the
4676 start position of the marker before deletion. If no footnote
4677 marker was deleted, this function returns NIL."
4678 (let ((marker (markdown-footnote-marker-positions)))
4679 (when marker
4680 (delete-region (cl-second marker) (cl-third marker))
4681 (butlast marker))))
4683 (defun markdown-footnote-kill-text ()
4684 "Kill footnote text at point.
4685 Returns the start position of the footnote text before deletion,
4686 or NIL if point was not inside a footnote text.
4688 The killed text is placed in the kill ring (without the footnote
4689 number)."
4690 (let ((fn (markdown-footnote-text-positions)))
4691 (when fn
4692 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn))))
4693 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text)
4694 (kill-new (match-string 1 text))
4695 (when (and (markdown-cur-line-blank-p)
4696 (markdown-prev-line-blank-p)
4697 (not (bobp)))
4698 (delete-region (1- (point)) (point)))
4699 (cl-second fn)))))
4701 (defun markdown-footnote-goto-text ()
4702 "Jump to the text of the footnote at point."
4703 (interactive)
4704 (let ((fn (car (markdown-footnote-marker-positions))))
4705 (unless fn
4706 (user-error "Not at a footnote marker"))
4707 (let ((new-pos (markdown-footnote-find-text fn)))
4708 (unless new-pos
4709 (error "No definition found for footnote `%s'" fn))
4710 (goto-char new-pos))))
4712 (defun markdown-footnote-return ()
4713 "Return from a footnote to its footnote number in the main text."
4714 (interactive)
4715 (let ((fn (save-excursion
4716 (car (markdown-footnote-text-positions)))))
4717 (unless fn
4718 (user-error "Not in a footnote"))
4719 (let ((new-pos (markdown-footnote-find-marker fn)))
4720 (unless new-pos
4721 (error "Footnote marker `%s' not found" fn))
4722 (goto-char new-pos))))
4724 (defun markdown-footnote-find-marker (id)
4725 "Find the location of the footnote marker with ID.
4726 The actual buffer position returned is the position directly
4727 following the marker's closing bracket. If no marker is found,
4728 NIL is returned."
4729 (save-excursion
4730 (goto-char (point-min))
4731 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t)
4732 (skip-chars-backward "^]")
4733 (point))))
4735 (defun markdown-footnote-find-text (id)
4736 "Find the location of the text of footnote ID.
4737 The actual buffer position returned is the position of the first
4738 character of the text, after the footnote's identifier. If no
4739 footnote text is found, NIL is returned."
4740 (save-excursion
4741 (goto-char (point-min))
4742 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t)
4743 (skip-chars-forward "[ \t]")
4744 (point))))
4746 (defun markdown-footnote-marker-positions ()
4747 "Return the position and ID of the footnote marker point is on.
4748 The return value is a list (ID START END). If point is not on a
4749 footnote, NIL is returned."
4750 ;; first make sure we're at a footnote marker
4751 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position))
4752 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]")))
4753 (save-excursion
4754 ;; move point between [ and ^:
4755 (if (looking-at-p "\\[")
4756 (forward-char 1)
4757 (skip-chars-backward "^["))
4758 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]"))
4759 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
4761 (defun markdown-footnote-text-positions ()
4762 "Return the start and end positions of the footnote text point is in.
4763 The exact return value is a list of three elements: (ID START END).
4764 The start position is the position of the opening bracket
4765 of the footnote id. The end position is directly after the
4766 newline that ends the footnote. If point is not in a footnote,
4767 NIL is returned instead."
4768 (save-excursion
4769 (let (result)
4770 (move-beginning-of-line 1)
4771 ;; Try to find the label. If we haven't found the label and we're at a blank
4772 ;; or indented line, back up if possible.
4773 (while (and
4774 (not (and (looking-at markdown-regex-footnote-definition)
4775 (setq result (list (match-string 1) (point)))))
4776 (and (not (bobp))
4777 (or (markdown-cur-line-blank-p)
4778 (>= (current-indentation) 4))))
4779 (forward-line -1))
4780 (when result
4781 ;; Advance if there is a next line that is either blank or indented.
4782 ;; (Need to check if we're on the last line, because
4783 ;; markdown-next-line-blank-p returns true for last line in buffer.)
4784 (while (and (/= (line-end-position) (point-max))
4785 (or (markdown-next-line-blank-p)
4786 (>= (markdown-next-line-indent) 4)))
4787 (forward-line))
4788 ;; Move back while the current line is blank.
4789 (while (markdown-cur-line-blank-p)
4790 (forward-line -1))
4791 ;; Advance to capture this line and a single trailing newline (if there
4792 ;; is one).
4793 (forward-line)
4794 (append result (list (point)))))))
4796 (defun markdown-get-defined-footnotes ()
4797 "Return a list of all defined footnotes.
4798 Result is an alist of pairs (MARKER . LINE), where MARKER is the
4799 footnote marker, a string, and LINE is the line number containing
4800 the footnote definition.
4802 For example, suppose the following footnotes are defined at positions
4803 448 and 475:
4805 \[^1]: First footnote here.
4806 \[^marker]: Second footnote.
4808 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
4809 (save-excursion
4810 (goto-char (point-min))
4811 (let (footnotes)
4812 (while (markdown-search-until-condition
4813 (lambda () (and (not (markdown-code-block-at-point-p))
4814 (not (markdown-inline-code-at-point-p))
4815 (not (markdown-in-comment-p))))
4816 markdown-regex-footnote-definition nil t)
4817 (let ((marker (match-string-no-properties 1))
4818 (pos (match-beginning 0)))
4819 (unless (zerop (length marker))
4820 (cl-pushnew (cons marker pos) footnotes :test #'equal))))
4821 (reverse footnotes))))
4824 ;;; Element Removal ===========================================================
4826 (defun markdown-kill-thing-at-point ()
4827 "Kill thing at point and add important text, without markup, to kill ring.
4828 Possible things to kill include (roughly in order of precedence):
4829 inline code, headers, horizontal rules, links (add link text to
4830 kill ring), images (add alt text to kill ring), angle uri, email
4831 addresses, bold, italics, reference definition (add URI to kill
4832 ring), footnote markers and text (kill both marker and text, add
4833 text to kill ring), and list items."
4834 (interactive "*")
4835 (let (val)
4836 (cond
4837 ;; Inline code
4838 ((markdown-inline-code-at-point)
4839 (kill-new (match-string 2))
4840 (delete-region (match-beginning 0) (match-end 0)))
4841 ;; ATX header
4842 ((thing-at-point-looking-at markdown-regex-header-atx)
4843 (kill-new (match-string 2))
4844 (delete-region (match-beginning 0) (match-end 0)))
4845 ;; Setext header
4846 ((thing-at-point-looking-at markdown-regex-header-setext)
4847 (kill-new (match-string 1))
4848 (delete-region (match-beginning 0) (match-end 0)))
4849 ;; Horizontal rule
4850 ((thing-at-point-looking-at markdown-regex-hr)
4851 (kill-new (match-string 0))
4852 (delete-region (match-beginning 0) (match-end 0)))
4853 ;; Inline link or image (add link or alt text to kill ring)
4854 ((thing-at-point-looking-at markdown-regex-link-inline)
4855 (kill-new (match-string 3))
4856 (delete-region (match-beginning 0) (match-end 0)))
4857 ;; Reference link or image (add link or alt text to kill ring)
4858 ((thing-at-point-looking-at markdown-regex-link-reference)
4859 (kill-new (match-string 3))
4860 (delete-region (match-beginning 0) (match-end 0)))
4861 ;; Angle URI (add URL to kill ring)
4862 ((thing-at-point-looking-at markdown-regex-angle-uri)
4863 (kill-new (match-string 2))
4864 (delete-region (match-beginning 0) (match-end 0)))
4865 ;; Email address in angle brackets (add email address to kill ring)
4866 ((thing-at-point-looking-at markdown-regex-email)
4867 (kill-new (match-string 1))
4868 (delete-region (match-beginning 0) (match-end 0)))
4869 ;; Wiki link (add alias text to kill ring)
4870 ((and markdown-enable-wiki-links
4871 (thing-at-point-looking-at markdown-regex-wiki-link))
4872 (kill-new (markdown-wiki-link-alias))
4873 (delete-region (match-beginning 1) (match-end 1)))
4874 ;; Bold
4875 ((thing-at-point-looking-at markdown-regex-bold)
4876 (kill-new (match-string 4))
4877 (delete-region (match-beginning 2) (match-end 2)))
4878 ;; Italics
4879 ((thing-at-point-looking-at markdown-regex-italic)
4880 (kill-new (match-string 3))
4881 (delete-region (match-beginning 1) (match-end 1)))
4882 ;; Strikethrough
4883 ((thing-at-point-looking-at markdown-regex-strike-through)
4884 (kill-new (match-string 4))
4885 (delete-region (match-beginning 2) (match-end 2)))
4886 ;; Footnote marker (add footnote text to kill ring)
4887 ((thing-at-point-looking-at markdown-regex-footnote)
4888 (markdown-footnote-kill))
4889 ;; Footnote text (add footnote text to kill ring)
4890 ((setq val (markdown-footnote-text-positions))
4891 (markdown-footnote-kill))
4892 ;; Reference definition (add URL to kill ring)
4893 ((thing-at-point-looking-at markdown-regex-reference-definition)
4894 (kill-new (match-string 5))
4895 (delete-region (match-beginning 0) (match-end 0)))
4896 ;; List item
4897 ((setq val (markdown-cur-list-item-bounds))
4898 (kill-new (delete-and-extract-region (cl-first val) (cl-second val))))
4900 (user-error "Nothing found at point to kill")))))
4902 (defun markdown-kill-outline ()
4903 "Kill visible heading and add it to `kill-ring'."
4904 (interactive)
4905 (save-excursion
4906 (markdown-outline-previous)
4907 (kill-region (point) (progn (markdown-outline-next) (point)))))
4909 (defun markdown-kill-block ()
4910 "Kill visible code block, list item, or blockquote and add it to `kill-ring'."
4911 (interactive)
4912 (save-excursion
4913 (markdown-backward-block)
4914 (kill-region (point) (progn (markdown-forward-block) (point)))))
4917 ;;; Indentation ===============================================================
4919 (defun markdown-indent-find-next-position (cur-pos positions)
4920 "Return the position after the index of CUR-POS in POSITIONS.
4921 Positions are calculated by `markdown-calc-indents'."
4922 (while (and positions
4923 (not (equal cur-pos (car positions))))
4924 (setq positions (cdr positions)))
4925 (or (cadr positions) 0))
4927 (defun markdown-outdent-find-next-position (cur-pos positions)
4928 "Return the maximal element that precedes CUR-POS from POSITIONS.
4929 Positions are calculated by `markdown-calc-indents'."
4930 (let ((result 0))
4931 (dolist (i positions)
4932 (when (< i cur-pos)
4933 (setq result (max result i))))
4934 result))
4936 (defun markdown-indent-line ()
4937 "Indent the current line using some heuristics.
4938 If the _previous_ command was either `markdown-enter-key' or
4939 `markdown-cycle', then we should cycle to the next
4940 reasonable indentation position. Otherwise, we could have been
4941 called directly by `markdown-enter-key', by an initial call of
4942 `markdown-cycle', or indirectly by `auto-fill-mode'. In
4943 these cases, indent to the default position.
4944 Positions are calculated by `markdown-calc-indents'."
4945 (interactive)
4946 (let ((positions (markdown-calc-indents))
4947 (point-pos (current-column))
4948 (_ (back-to-indentation))
4949 (cur-pos (current-column)))
4950 (if (not (equal this-command 'markdown-cycle))
4951 (indent-line-to (car positions))
4952 (setq positions (sort (delete-dups positions) '<))
4953 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions))
4954 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0)))
4955 (indent-line-to next-pos)
4956 (move-to-column new-point-pos)))))
4958 (defun markdown-calc-indents ()
4959 "Return a list of indentation columns to cycle through.
4960 The first element in the returned list should be considered the
4961 default indentation level. This function does not worry about
4962 duplicate positions, which are handled up by calling functions."
4963 (let (pos prev-line-pos positions)
4965 ;; Indentation of previous line
4966 (setq prev-line-pos (markdown-prev-line-indent))
4967 (setq positions (cons prev-line-pos positions))
4969 ;; Indentation of previous non-list-marker text
4970 (when (setq pos (save-excursion
4971 (forward-line -1)
4972 (when (looking-at markdown-regex-list)
4973 (- (match-end 3) (match-beginning 0)))))
4974 (setq positions (cons pos positions)))
4976 ;; Indentation required for a pre block in current context
4977 (setq pos (length (markdown-pre-indentation (point))))
4978 (setq positions (cons pos positions))
4980 ;; Indentation of the previous line + tab-width
4981 (if prev-line-pos
4982 (setq positions (cons (+ prev-line-pos tab-width) positions))
4983 (setq positions (cons tab-width positions)))
4985 ;; Indentation of the previous line - tab-width
4986 (if (and prev-line-pos (> prev-line-pos tab-width))
4987 (setq positions (cons (- prev-line-pos tab-width) positions)))
4989 ;; Indentation of all preceding list markers (when in a list)
4990 (when (setq pos (markdown-calculate-list-levels))
4991 (setq positions (append pos positions)))
4993 ;; First column
4994 (setq positions (cons 0 positions))
4996 ;; Return reversed list
4997 (reverse positions)))
4999 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent
5000 "Handle RET depending on the context.
5001 If the point is at a table, move to the next row. Otherwise,
5002 indent according to value of `markdown-indent-on-enter'.
5003 When it is nil, simply call `newline'. Otherwise, indent the next line
5004 following RET using `markdown-indent-line'. Furthermore, when it
5005 is set to \\='indent-and-new-item and the point is in a list item,
5006 start a new item with the same indentation. If the point is in an
5007 empty list item, remove it (so that pressing RET twice when in a
5008 list simply adds a blank line)."
5009 (interactive)
5010 (cond
5011 ;; Table
5012 ((markdown-table-at-point-p)
5013 (call-interactively #'markdown-table-next-row))
5014 ;; Indent non-table text
5015 (markdown-indent-on-enter
5016 (let (bounds)
5017 (if (and (memq markdown-indent-on-enter '(indent-and-new-item))
5018 (setq bounds (markdown-cur-list-item-bounds)))
5019 (let ((beg (cl-first bounds))
5020 (end (cl-second bounds))
5021 (length (cl-fourth bounds)))
5022 ;; Point is in a list item
5023 (if (= (- end beg) length)
5024 ;; Delete blank list
5025 (progn
5026 (delete-region beg end)
5027 (newline)
5028 (markdown-indent-line))
5029 (call-interactively #'markdown-insert-list-item)))
5030 ;; Point is not in a list
5031 (newline)
5032 (markdown-indent-line))))
5033 ;; Insert a raw newline
5034 (t (newline))))
5036 (defun markdown-outdent-or-delete (arg)
5037 "Handle BACKSPACE by cycling through indentation points.
5038 When BACKSPACE is pressed, if there is only whitespace
5039 before the current point, then outdent the line one level.
5040 Otherwise, do normal delete by repeating
5041 `backward-delete-char-untabify' ARG times."
5042 (interactive "*p")
5043 (if (use-region-p)
5044 (backward-delete-char-untabify arg)
5045 (let ((cur-pos (current-column))
5046 (start-of-indention (save-excursion
5047 (back-to-indentation)
5048 (current-column)))
5049 (positions (markdown-calc-indents)))
5050 (if (and (> cur-pos 0) (= cur-pos start-of-indention))
5051 (indent-line-to (markdown-outdent-find-next-position cur-pos positions))
5052 (backward-delete-char-untabify arg)))))
5054 (defun markdown-find-leftmost-column (beg end)
5055 "Find the leftmost column in the region from BEG to END."
5056 (let ((mincol 1000))
5057 (save-excursion
5058 (goto-char beg)
5059 (while (< (point) end)
5060 (back-to-indentation)
5061 (unless (looking-at-p "[ \t]*$")
5062 (setq mincol (min mincol (current-column))))
5063 (forward-line 1)
5065 mincol))
5067 (defun markdown-indent-region (beg end arg)
5068 "Indent the region from BEG to END using some heuristics.
5069 When ARG is non-nil, outdent the region instead.
5070 See `markdown-indent-line' and `markdown-indent-line'."
5071 (interactive "*r\nP")
5072 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
5073 (leftmostcol (markdown-find-leftmost-column beg end))
5074 (next-pos (if arg
5075 (markdown-outdent-find-next-position leftmostcol positions)
5076 (markdown-indent-find-next-position leftmostcol positions))))
5077 (indent-rigidly beg end (- next-pos leftmostcol))
5078 (setq deactivate-mark nil)))
5080 (defun markdown-outdent-region (beg end)
5081 "Call `markdown-indent-region' on region from BEG to END with prefix."
5082 (interactive "*r")
5083 (markdown-indent-region beg end t))
5085 (defun markdown--indent-region (start end)
5086 (let ((deactivate-mark nil))
5087 (save-excursion
5088 (goto-char end)
5089 (setq end (point-marker))
5090 (goto-char start)
5091 (when (bolp)
5092 (forward-line 1))
5093 (while (< (point) end)
5094 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp)))
5095 (indent-according-to-mode))
5096 (forward-line 1))
5097 (move-marker end nil))))
5100 ;;; Markup Completion =========================================================
5102 (defconst markdown-complete-alist
5103 '((markdown-regex-header-atx . markdown-complete-atx)
5104 (markdown-regex-header-setext . markdown-complete-setext)
5105 (markdown-regex-hr . markdown-complete-hr))
5106 "Association list of form (regexp . function) for markup completion.")
5108 (defun markdown-incomplete-atx-p ()
5109 "Return t if ATX header markup is incomplete and nil otherwise.
5110 Assumes match data is available for `markdown-regex-header-atx'.
5111 Checks that the number of trailing hash marks equals the number of leading
5112 hash marks, that there is only a single space before and after the text,
5113 and that there is no extraneous whitespace in the text."
5115 ;; Number of starting and ending hash marks differs
5116 (not (= (length (match-string 1)) (length (match-string 3))))
5117 ;; When the header text is not empty...
5118 (and (> (length (match-string 2)) 0)
5119 ;; ...if there are extra leading, trailing, or interior spaces
5120 (or (not (= (match-beginning 2) (1+ (match-end 1))))
5121 (not (= (match-beginning 3) (1+ (match-end 2))))
5122 (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
5123 ;; When the header text is empty...
5124 (and (= (length (match-string 2)) 0)
5125 ;; ...if there are too many or too few spaces
5126 (not (= (match-beginning 3) (+ (match-end 1) 2))))))
5128 (defun markdown-complete-atx ()
5129 "Complete and normalize ATX headers.
5130 Add or remove hash marks to the end of the header to match the
5131 beginning. Ensure that there is only a single space between hash
5132 marks and header text. Removes extraneous whitespace from header text.
5133 Assumes match data is available for `markdown-regex-header-atx'.
5134 Return nil if markup was complete and non-nil if markup was completed."
5135 (when (markdown-incomplete-atx-p)
5136 (let* ((new-marker (make-marker))
5137 (new-marker (set-marker new-marker (match-end 2))))
5138 ;; Hash marks and spacing at end
5139 (goto-char (match-end 2))
5140 (delete-region (match-end 2) (match-end 3))
5141 (insert " " (match-string 1))
5142 ;; Remove extraneous whitespace from title
5143 (replace-match (markdown-compress-whitespace-string (match-string 2))
5144 t t nil 2)
5145 ;; Spacing at beginning
5146 (goto-char (match-end 1))
5147 (delete-region (match-end 1) (match-beginning 2))
5148 (insert " ")
5149 ;; Leave point at end of text
5150 (goto-char new-marker))))
5152 (defun markdown-incomplete-setext-p ()
5153 "Return t if setext header markup is incomplete and nil otherwise.
5154 Assumes match data is available for `markdown-regex-header-setext'.
5155 Checks that length of underline matches text and that there is no
5156 extraneous whitespace in the text."
5157 (or (not (= (length (match-string 1)) (length (match-string 2))))
5158 (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
5160 (defun markdown-complete-setext ()
5161 "Complete and normalize setext headers.
5162 Add or remove underline characters to match length of header
5163 text. Removes extraneous whitespace from header text. Assumes
5164 match data is available for `markdown-regex-header-setext'.
5165 Return nil if markup was complete and non-nil if markup was completed."
5166 (when (markdown-incomplete-setext-p)
5167 (let* ((text (markdown-compress-whitespace-string (match-string 1)))
5168 (char (char-after (match-beginning 2)))
5169 (level (if (char-equal char ?-) 2 1)))
5170 (goto-char (match-beginning 0))
5171 (delete-region (match-beginning 0) (match-end 0))
5172 (markdown-insert-header level text t)
5173 t)))
5175 (defun markdown-incomplete-hr-p ()
5176 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
5177 Assumes match data is available for `markdown-regex-hr'."
5178 (not (member (match-string 0) markdown-hr-strings)))
5180 (defun markdown-complete-hr ()
5181 "Complete horizontal rules.
5182 If horizontal rule string is a member of `markdown-hr-strings',
5183 do nothing. Otherwise, replace with the car of
5184 `markdown-hr-strings'.
5185 Assumes match data is available for `markdown-regex-hr'.
5186 Return nil if markup was complete and non-nil if markup was completed."
5187 (when (markdown-incomplete-hr-p)
5188 (replace-match (car markdown-hr-strings))
5191 (defun markdown-complete ()
5192 "Complete markup of object near point or in region when active.
5193 Handle all objects in `markdown-complete-alist', in order.
5194 See `markdown-complete-at-point' and `markdown-complete-region'."
5195 (interactive "*")
5196 (if (use-region-p)
5197 (markdown-complete-region (region-beginning) (region-end))
5198 (markdown-complete-at-point)))
5200 (defun markdown-complete-at-point ()
5201 "Complete markup of object near point.
5202 Handle all elements of `markdown-complete-alist' in order."
5203 (interactive "*")
5204 (let ((list markdown-complete-alist) found changed)
5205 (while list
5206 (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'?
5207 (function (cdar list)))
5208 (setq list (cdr list))
5209 (when (thing-at-point-looking-at regexp)
5210 (setq found t)
5211 (setq changed (funcall function))
5212 (setq list nil))))
5213 (if found
5214 (or changed (user-error "Markup at point is complete"))
5215 (user-error "Nothing to complete at point"))))
5217 (defun markdown-complete-region (beg end)
5218 "Complete markup of objects in region from BEG to END.
5219 Handle all objects in `markdown-complete-alist', in order. Each
5220 match is checked to ensure that a previous regexp does not also
5221 match."
5222 (interactive "*r")
5223 (let ((end-marker (set-marker (make-marker) end))
5224 previous)
5225 (dolist (element markdown-complete-alist)
5226 (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'?
5227 (function (cdr element)))
5228 (goto-char beg)
5229 (while (re-search-forward regexp end-marker 'limit)
5230 (when (match-string 0)
5231 ;; Make sure this is not a match for any of the preceding regexps.
5232 ;; This prevents mistaking an HR for a Setext subheading.
5233 (let (match)
5234 (save-match-data
5235 (dolist (prev-regexp previous)
5236 (or match (setq match (looking-back prev-regexp nil)))))
5237 (unless match
5238 (save-excursion (funcall function))))))
5239 (cl-pushnew regexp previous :test #'equal)))
5240 previous))
5242 (defun markdown-complete-buffer ()
5243 "Complete markup for all objects in the current buffer."
5244 (interactive "*")
5245 (markdown-complete-region (point-min) (point-max)))
5248 ;;; Markup Cycling ============================================================
5250 (defun markdown-cycle-atx (arg &optional remove)
5251 "Cycle ATX header markup.
5252 Promote header (decrease level) when ARG is 1 and demote
5253 header (increase level) if arg is -1. When REMOVE is non-nil,
5254 remove the header when the level reaches zero and stop cycling
5255 when it reaches six. Otherwise, perform a proper cycling through
5256 levels one through six. Assumes match data is available for
5257 `markdown-regex-header-atx'."
5258 (let* ((old-level (length (match-string 1)))
5259 (new-level (+ old-level arg))
5260 (text (match-string 2)))
5261 (when (not remove)
5262 (setq new-level (% new-level 6))
5263 (setq new-level (cond ((= new-level 0) 6)
5264 ((< new-level 0) (+ new-level 6))
5265 (t new-level))))
5266 (cond
5267 ((= new-level 0)
5268 (markdown-unwrap-thing-at-point nil 0 2))
5269 ((<= new-level 6)
5270 (goto-char (match-beginning 0))
5271 (delete-region (match-beginning 0) (match-end 0))
5272 (markdown-insert-header new-level text nil)))))
5274 (defun markdown-cycle-setext (arg &optional remove)
5275 "Cycle setext header markup.
5276 Promote header (increase level) when ARG is 1 and demote
5277 header (decrease level or remove) if arg is -1. When demoting a
5278 level-two setext header, replace with a level-three atx header.
5279 When REMOVE is non-nil, remove the header when the level reaches
5280 zero. Otherwise, cycle back to a level six atx header. Assumes
5281 match data is available for `markdown-regex-header-setext'."
5282 (let* ((char (char-after (match-beginning 2)))
5283 (old-level (if (char-equal char ?=) 1 2))
5284 (new-level (+ old-level arg)))
5285 (when (and (not remove) (= new-level 0))
5286 (setq new-level 6))
5287 (cond
5288 ((= new-level 0)
5289 (markdown-unwrap-thing-at-point nil 0 1))
5290 ((<= new-level 2)
5291 (markdown-insert-header new-level nil t))
5292 ((<= new-level 6)
5293 (markdown-insert-header new-level nil nil)))))
5295 (defun markdown-cycle-hr (arg &optional remove)
5296 "Cycle string used for horizontal rule from `markdown-hr-strings'.
5297 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
5298 backwards (promote). When REMOVE is non-nil, remove the hr instead
5299 of cycling when the end of the list is reached.
5300 Assumes match data is available for `markdown-regex-hr'."
5301 (let* ((strings (if (= arg -1)
5302 (reverse markdown-hr-strings)
5303 markdown-hr-strings))
5304 (tail (member (match-string 0) strings))
5305 (new (or (cadr tail)
5306 (if remove
5307 (if (= arg 1)
5309 (car tail))
5310 (car strings)))))
5311 (replace-match new)))
5313 (defun markdown-cycle-bold ()
5314 "Cycle bold markup between underscores and asterisks.
5315 Assumes match data is available for `markdown-regex-bold'."
5316 (save-excursion
5317 (let* ((old-delim (match-string 3))
5318 (new-delim (if (string-equal old-delim "**") "__" "**")))
5319 (replace-match new-delim t t nil 3)
5320 (replace-match new-delim t t nil 5))))
5322 (defun markdown-cycle-italic ()
5323 "Cycle italic markup between underscores and asterisks.
5324 Assumes match data is available for `markdown-regex-italic'."
5325 (save-excursion
5326 (let* ((old-delim (match-string 2))
5327 (new-delim (if (string-equal old-delim "*") "_" "*")))
5328 (replace-match new-delim t t nil 2)
5329 (replace-match new-delim t t nil 4))))
5332 ;;; Keymap ====================================================================
5334 (defun markdown--style-map-prompt ()
5335 "Return a formatted prompt for Markdown markup insertion."
5336 (when markdown-enable-prefix-prompts
5337 (concat
5338 "Markdown: "
5339 (propertize "bold" 'face 'markdown-bold-face) ", "
5340 (propertize "italic" 'face 'markdown-italic-face) ", "
5341 (propertize "code" 'face 'markdown-inline-code-face) ", "
5342 (propertize "C = GFM code" 'face 'markdown-code-face) ", "
5343 (propertize "pre" 'face 'markdown-pre-face) ", "
5344 (propertize "footnote" 'face 'markdown-footnote-text-face) ", "
5345 (propertize "F = foldable" 'face 'markdown-bold-face) ", "
5346 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", "
5347 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", "
5348 (propertize "- = hr" 'face 'markdown-hr-face) ", "
5349 "C-h = more")))
5351 (defun markdown--command-map-prompt ()
5352 "Return prompt for Markdown buffer-wide commands."
5353 (when markdown-enable-prefix-prompts
5354 (concat
5355 "Command: "
5356 (propertize "m" 'face 'markdown-bold-face) "arkdown, "
5357 (propertize "p" 'face 'markdown-bold-face) "review, "
5358 (propertize "o" 'face 'markdown-bold-face) "pen, "
5359 (propertize "e" 'face 'markdown-bold-face) "xport, "
5360 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, "
5361 (propertize "c" 'face 'markdown-bold-face) "heck refs, "
5362 (propertize "u" 'face 'markdown-bold-face) "nused refs, "
5363 "C-h = more")))
5365 (defvar markdown-mode-style-map
5366 (let ((map (make-keymap (markdown--style-map-prompt))))
5367 (define-key map (kbd "1") 'markdown-insert-header-atx-1)
5368 (define-key map (kbd "2") 'markdown-insert-header-atx-2)
5369 (define-key map (kbd "3") 'markdown-insert-header-atx-3)
5370 (define-key map (kbd "4") 'markdown-insert-header-atx-4)
5371 (define-key map (kbd "5") 'markdown-insert-header-atx-5)
5372 (define-key map (kbd "6") 'markdown-insert-header-atx-6)
5373 (define-key map (kbd "!") 'markdown-insert-header-setext-1)
5374 (define-key map (kbd "@") 'markdown-insert-header-setext-2)
5375 (define-key map (kbd "b") 'markdown-insert-bold)
5376 (define-key map (kbd "c") 'markdown-insert-code)
5377 (define-key map (kbd "C") 'markdown-insert-gfm-code-block)
5378 (define-key map (kbd "f") 'markdown-insert-footnote)
5379 (define-key map (kbd "F") 'markdown-insert-foldable-block)
5380 (define-key map (kbd "h") 'markdown-insert-header-dwim)
5381 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim)
5382 (define-key map (kbd "i") 'markdown-insert-italic)
5383 (define-key map (kbd "k") 'markdown-insert-kbd)
5384 (define-key map (kbd "l") 'markdown-insert-link)
5385 (define-key map (kbd "p") 'markdown-insert-pre)
5386 (define-key map (kbd "P") 'markdown-pre-region)
5387 (define-key map (kbd "q") 'markdown-insert-blockquote)
5388 (define-key map (kbd "s") 'markdown-insert-strike-through)
5389 (define-key map (kbd "t") 'markdown-insert-table)
5390 (define-key map (kbd "Q") 'markdown-blockquote-region)
5391 (define-key map (kbd "w") 'markdown-insert-wiki-link)
5392 (define-key map (kbd "-") 'markdown-insert-hr)
5393 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox)
5394 ;; Deprecated keys that may be removed in a future version
5395 (define-key map (kbd "e") 'markdown-insert-italic)
5396 map)
5397 "Keymap for Markdown text styling commands.")
5399 (defvar markdown-mode-command-map
5400 (let ((map (make-keymap (markdown--command-map-prompt))))
5401 (define-key map (kbd "m") 'markdown-other-window)
5402 (define-key map (kbd "p") 'markdown-preview)
5403 (define-key map (kbd "e") 'markdown-export)
5404 (define-key map (kbd "v") 'markdown-export-and-preview)
5405 (define-key map (kbd "o") 'markdown-open)
5406 (define-key map (kbd "l") 'markdown-live-preview-mode)
5407 (define-key map (kbd "w") 'markdown-kill-ring-save)
5408 (define-key map (kbd "c") 'markdown-check-refs)
5409 (define-key map (kbd "u") 'markdown-unused-refs)
5410 (define-key map (kbd "n") 'markdown-cleanup-list-numbers)
5411 (define-key map (kbd "]") 'markdown-complete-buffer)
5412 (define-key map (kbd "^") 'markdown-table-sort-lines)
5413 (define-key map (kbd "|") 'markdown-table-convert-region)
5414 (define-key map (kbd "t") 'markdown-table-transpose)
5415 map)
5416 "Keymap for Markdown buffer-wide commands.")
5418 (defvar markdown-mode-map
5419 (let ((map (make-keymap)))
5420 ;; Markup insertion & removal
5421 (define-key map (kbd "C-c C-s") markdown-mode-style-map)
5422 (define-key map (kbd "C-c C-l") 'markdown-insert-link)
5423 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point)
5424 ;; Promotion, demotion, and cycling
5425 (define-key map (kbd "C-c C--") 'markdown-promote)
5426 (define-key map (kbd "C-c C-=") 'markdown-demote)
5427 (define-key map (kbd "C-c C-]") 'markdown-complete)
5428 ;; Following and doing things
5429 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point)
5430 (define-key map (kbd "C-c C-d") 'markdown-do)
5431 (define-key map (kbd "C-c '") 'markdown-edit-code-block)
5432 ;; Indentation
5433 (define-key map (kbd "RET") 'markdown-enter-key)
5434 (define-key map (kbd "DEL") 'markdown-outdent-or-delete)
5435 (define-key map (kbd "C-c >") 'markdown-indent-region)
5436 (define-key map (kbd "C-c <") 'markdown-outdent-region)
5437 ;; Visibility cycling
5438 (define-key map (kbd "TAB") 'markdown-cycle)
5439 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by
5440 ;; (local-)function-key-map.
5441 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
5442 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab)
5443 (define-key map (kbd "<backtab>") 'markdown-shifttab)
5444 ;; Heading and list navigation
5445 (define-key map (kbd "C-c C-n") 'markdown-outline-next)
5446 (define-key map (kbd "C-c C-p") 'markdown-outline-previous)
5447 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level)
5448 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level)
5449 (define-key map (kbd "C-c C-u") 'markdown-outline-up)
5450 ;; Buffer-wide commands
5451 (define-key map (kbd "C-c C-c") markdown-mode-command-map)
5452 ;; Subtree, list, and table editing
5453 (define-key map (kbd "C-c <up>") 'markdown-move-up)
5454 (define-key map (kbd "C-c <down>") 'markdown-move-down)
5455 (define-key map (kbd "C-c <left>") 'markdown-promote)
5456 (define-key map (kbd "C-c <right>") 'markdown-demote)
5457 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row)
5458 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row)
5459 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column)
5460 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column)
5461 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree)
5462 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree)
5463 (define-key map (kbd "M-RET") 'markdown-insert-list-item)
5464 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item)
5465 ;; Paragraphs (Markdown context aware)
5466 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph)
5467 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph)
5468 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph)
5469 ;; Blocks (one or more paragraphs)
5470 (define-key map (kbd "C-M-{") 'markdown-backward-block)
5471 (define-key map (kbd "C-M-}") 'markdown-forward-block)
5472 (define-key map (kbd "C-c M-h") 'markdown-mark-block)
5473 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block)
5474 ;; Pages (top-level sections)
5475 (define-key map [remap backward-page] 'markdown-backward-page)
5476 (define-key map [remap forward-page] 'markdown-forward-page)
5477 (define-key map [remap mark-page] 'markdown-mark-page)
5478 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page)
5479 ;; Link Movement
5480 (define-key map (kbd "M-n") 'markdown-next-link)
5481 (define-key map (kbd "M-p") 'markdown-previous-link)
5482 ;; Toggling functionality
5483 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math)
5484 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively)
5485 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images)
5486 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding)
5487 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding)
5488 ;; Alternative keys (in case of problems with the arrow keys)
5489 (define-key map (kbd "C-c C-x u") 'markdown-move-up)
5490 (define-key map (kbd "C-c C-x d") 'markdown-move-down)
5491 (define-key map (kbd "C-c C-x l") 'markdown-promote)
5492 (define-key map (kbd "C-c C-x r") 'markdown-demote)
5493 ;; Deprecated keys that may be removed in a future version
5494 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l
5495 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l
5496 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l
5497 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l
5498 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote)
5499 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link)
5500 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1)
5501 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2)
5502 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3)
5503 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4)
5504 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5)
5505 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6)
5506 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1)
5507 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2)
5508 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim)
5509 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim)
5510 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2)
5511 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1)
5512 (define-key map (kbd "C-c C-i") 'markdown-insert-image)
5513 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j
5514 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d
5515 (define-key map (kbd "C-c -") 'markdown-insert-hr)
5516 map)
5517 "Keymap for Markdown major mode.")
5519 (defvar markdown-mode-mouse-map
5520 (when markdown-mouse-follow-link
5521 (let ((map (make-sparse-keymap)))
5522 (define-key map [follow-link] 'mouse-face)
5523 (define-key map [mouse-2] #'markdown-follow-thing-at-point)
5524 map))
5525 "Keymap for following links with mouse.")
5527 (defvar gfm-mode-map
5528 (let ((map (make-sparse-keymap)))
5529 (set-keymap-parent map markdown-mode-map)
5530 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through)
5531 (define-key map "`" 'markdown-electric-backquote)
5532 map)
5533 "Keymap for `gfm-mode'.
5534 See also `markdown-mode-map'.")
5537 ;;; Menu ======================================================================
5539 (easy-menu-define markdown-mode-menu markdown-mode-map
5540 "Menu for Markdown mode."
5541 '("Markdown"
5542 "---"
5543 ("Movement"
5544 ["Jump" markdown-do]
5545 ["Follow Link" markdown-follow-thing-at-point]
5546 ["Next Link" markdown-next-link]
5547 ["Previous Link" markdown-previous-link]
5548 "---"
5549 ["Next Heading or List Item" markdown-outline-next]
5550 ["Previous Heading or List Item" markdown-outline-previous]
5551 ["Next at Same Level" markdown-outline-next-same-level]
5552 ["Previous at Same Level" markdown-outline-previous-same-level]
5553 ["Up to Parent" markdown-outline-up]
5554 "---"
5555 ["Forward Paragraph" markdown-forward-paragraph]
5556 ["Backward Paragraph" markdown-backward-paragraph]
5557 ["Forward Block" markdown-forward-block]
5558 ["Backward Block" markdown-backward-block])
5559 ("Show & Hide"
5560 ["Cycle Heading Visibility" markdown-cycle
5561 :enable (markdown-on-heading-p)]
5562 ["Cycle Heading Visibility (Global)" markdown-shifttab]
5563 "---"
5564 ["Narrow to Region" narrow-to-region]
5565 ["Narrow to Block" markdown-narrow-to-block]
5566 ["Narrow to Section" narrow-to-defun]
5567 ["Narrow to Subtree" markdown-narrow-to-subtree]
5568 ["Widen" widen (buffer-narrowed-p)]
5569 "---"
5570 ["Toggle Markup Hiding" markdown-toggle-markup-hiding
5571 :keys "C-c C-x C-m"
5572 :style radio
5573 :selected markdown-hide-markup])
5574 "---"
5575 ("Headings & Structure"
5576 ["Automatic Heading" markdown-insert-header-dwim
5577 :keys "C-c C-s h"]
5578 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
5579 :keys "C-c C-s H"]
5580 ("Specific Heading (atx)"
5581 ["First Level atx" markdown-insert-header-atx-1
5582 :keys "C-c C-s 1"]
5583 ["Second Level atx" markdown-insert-header-atx-2
5584 :keys "C-c C-s 2"]
5585 ["Third Level atx" markdown-insert-header-atx-3
5586 :keys "C-c C-s 3"]
5587 ["Fourth Level atx" markdown-insert-header-atx-4
5588 :keys "C-c C-s 4"]
5589 ["Fifth Level atx" markdown-insert-header-atx-5
5590 :keys "C-c C-s 5"]
5591 ["Sixth Level atx" markdown-insert-header-atx-6
5592 :keys "C-c C-s 6"])
5593 ("Specific Heading (Setext)"
5594 ["First Level Setext" markdown-insert-header-setext-1
5595 :keys "C-c C-s !"]
5596 ["Second Level Setext" markdown-insert-header-setext-2
5597 :keys "C-c C-s @"])
5598 ["Horizontal Rule" markdown-insert-hr
5599 :keys "C-c C-s -"]
5600 "---"
5601 ["Move Subtree Up" markdown-move-up
5602 :keys "C-c <up>"]
5603 ["Move Subtree Down" markdown-move-down
5604 :keys "C-c <down>"]
5605 ["Promote Subtree" markdown-promote
5606 :keys "C-c <left>"]
5607 ["Demote Subtree" markdown-demote
5608 :keys "C-c <right>"])
5609 ("Region & Mark"
5610 ["Indent Region" markdown-indent-region]
5611 ["Outdent Region" markdown-outdent-region]
5612 "--"
5613 ["Mark Paragraph" mark-paragraph]
5614 ["Mark Block" markdown-mark-block]
5615 ["Mark Section" mark-defun]
5616 ["Mark Subtree" markdown-mark-subtree])
5617 ("Tables"
5618 ["Move Row Up" markdown-move-up
5619 :enable (markdown-table-at-point-p)
5620 :keys "C-c <up>"]
5621 ["Move Row Down" markdown-move-down
5622 :enable (markdown-table-at-point-p)
5623 :keys "C-c <down>"]
5624 ["Move Column Left" markdown-promote
5625 :enable (markdown-table-at-point-p)
5626 :keys "C-c <left>"]
5627 ["Move Column Right" markdown-demote
5628 :enable (markdown-table-at-point-p)
5629 :keys "C-c <right>"]
5630 ["Delete Row" markdown-table-delete-row
5631 :enable (markdown-table-at-point-p)]
5632 ["Insert Row" markdown-table-insert-row
5633 :enable (markdown-table-at-point-p)]
5634 ["Delete Column" markdown-table-delete-column
5635 :enable (markdown-table-at-point-p)]
5636 ["Insert Column" markdown-table-insert-column
5637 :enable (markdown-table-at-point-p)]
5638 ["Insert Table" markdown-insert-table]
5639 "--"
5640 ["Convert Region to Table" markdown-table-convert-region]
5641 ["Sort Table Lines" markdown-table-sort-lines
5642 :enable (markdown-table-at-point-p)]
5643 ["Transpose Table" markdown-table-transpose
5644 :enable (markdown-table-at-point-p)])
5645 ("Lists"
5646 ["Insert List Item" markdown-insert-list-item]
5647 ["Move Subtree Up" markdown-move-up
5648 :keys "C-c <up>"]
5649 ["Move Subtree Down" markdown-move-down
5650 :keys "C-c <down>"]
5651 ["Indent Subtree" markdown-demote
5652 :keys "C-c <right>"]
5653 ["Outdent Subtree" markdown-promote
5654 :keys "C-c <left>"]
5655 ["Renumber List" markdown-cleanup-list-numbers]
5656 ["Insert Task List Item" markdown-insert-gfm-checkbox
5657 :keys "C-c C-x ["]
5658 ["Toggle Task List Item" markdown-toggle-gfm-checkbox
5659 :enable (markdown-gfm-task-list-item-at-point)
5660 :keys "C-c C-d"])
5661 ("Links & Images"
5662 ["Insert Link" markdown-insert-link]
5663 ["Insert Image" markdown-insert-image]
5664 ["Insert Footnote" markdown-insert-footnote
5665 :keys "C-c C-s f"]
5666 ["Insert Wiki Link" markdown-insert-wiki-link
5667 :keys "C-c C-s w"]
5668 "---"
5669 ["Check References" markdown-check-refs]
5670 ["Find Unused References" markdown-unused-refs]
5671 ["Toggle URL Hiding" markdown-toggle-url-hiding
5672 :style radio
5673 :selected markdown-hide-urls]
5674 ["Toggle Inline Images" markdown-toggle-inline-images
5675 :keys "C-c C-x C-i"
5676 :style radio
5677 :selected markdown-inline-image-overlays]
5678 ["Toggle Wiki Links" markdown-toggle-wiki-links
5679 :style radio
5680 :selected markdown-enable-wiki-links])
5681 ("Styles"
5682 ["Bold" markdown-insert-bold]
5683 ["Italic" markdown-insert-italic]
5684 ["Code" markdown-insert-code]
5685 ["Strikethrough" markdown-insert-strike-through]
5686 ["Keyboard" markdown-insert-kbd]
5687 "---"
5688 ["Blockquote" markdown-insert-blockquote]
5689 ["Preformatted" markdown-insert-pre]
5690 ["GFM Code Block" markdown-insert-gfm-code-block]
5691 ["Edit Code Block" markdown-edit-code-block
5692 :enable (markdown-code-block-at-point-p)]
5693 ["Foldable Block" markdown-insert-foldable-block]
5694 "---"
5695 ["Blockquote Region" markdown-blockquote-region]
5696 ["Preformatted Region" markdown-pre-region]
5697 "---"
5698 ["Fontify Code Blocks Natively"
5699 markdown-toggle-fontify-code-blocks-natively
5700 :style radio
5701 :selected markdown-fontify-code-blocks-natively]
5702 ["LaTeX Math Support" markdown-toggle-math
5703 :style radio
5704 :selected markdown-enable-math])
5705 "---"
5706 ("Preview & Export"
5707 ["Compile" markdown-other-window]
5708 ["Preview" markdown-preview]
5709 ["Export" markdown-export]
5710 ["Export & View" markdown-export-and-preview]
5711 ["Open" markdown-open]
5712 ["Live Export" markdown-live-preview-mode
5713 :style radio
5714 :selected markdown-live-preview-mode]
5715 ["Kill ring save" markdown-kill-ring-save])
5716 ("Markup Completion and Cycling"
5717 ["Complete Markup" markdown-complete]
5718 ["Promote Element" markdown-promote
5719 :keys "C-c C--"]
5720 ["Demote Element" markdown-demote
5721 :keys "C-c C-="])
5722 "---"
5723 ["Kill Element" markdown-kill-thing-at-point]
5724 "---"
5725 ("Documentation"
5726 ["Version" markdown-show-version]
5727 ["Homepage" markdown-mode-info]
5728 ["Describe Mode" (describe-function 'markdown-mode)]
5729 ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
5732 ;;; imenu =====================================================================
5734 (defun markdown-imenu-create-nested-index ()
5735 "Create and return a nested imenu index alist for the current buffer.
5736 See `imenu-create-index-function' and `imenu--index-alist' for details."
5737 (let* ((root '(nil . nil))
5738 (min-level 9999)
5739 hashes headers)
5740 (save-excursion
5741 ;; Headings
5742 (goto-char (point-min))
5743 (while (re-search-forward markdown-regex-header (point-max) t)
5744 (unless (or (markdown-code-block-at-point-p)
5745 (and (match-beginning 3)
5746 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end)))
5747 (cond
5748 ((match-string-no-properties 2) ;; level 1 setext
5749 (setq min-level 1)
5750 (push (list :heading (match-string-no-properties 1)
5751 :point (match-beginning 1)
5752 :level 1) headers))
5753 ((match-string-no-properties 3) ;; level 2 setext
5754 (setq min-level (min min-level 2))
5755 (push (list :heading (match-string-no-properties 1)
5756 :point (match-beginning 1)
5757 :level (- 2 (1- min-level))) headers))
5758 ((setq hashes (markdown-trim-whitespace
5759 (match-string-no-properties 4)))
5760 (setq min-level (min min-level (length hashes)))
5761 (push (list :heading (match-string-no-properties 5)
5762 :point (match-beginning 4)
5763 :level (- (length hashes) (1- min-level))) headers)))))
5764 (cl-loop with cur-level = 0
5765 with cur-alist = nil
5766 with empty-heading = "-"
5767 with self-heading = "."
5768 for header in (reverse headers)
5769 for level = (plist-get header :level)
5771 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point)))))
5772 (cond
5773 ((= cur-level level) ; new sibling
5774 (setcdr cur-alist alist)
5775 (setq cur-alist alist))
5776 ((< cur-level level) ; first child
5777 (dotimes (_ (- level cur-level 1))
5778 (setq alist (list (cons empty-heading alist))))
5779 (if cur-alist
5780 (let* ((parent (car cur-alist))
5781 (self-pos (cdr parent)))
5782 (setcdr parent (cons (cons self-heading self-pos) alist)))
5783 (setcdr root alist)) ; primogenitor
5784 (setq cur-alist alist)
5785 (setq cur-level level))
5786 (t ; new sibling of an ancestor
5787 (let ((sibling-alist (last (cdr root))))
5788 (dotimes (_ (1- level))
5789 (setq sibling-alist (last (cdar sibling-alist))))
5790 (setcdr sibling-alist alist)
5791 (setq cur-alist alist))
5792 (setq cur-level level)))))
5793 (setq root (copy-tree root))
5794 ;; Footnotes
5795 (let ((fn (markdown-get-defined-footnotes)))
5796 (if (or (zerop (length fn))
5797 (null markdown-add-footnotes-to-imenu))
5798 (cdr root)
5799 (nconc (cdr root) (list (cons "Footnotes" fn))))))))
5801 (defun markdown-imenu-create-flat-index ()
5802 "Create and return a flat imenu index alist for the current buffer.
5803 See `imenu-create-index-function' and `imenu--index-alist' for details."
5804 (let* ((empty-heading "-") index heading pos)
5805 (save-excursion
5806 ;; Headings
5807 (goto-char (point-min))
5808 (while (re-search-forward markdown-regex-header (point-max) t)
5809 (when (and (not (markdown-code-block-at-point-p (line-beginning-position)))
5810 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin)))
5811 (cond
5812 ((setq heading (match-string-no-properties 1))
5813 (setq pos (match-beginning 1)))
5814 ((setq heading (match-string-no-properties 5))
5815 (setq pos (match-beginning 4))))
5816 (or (> (length heading) 0)
5817 (setq heading empty-heading))
5818 (setq index (append index (list (cons heading pos))))))
5819 ;; Footnotes
5820 (when markdown-add-footnotes-to-imenu
5821 (nconc index (markdown-get-defined-footnotes)))
5822 index)))
5825 ;;; References ================================================================
5827 (defun markdown-reference-goto-definition ()
5828 "Jump to the definition of the reference at point or create it."
5829 (interactive)
5830 (when (thing-at-point-looking-at markdown-regex-link-reference)
5831 (let* ((text (match-string-no-properties 3))
5832 (reference (match-string-no-properties 6))
5833 (target (downcase (if (string= reference "") text reference)))
5834 (loc (cadr (save-match-data (markdown-reference-definition target)))))
5835 (if loc
5836 (goto-char loc)
5837 (goto-char (match-beginning 0))
5838 (markdown-insert-reference-definition target)))))
5840 (defun markdown-reference-find-links (reference)
5841 "Return a list of all links for REFERENCE.
5842 REFERENCE should not include the surrounding square brackets.
5843 Elements of the list have the form (text start line), where
5844 text is the link text, start is the location at the beginning of
5845 the link, and line is the line number on which the link appears."
5846 (let* ((ref-quote (regexp-quote reference))
5847 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
5848 ref-quote ref-quote))
5849 links)
5850 (save-excursion
5851 (goto-char (point-min))
5852 (while (re-search-forward regexp nil t)
5853 (let* ((text (or (match-string-no-properties 1)
5854 (match-string-no-properties 2)))
5855 (start (match-beginning 0))
5856 (line (markdown-line-number-at-pos)))
5857 (cl-pushnew (list text start line) links :test #'equal))))
5858 links))
5860 (defmacro markdown-for-all-refs (f)
5861 `(let ((result))
5862 (save-excursion
5863 (goto-char (point-min))
5864 (while
5865 (re-search-forward markdown-regex-link-reference nil t)
5866 (let* ((text (match-string-no-properties 3))
5867 (reference (match-string-no-properties 6))
5868 (target (downcase (if (string= reference "") text reference))))
5869 (,f text target result))))
5870 (reverse result)))
5872 (defmacro markdown-collect-always (_ target result)
5873 `(cl-pushnew ,target ,result :test #'equal))
5875 (defmacro markdown-collect-undefined (text target result)
5876 `(unless (markdown-reference-definition target)
5877 (let ((entry (assoc ,target ,result)))
5878 (if (not entry)
5879 (cl-pushnew
5880 (cons ,target (list (cons ,text (markdown-line-number-at-pos))))
5881 ,result :test #'equal)
5882 (setcdr entry
5883 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos)))))))))
5885 (defun markdown-get-all-refs ()
5886 "Return a list of all Markdown references."
5887 (markdown-for-all-refs markdown-collect-always))
5889 (defun markdown-get-undefined-refs ()
5890 "Return a list of undefined Markdown references.
5891 Result is an alist of pairs (reference . occurrences), where
5892 occurrences is itself another alist of pairs (label . line-number).
5893 For example, an alist corresponding to [Nice editor][Emacs] at line 12,
5894 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
5895 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
5896 (markdown-for-all-refs markdown-collect-undefined))
5898 (defun markdown-get-unused-refs ()
5899 (cl-sort
5900 (cl-set-difference
5901 (markdown-get-defined-references) (markdown-get-all-refs)
5902 :test (lambda (e1 e2) (equal (car e1) e2)))
5903 #'< :key #'cdr))
5905 (defmacro defun-markdown-buffer (name docstring)
5906 "Define a function to name and return a buffer.
5908 By convention, NAME must be a name of a string constant with
5909 %buffer% placeholder used to name the buffer, and will also be
5910 used as a name of the function defined.
5912 DOCSTRING will be used as the first part of the docstring."
5913 `(defun ,name (&optional buffer-name)
5914 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.")
5915 (or buffer-name (setq buffer-name (buffer-name)))
5916 (let ((refbuf (get-buffer-create (replace-regexp-in-string
5917 "%buffer%" buffer-name
5918 ,name))))
5919 (with-current-buffer refbuf
5920 (when view-mode
5921 (View-exit-and-edit))
5922 (use-local-map button-buffer-map)
5923 (erase-buffer))
5924 refbuf)))
5926 (defconst markdown-reference-check-buffer
5927 "*Undefined references for %buffer%*"
5928 "Pattern for name of buffer for listing undefined references.
5929 The string %buffer% will be replaced by the corresponding
5930 `markdown-mode' buffer name.")
5932 (defun-markdown-buffer
5933 markdown-reference-check-buffer
5934 "Name and return buffer for reference checking.")
5936 (defconst markdown-unused-references-buffer
5937 "*Unused references for %buffer%*"
5938 "Pattern for name of buffer for listing unused references.
5939 The string %buffer% will be replaced by the corresponding
5940 `markdown-mode' buffer name.")
5942 (defun-markdown-buffer
5943 markdown-unused-references-buffer
5944 "Name and return buffer for unused reference checking.")
5946 (defconst markdown-reference-links-buffer
5947 "*Reference links for %buffer%*"
5948 "Pattern for name of buffer for listing references.
5949 The string %buffer% will be replaced by the corresponding buffer name.")
5951 (defun-markdown-buffer
5952 markdown-reference-links-buffer
5953 "Name, setup, and return a buffer for listing links.")
5955 ;; Add an empty Markdown reference definition to buffer
5956 ;; specified in the 'target-buffer property. The reference name is
5957 ;; the button's label.
5958 (define-button-type 'markdown-undefined-reference-button
5959 'help-echo "mouse-1, RET: create definition for undefined reference"
5960 'follow-link t
5961 'face 'bold
5962 'action (lambda (b)
5963 (let ((buffer (button-get b 'target-buffer))
5964 (line (button-get b 'target-line))
5965 (label (button-label b)))
5966 (switch-to-buffer-other-window buffer)
5967 (goto-char (point-min))
5968 (forward-line line)
5969 (markdown-insert-reference-definition label)
5970 (markdown-check-refs t))))
5972 ;; Jump to line in buffer specified by 'target-buffer property.
5973 ;; Line number is button's 'target-line property.
5974 (define-button-type 'markdown-goto-line-button
5975 'help-echo "mouse-1, RET: go to line"
5976 'follow-link t
5977 'face 'italic
5978 'action (lambda (b)
5979 (switch-to-buffer-other-window (button-get b 'target-buffer))
5980 ;; use call-interactively to silence compiler
5981 (let ((current-prefix-arg (button-get b 'target-line)))
5982 (call-interactively 'goto-line))))
5984 ;; Kill a line in buffer specified by 'target-buffer property.
5985 ;; Line number is button's 'target-line property.
5986 (define-button-type 'markdown-kill-line-button
5987 'help-echo "mouse-1, RET: kill line"
5988 'follow-link t
5989 'face 'italic
5990 'action (lambda (b)
5991 (switch-to-buffer-other-window (button-get b 'target-buffer))
5992 ;; use call-interactively to silence compiler
5993 (let ((current-prefix-arg (button-get b 'target-line)))
5994 (call-interactively 'goto-line))
5995 (kill-line 1)
5996 (markdown-unused-refs t)))
5998 ;; Jumps to a particular link at location given by 'target-char
5999 ;; property in buffer given by 'target-buffer property.
6000 (define-button-type 'markdown-location-button
6001 'help-echo "mouse-1, RET: jump to location of link"
6002 'follow-link t
6003 'face 'bold
6004 'action (lambda (b)
6005 (let ((target (button-get b 'target-buffer))
6006 (loc (button-get b 'target-char)))
6007 (kill-buffer-and-window)
6008 (switch-to-buffer target)
6009 (goto-char loc))))
6011 (defun markdown-insert-undefined-reference-button (reference oldbuf)
6012 "Insert a button for creating REFERENCE in buffer OLDBUF.
6013 REFERENCE should be a list of the form (reference . occurrences),
6014 as returned by `markdown-get-undefined-refs'."
6015 (let ((label (car reference)))
6016 ;; Create a reference button
6017 (insert-button label
6018 :type 'markdown-undefined-reference-button
6019 'target-buffer oldbuf
6020 'target-line (cdr (car (cdr reference))))
6021 (insert " (")
6022 (dolist (occurrence (cdr reference))
6023 (let ((line (cdr occurrence)))
6024 ;; Create a line number button
6025 (insert-button (number-to-string line)
6026 :type 'markdown-goto-line-button
6027 'target-buffer oldbuf
6028 'target-line line)
6029 (insert " ")))
6030 (delete-char -1)
6031 (insert ")")
6032 (newline)))
6034 (defun markdown-insert-unused-reference-button (reference oldbuf)
6035 "Insert a button for creating REFERENCE in buffer OLDBUF.
6036 REFERENCE must be a pair of (ref . line-number)."
6037 (let ((label (car reference))
6038 (line (cdr reference)))
6039 ;; Create a reference button
6040 (insert-button label
6041 :type 'markdown-goto-line-button
6042 'face 'bold
6043 'target-buffer oldbuf
6044 'target-line line)
6045 (insert (format " (%d) [" line))
6046 (insert-button "X"
6047 :type 'markdown-kill-line-button
6048 'face 'bold
6049 'target-buffer oldbuf
6050 'target-line line)
6051 (insert "]")
6052 (newline)))
6054 (defun markdown-insert-link-button (link oldbuf)
6055 "Insert a button for jumping to LINK in buffer OLDBUF.
6056 LINK should be a list of the form (text char line) containing
6057 the link text, location, and line number."
6058 (let ((label (cl-first link))
6059 (char (cl-second link))
6060 (line (cl-third link)))
6061 ;; Create a reference button
6062 (insert-button label
6063 :type 'markdown-location-button
6064 'target-buffer oldbuf
6065 'target-char char)
6066 (insert (format " (line %d)\n" line))))
6068 (defun markdown-reference-goto-link (&optional reference)
6069 "Jump to the location of the first use of REFERENCE."
6070 (interactive)
6071 (unless reference
6072 (if (thing-at-point-looking-at markdown-regex-reference-definition)
6073 (setq reference (match-string-no-properties 2))
6074 (user-error "No reference definition at point")))
6075 (let ((links (markdown-reference-find-links reference)))
6076 (cond ((= (length links) 1)
6077 (goto-char (cadr (car links))))
6078 ((> (length links) 1)
6079 (let ((oldbuf (current-buffer))
6080 (linkbuf (markdown-reference-links-buffer)))
6081 (with-current-buffer linkbuf
6082 (insert "Links using reference " reference ":\n\n")
6083 (dolist (link (reverse links))
6084 (markdown-insert-link-button link oldbuf)))
6085 (view-buffer-other-window linkbuf)
6086 (goto-char (point-min))
6087 (forward-line 2)))
6089 (error "No links for reference %s" reference)))))
6091 (defmacro defun-markdown-ref-checker
6092 (name docstring checker-function buffer-function none-message buffer-header insert-reference)
6093 "Define a function NAME acting on result of CHECKER-FUNCTION.
6095 DOCSTRING is used as a docstring for the defined function.
6097 BUFFER-FUNCTION should name and return an auxiliary buffer to put
6098 results in.
6100 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results.
6102 BUFFER-HEADER is put into the auxiliary buffer first, followed by
6103 calling INSERT-REFERENCE for each element in the list returned by
6104 CHECKER-FUNCTION."
6105 `(defun ,name (&optional silent)
6106 ,(concat
6107 docstring
6108 "\n\nIf SILENT is non-nil, do not message anything when no
6109 such references found.")
6110 (interactive "P")
6111 (unless (derived-mode-p 'markdown-mode)
6112 (user-error "Not available in current mode"))
6113 (let ((oldbuf (current-buffer))
6114 (refs (,checker-function))
6115 (refbuf (,buffer-function)))
6116 (if (null refs)
6117 (progn
6118 (when (not silent)
6119 (message ,none-message))
6120 (kill-buffer refbuf))
6121 (with-current-buffer refbuf
6122 (insert ,buffer-header)
6123 (dolist (ref refs)
6124 (,insert-reference ref oldbuf))
6125 (view-buffer-other-window refbuf)
6126 (goto-char (point-min))
6127 (forward-line 2))))))
6129 (defun-markdown-ref-checker
6130 markdown-check-refs
6131 "Show all undefined Markdown references in current `markdown-mode' buffer.
6133 Links which have empty reference definitions are considered to be
6134 defined."
6135 markdown-get-undefined-refs
6136 markdown-reference-check-buffer
6137 "No undefined references found"
6138 "The following references are undefined:\n\n"
6139 markdown-insert-undefined-reference-button)
6142 (defun-markdown-ref-checker
6143 markdown-unused-refs
6144 "Show all unused Markdown references in current `markdown-mode' buffer."
6145 markdown-get-unused-refs
6146 markdown-unused-references-buffer
6147 "No unused references found"
6148 "The following references are unused:\n\n"
6149 markdown-insert-unused-reference-button)
6153 ;;; Lists =====================================================================
6155 (defun markdown-insert-list-item (&optional arg)
6156 "Insert a new list item.
6157 If the point is inside unordered list, insert a bullet mark. If
6158 the point is inside ordered list, insert the next number followed
6159 by a period. Use the previous list item to determine the amount
6160 of whitespace to place before and after list markers.
6162 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
6163 decrease the indentation by one level.
6165 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
6166 increase the indentation by one level."
6167 (interactive "p")
6168 (let (bounds cur-indent marker indent new-indent new-loc)
6169 (save-match-data
6170 ;; Look for a list item on current or previous non-blank line
6171 (save-excursion
6172 (while (and (not (setq bounds (markdown-cur-list-item-bounds)))
6173 (not (bobp))
6174 (markdown-cur-line-blank-p))
6175 (forward-line -1)))
6176 (when bounds
6177 (cond ((save-excursion
6178 (skip-chars-backward " \t")
6179 (looking-at-p markdown-regex-list))
6180 (beginning-of-line)
6181 (insert "\n")
6182 (forward-line -1))
6183 ((not (markdown-cur-line-blank-p))
6184 (newline)))
6185 (setq new-loc (point)))
6186 ;; Look ahead for a list item on next non-blank line
6187 (unless bounds
6188 (save-excursion
6189 (while (and (null bounds)
6190 (not (eobp))
6191 (markdown-cur-line-blank-p))
6192 (forward-line)
6193 (setq bounds (markdown-cur-list-item-bounds))))
6194 (when bounds
6195 (setq new-loc (point))
6196 (unless (markdown-cur-line-blank-p)
6197 (newline))))
6198 (if (not bounds)
6199 ;; When not in a list, start a new unordered one
6200 (progn
6201 (unless (markdown-cur-line-blank-p)
6202 (insert "\n"))
6203 (insert markdown-unordered-list-item-prefix))
6204 ;; Compute indentation and marker for new list item
6205 (setq cur-indent (nth 2 bounds))
6206 (setq marker (nth 4 bounds))
6207 ;; If current item is a GFM checkbox, insert new unchecked checkbox.
6208 (when (nth 5 bounds)
6209 (setq marker
6210 (concat marker
6211 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds)))))
6212 (cond
6213 ;; Dedent: decrement indentation, find previous marker.
6214 ((= arg 4)
6215 (setq indent (max (- cur-indent markdown-list-indent-width) 0))
6216 (let ((prev-bounds
6217 (save-excursion
6218 (goto-char (nth 0 bounds))
6219 (when (markdown-up-list)
6220 (markdown-cur-list-item-bounds)))))
6221 (when prev-bounds
6222 (setq marker (nth 4 prev-bounds)))))
6223 ;; Indent: increment indentation by 4, use same marker.
6224 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width)))
6225 ;; Same level: keep current indentation and marker.
6226 (t (setq indent cur-indent)))
6227 (setq new-indent (make-string indent 32))
6228 (goto-char new-loc)
6229 (cond
6230 ;; Ordered list
6231 ((string-match-p "[0-9]" marker)
6232 (if (= arg 16) ;; starting a new column indented one more level
6233 (insert (concat new-indent "1. "))
6234 ;; Don't use previous match-data
6235 (set-match-data nil)
6236 ;; travel up to the last item and pick the correct number. If
6237 ;; the argument was nil, "new-indent = cur-indent" is the same,
6238 ;; so we don't need special treatment. Neat.
6239 (save-excursion
6240 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)")))
6241 (>= (forward-line -1) 0))))
6242 (let* ((old-prefix (match-string 1))
6243 (old-spacing (match-string 2))
6244 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration)
6245 (int-to-string (1+ (string-to-number old-prefix)))
6246 "1"))
6247 (space-adjust (- (length old-prefix) (length new-prefix)))
6248 (new-spacing (if (and (match-string 2)
6249 (not (string-match-p "\t" old-spacing))
6250 (< space-adjust 0)
6251 (> space-adjust (- 1 (length (match-string 2)))))
6252 (substring (match-string 2) 0 space-adjust)
6253 (or old-spacing ". "))))
6254 (insert (concat new-indent new-prefix new-spacing)))))
6255 ;; Unordered list, GFM task list, or ordered list with hash mark
6256 ((string-match-p "[\\*\\+-]\\|#\\." marker)
6257 (insert new-indent marker))))
6258 ;; Propertize the newly inserted list item now
6259 (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position)))))
6261 (defun markdown-move-list-item-up ()
6262 "Move the current list item up in the list when possible.
6263 In nested lists, move child items with the parent item."
6264 (interactive)
6265 (let (cur prev old)
6266 (when (setq cur (markdown-cur-list-item-bounds))
6267 (setq old (point))
6268 (goto-char (nth 0 cur))
6269 (if (markdown-prev-list-item (nth 3 cur))
6270 (progn
6271 (setq prev (markdown-cur-list-item-bounds))
6272 (condition-case nil
6273 (progn
6274 (transpose-regions (nth 0 prev) (nth 1 prev)
6275 (nth 0 cur) (nth 1 cur) t)
6276 (goto-char (+ (nth 0 prev) (- old (nth 0 cur)))))
6277 ;; Catch error in case regions overlap.
6278 (error (goto-char old))))
6279 (goto-char old)))))
6281 (defun markdown-move-list-item-down ()
6282 "Move the current list item down in the list when possible.
6283 In nested lists, move child items with the parent item."
6284 (interactive)
6285 (let (cur next old)
6286 (when (setq cur (markdown-cur-list-item-bounds))
6287 (setq old (point))
6288 (if (markdown-next-list-item (nth 3 cur))
6289 (progn
6290 (setq next (markdown-cur-list-item-bounds))
6291 (condition-case nil
6292 (progn
6293 (transpose-regions (nth 0 cur) (nth 1 cur)
6294 (nth 0 next) (nth 1 next) nil)
6295 (goto-char (+ old (- (nth 1 next) (nth 1 cur)))))
6296 ;; Catch error in case regions overlap.
6297 (error (goto-char old))))
6298 (goto-char old)))))
6300 (defun markdown-demote-list-item (&optional bounds)
6301 "Indent (or demote) the current list item.
6302 Optionally, BOUNDS of the current list item may be provided if available.
6303 In nested lists, demote child items as well."
6304 (interactive)
6305 (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
6306 (save-excursion
6307 (let* ((item-start (set-marker (make-marker) (nth 0 bounds)))
6308 (item-end (set-marker (make-marker) (nth 1 bounds)))
6309 (list-start (progn (markdown-beginning-of-list)
6310 (set-marker (make-marker) (point))))
6311 (list-end (progn (markdown-end-of-list)
6312 (set-marker (make-marker) (point)))))
6313 (goto-char item-start)
6314 (while (< (point) item-end)
6315 (unless (markdown-cur-line-blank-p)
6316 (insert (make-string markdown-list-indent-width ? )))
6317 (forward-line))
6318 (markdown-syntax-propertize-list-items list-start list-end)))))
6320 (defun markdown-promote-list-item (&optional bounds)
6321 "Unindent (or promote) the current list item.
6322 Optionally, BOUNDS of the current list item may be provided if available.
6323 In nested lists, demote child items as well."
6324 (interactive)
6325 (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
6326 (save-excursion
6327 (save-match-data
6328 (let ((item-start (set-marker (make-marker) (nth 0 bounds)))
6329 (item-end (set-marker (make-marker) (nth 1 bounds)))
6330 (list-start (progn (markdown-beginning-of-list)
6331 (set-marker (make-marker) (point))))
6332 (list-end (progn (markdown-end-of-list)
6333 (set-marker (make-marker) (point))))
6334 num regexp)
6335 (goto-char item-start)
6336 (when (looking-at (format "^[ ]\\{1,%d\\}"
6337 markdown-list-indent-width))
6338 (setq num (- (match-end 0) (match-beginning 0)))
6339 (setq regexp (format "^[ ]\\{1,%d\\}" num))
6340 (while (and (< (point) item-end)
6341 (re-search-forward regexp item-end t))
6342 (replace-match "" nil nil)
6343 (forward-line))
6344 (markdown-syntax-propertize-list-items list-start list-end)))))))
6346 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item)
6347 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM.
6348 PREV-ITEM is width of previous-indentation and list number
6350 Assume that the previously found match was for a numbered item in
6351 a list."
6352 (let ((cpfx pfx)
6353 (cur-item nil)
6354 (idx 0)
6355 (continue t)
6356 (step t)
6357 (sep nil))
6358 (while (and continue (not (eobp)))
6359 (setq step t)
6360 (cond
6361 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ")
6362 (setq cpfx (match-string-no-properties 2))
6363 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker
6364 (cond
6365 ((or (= (length cpfx) (length pfx))
6366 (= (length cur-item) (length prev-item)))
6367 (save-excursion
6368 (replace-match
6369 (if (not markdown-ordered-list-enumeration)
6370 (concat pfx "1. ")
6371 (cl-incf idx)
6372 (concat pfx (number-to-string idx) ". "))))
6373 (setq sep nil))
6374 ;; indented a level
6375 ((< (length pfx) (length cpfx))
6376 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item))
6377 (setq step nil))
6378 ;; exit the loop
6380 (setq step nil)
6381 (setq continue nil))))
6383 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
6384 (setq cpfx (match-string-no-properties 1))
6385 (cond
6386 ;; reset if separated before
6387 ((string= cpfx pfx) (when sep (setq idx 0)))
6388 ((string< cpfx pfx)
6389 (setq step nil)
6390 (setq continue nil))))
6391 (t (setq sep t)))
6393 (when step
6394 (beginning-of-line)
6395 (setq continue (= (forward-line) 0))))
6396 sep))
6398 (defun markdown-cleanup-list-numbers ()
6399 "Update the numbering of ordered lists."
6400 (interactive)
6401 (save-excursion
6402 (goto-char (point-min))
6403 (markdown-cleanup-list-numbers-level "")))
6406 ;;; Movement ==================================================================
6408 (defun markdown-beginning-of-defun (&optional arg)
6409 "`beginning-of-defun-function' for Markdown.
6410 This is used to find the beginning of the defun and should behave
6411 like ‘beginning-of-defun’, returning non-nil if it found the
6412 beginning of a defun. It moves the point backward, right before a
6413 heading which defines a defun. When ARG is non-nil, repeat that
6414 many times. When ARG is negative, move forward to the ARG-th
6415 following section."
6416 (or arg (setq arg 1))
6417 (when (< arg 0) (end-of-line))
6418 ;; Adjust position for setext headings.
6419 (when (and (thing-at-point-looking-at markdown-regex-header-setext)
6420 (not (= (point) (match-beginning 0)))
6421 (not (markdown-code-block-at-point-p)))
6422 (goto-char (match-end 0)))
6423 (let (found)
6424 ;; Move backward with positive argument.
6425 (while (and (not (bobp)) (> arg 0))
6426 (setq found nil)
6427 (while (and (not found)
6428 (not (bobp))
6429 (re-search-backward markdown-regex-header nil 'move))
6430 (markdown-code-block-at-pos (match-beginning 0))
6431 (setq found (match-beginning 0)))
6432 (setq arg (1- arg)))
6433 ;; Move forward with negative argument.
6434 (while (and (not (eobp)) (< arg 0))
6435 (setq found nil)
6436 (while (and (not found)
6437 (not (eobp))
6438 (re-search-forward markdown-regex-header nil 'move))
6439 (markdown-code-block-at-pos (match-beginning 0))
6440 (setq found (match-beginning 0)))
6441 (setq arg (1+ arg)))
6442 (when found
6443 (beginning-of-line)
6444 t)))
6446 (defun markdown-end-of-defun ()
6447 "`end-of-defun-function’ for Markdown.
6448 This is used to find the end of the defun at point.
6449 It is called with no argument, right after calling ‘beginning-of-defun-raw’,
6450 so it can assume that point is at the beginning of the defun body.
6451 It should move point to the first position after the defun."
6452 (or (eobp) (forward-char 1))
6453 (let (found)
6454 (while (and (not found)
6455 (not (eobp))
6456 (re-search-forward markdown-regex-header nil 'move))
6457 (when (not (markdown-code-block-at-pos (match-beginning 0)))
6458 (setq found (match-beginning 0))))
6459 (when found
6460 (goto-char found)
6461 (skip-syntax-backward "-"))))
6463 (defun markdown-beginning-of-text-block ()
6464 "Move backward to previous beginning of a plain text block.
6465 This function simply looks for blank lines without considering
6466 the surrounding context in light of Markdown syntax. For that, see
6467 `markdown-backward-block'."
6468 (interactive)
6469 (let ((start (point)))
6470 (if (re-search-backward markdown-regex-block-separator nil t)
6471 (goto-char (match-end 0))
6472 (goto-char (point-min)))
6473 (when (and (= start (point)) (not (bobp)))
6474 (forward-line -1)
6475 (if (re-search-backward markdown-regex-block-separator nil t)
6476 (goto-char (match-end 0))
6477 (goto-char (point-min))))))
6479 (defun markdown-end-of-text-block ()
6480 "Move forward to next beginning of a plain text block.
6481 This function simply looks for blank lines without considering
6482 the surrounding context in light of Markdown syntax. For that, see
6483 `markdown-forward-block'."
6484 (interactive)
6485 (beginning-of-line)
6486 (skip-chars-forward " \t\n")
6487 (when (= (point) (point-min))
6488 (forward-char))
6489 (if (re-search-forward markdown-regex-block-separator nil t)
6490 (goto-char (match-end 0))
6491 (goto-char (point-max)))
6492 (skip-chars-backward " \t\n")
6493 (forward-line))
6495 (defun markdown-backward-paragraph (&optional arg)
6496 "Move the point to the start of the current paragraph.
6497 With argument ARG, do it ARG times; a negative argument ARG = -N
6498 means move forward N blocks."
6499 (interactive "^p")
6500 (or arg (setq arg 1))
6501 (if (< arg 0)
6502 (markdown-forward-paragraph (- arg))
6503 (dotimes (_ arg)
6504 ;; Skip over whitespace in between paragraphs when moving backward.
6505 (skip-chars-backward " \t\n")
6506 (beginning-of-line)
6507 ;; Skip over code block endings.
6508 (when (markdown-range-properties-exist
6509 (line-beginning-position) (line-end-position)
6510 '(markdown-gfm-block-end
6511 markdown-tilde-fence-end))
6512 (forward-line -1))
6513 ;; Skip over blank lines inside blockquotes.
6514 (while (and (not (eobp))
6515 (looking-at markdown-regex-blockquote)
6516 (= (length (match-string 3)) 0))
6517 (forward-line -1))
6518 ;; Proceed forward based on the type of block of paragraph.
6519 (let (bounds skip)
6520 (cond
6521 ;; Blockquotes
6522 ((looking-at markdown-regex-blockquote)
6523 (while (and (not (bobp))
6524 (looking-at markdown-regex-blockquote)
6525 (> (length (match-string 3)) 0)) ;; not blank
6526 (forward-line -1))
6527 (forward-line))
6528 ;; List items
6529 ((setq bounds (markdown-cur-list-item-bounds))
6530 (goto-char (nth 0 bounds)))
6531 ;; Other
6533 (while (and (not (bobp))
6534 (not skip)
6535 (not (markdown-cur-line-blank-p))
6536 (not (looking-at markdown-regex-blockquote))
6537 (not (markdown-range-properties-exist
6538 (line-beginning-position) (line-end-position)
6539 '(markdown-gfm-block-end
6540 markdown-tilde-fence-end))))
6541 (setq skip (markdown-range-properties-exist
6542 (line-beginning-position) (line-end-position)
6543 '(markdown-gfm-block-begin
6544 markdown-tilde-fence-begin)))
6545 (forward-line -1))
6546 (unless (bobp)
6547 (forward-line 1))))))))
6549 (defun markdown-forward-paragraph (&optional arg)
6550 "Move forward to the next end of a paragraph.
6551 With argument ARG, do it ARG times; a negative argument ARG = -N
6552 means move backward N blocks."
6553 (interactive "^p")
6554 (or arg (setq arg 1))
6555 (if (< arg 0)
6556 (markdown-backward-paragraph (- arg))
6557 (dotimes (_ arg)
6558 ;; Skip whitespace in between paragraphs.
6559 (when (markdown-cur-line-blank-p)
6560 (skip-syntax-forward "-")
6561 (beginning-of-line))
6562 ;; Proceed forward based on the type of block.
6563 (let (bounds skip)
6564 (cond
6565 ;; Blockquotes
6566 ((looking-at markdown-regex-blockquote)
6567 ;; Skip over blank lines inside blockquotes.
6568 (while (and (not (eobp))
6569 (looking-at markdown-regex-blockquote)
6570 (= (length (match-string 3)) 0))
6571 (forward-line))
6572 ;; Move to end of quoted text block
6573 (while (and (not (eobp))
6574 (looking-at markdown-regex-blockquote)
6575 (> (length (match-string 3)) 0)) ;; not blank
6576 (forward-line)))
6577 ;; List items
6578 ((and (markdown-cur-list-item-bounds)
6579 (setq bounds (markdown-next-list-item-bounds)))
6580 (goto-char (nth 0 bounds)))
6581 ;; Other
6583 (forward-line)
6584 (while (and (not (eobp))
6585 (not skip)
6586 (not (markdown-cur-line-blank-p))
6587 (not (looking-at markdown-regex-blockquote))
6588 (not (markdown-range-properties-exist
6589 (line-beginning-position) (line-end-position)
6590 '(markdown-gfm-block-begin
6591 markdown-tilde-fence-begin))))
6592 (setq skip (markdown-range-properties-exist
6593 (line-beginning-position) (line-end-position)
6594 '(markdown-gfm-block-end
6595 markdown-tilde-fence-end)))
6596 (forward-line))))))))
6598 (defun markdown-backward-block (&optional arg)
6599 "Move the point to the start of the current Markdown block.
6600 Moves across complete code blocks, list items, and blockquotes,
6601 but otherwise stops at blank lines, headers, and horizontal
6602 rules. With argument ARG, do it ARG times; a negative argument
6603 ARG = -N means move forward N blocks."
6604 (interactive "^p")
6605 (or arg (setq arg 1))
6606 (if (< arg 0)
6607 (markdown-forward-block (- arg))
6608 (dotimes (_ arg)
6609 ;; Skip over whitespace in between blocks when moving backward,
6610 ;; unless at a block boundary with no whitespace.
6611 (skip-syntax-backward "-")
6612 (beginning-of-line)
6613 ;; Proceed forward based on the type of block.
6614 (cond
6615 ;; Code blocks
6616 ((and (markdown-code-block-at-pos (point)) ;; this line
6617 (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line
6618 (forward-line -1)
6619 (while (and (markdown-code-block-at-point-p) (not (bobp)))
6620 (forward-line -1))
6621 (forward-line))
6622 ;; Headings
6623 ((markdown-heading-at-point)
6624 (goto-char (match-beginning 0)))
6625 ;; Horizontal rules
6626 ((looking-at markdown-regex-hr))
6627 ;; Blockquotes
6628 ((looking-at markdown-regex-blockquote)
6629 (forward-line -1)
6630 (while (and (looking-at markdown-regex-blockquote)
6631 (not (bobp)))
6632 (forward-line -1))
6633 (forward-line))
6634 ;; List items
6635 ((markdown-cur-list-item-bounds)
6636 (markdown-beginning-of-list))
6637 ;; Other
6639 ;; Move forward in case it is a one line regular paragraph.
6640 (unless (markdown-next-line-blank-p)
6641 (forward-line))
6642 (unless (markdown-prev-line-blank-p)
6643 (markdown-backward-paragraph)))))))
6645 (defun markdown-forward-block (&optional arg)
6646 "Move forward to the next end of a Markdown block.
6647 Moves across complete code blocks, list items, and blockquotes,
6648 but otherwise stops at blank lines, headers, and horizontal
6649 rules. With argument ARG, do it ARG times; a negative argument
6650 ARG = -N means move backward N blocks."
6651 (interactive "^p")
6652 (or arg (setq arg 1))
6653 (if (< arg 0)
6654 (markdown-backward-block (- arg))
6655 (dotimes (_ arg)
6656 ;; Skip over whitespace in between blocks when moving forward.
6657 (if (markdown-cur-line-blank-p)
6658 (skip-syntax-forward "-")
6659 (beginning-of-line))
6660 ;; Proceed forward based on the type of block.
6661 (cond
6662 ;; Code blocks
6663 ((markdown-code-block-at-point-p)
6664 (forward-line)
6665 (while (and (markdown-code-block-at-point-p) (not (eobp)))
6666 (forward-line)))
6667 ;; Headings
6668 ((looking-at markdown-regex-header)
6669 (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
6670 (forward-line))
6671 ;; Horizontal rules
6672 ((looking-at markdown-regex-hr)
6673 (forward-line))
6674 ;; Blockquotes
6675 ((looking-at markdown-regex-blockquote)
6676 (forward-line)
6677 (while (and (looking-at markdown-regex-blockquote) (not (eobp)))
6678 (forward-line)))
6679 ;; List items
6680 ((markdown-cur-list-item-bounds)
6681 (markdown-end-of-list)
6682 (forward-line))
6683 ;; Other
6684 (t (markdown-forward-paragraph))))
6685 (skip-syntax-backward "-")
6686 (unless (eobp)
6687 (forward-char 1))))
6689 (defun markdown-backward-page (&optional count)
6690 "Move backward to boundary of the current toplevel section.
6691 With COUNT, repeat, or go forward if negative."
6692 (interactive "p")
6693 (or count (setq count 1))
6694 (if (< count 0)
6695 (markdown-forward-page (- count))
6696 (skip-syntax-backward "-")
6697 (or (markdown-back-to-heading-over-code-block t t)
6698 (goto-char (point-min)))
6699 (when (looking-at markdown-regex-header)
6700 (let ((level (markdown-outline-level)))
6701 (when (> level 1) (markdown-up-heading level))
6702 (when (> count 1)
6703 (condition-case nil
6704 (markdown-backward-same-level (1- count))
6705 (error (goto-char (point-min)))))))))
6707 (defun markdown-forward-page (&optional count)
6708 "Move forward to boundary of the current toplevel section.
6709 With COUNT, repeat, or go backward if negative."
6710 (interactive "p")
6711 (or count (setq count 1))
6712 (if (< count 0)
6713 (markdown-backward-page (- count))
6714 (if (markdown-back-to-heading-over-code-block t t)
6715 (let ((level (markdown-outline-level)))
6716 (when (> level 1) (markdown-up-heading level))
6717 (condition-case nil
6718 (markdown-forward-same-level count)
6719 (error (goto-char (point-max)))))
6720 (markdown-next-visible-heading 1))))
6722 (defun markdown-next-link ()
6723 "Jump to next inline, reference, or wiki link.
6724 If successful, return point. Otherwise, return nil.
6725 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
6726 (interactive)
6727 (let ((opoint (point)))
6728 (when (or (markdown-link-p) (markdown-wiki-link-p))
6729 ;; At a link already, move past it.
6730 (goto-char (+ (match-end 0) 1)))
6731 ;; Search for the next wiki link and move to the beginning.
6732 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t)
6733 (markdown-code-block-at-point-p)
6734 (< (point) (point-max))))
6735 (if (and (not (eq (point) opoint))
6736 (or (markdown-link-p) (markdown-wiki-link-p)))
6737 ;; Group 1 will move past non-escape character in wiki link regexp.
6738 ;; Go to beginning of group zero for all other link types.
6739 (goto-char (or (match-beginning 1) (match-beginning 0)))
6740 (goto-char opoint)
6741 nil)))
6743 (defun markdown-previous-link ()
6744 "Jump to previous wiki link.
6745 If successful, return point. Otherwise, return nil.
6746 See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
6747 (interactive)
6748 (let ((opoint (point)))
6749 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t)
6750 (markdown-code-block-at-point-p)
6751 (> (point) (point-min))))
6752 (if (and (not (eq (point) opoint))
6753 (or (markdown-link-p) (markdown-wiki-link-p)))
6754 (goto-char (or (match-beginning 1) (match-beginning 0)))
6755 (goto-char opoint)
6756 nil)))
6759 ;;; Outline ===================================================================
6761 (defun markdown-move-heading-common (move-fn &optional arg adjust)
6762 "Wrapper for `outline-mode' functions to skip false positives.
6763 MOVE-FN is a function and ARG is its argument. For example,
6764 headings inside preformatted code blocks may match
6765 `outline-regexp' but should not be considered as headings.
6766 When ADJUST is non-nil, adjust the point for interactive calls
6767 to avoid leaving the point at invisible markup. This adjustment
6768 generally should only be done for interactive calls, since other
6769 functions may expect the point to be at the beginning of the
6770 regular expression."
6771 (let ((prev -1) (start (point)))
6772 (if arg (funcall move-fn arg) (funcall move-fn))
6773 (while (and (/= prev (point)) (markdown-code-block-at-point-p))
6774 (setq prev (point))
6775 (if arg (funcall move-fn arg) (funcall move-fn)))
6776 ;; Adjust point for setext headings and invisible text.
6777 (save-match-data
6778 (when (and adjust (thing-at-point-looking-at markdown-regex-header))
6779 (if markdown-hide-markup
6780 ;; Move to beginning of heading text if markup is hidden.
6781 (goto-char (or (match-beginning 1) (match-beginning 5)))
6782 ;; Move to beginning of markup otherwise.
6783 (goto-char (or (match-beginning 1) (match-beginning 4))))))
6784 (if (= (point) start) nil (point))))
6786 (defun markdown-next-visible-heading (arg)
6787 "Move to the next visible heading line of any level.
6788 With argument, repeats or can move backward if negative. ARG is
6789 passed to `outline-next-visible-heading'."
6790 (interactive "p")
6791 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust))
6793 (defun markdown-previous-visible-heading (arg)
6794 "Move to the previous visible heading line of any level.
6795 With argument, repeats or can move backward if negative. ARG is
6796 passed to `outline-previous-visible-heading'."
6797 (interactive "p")
6798 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust))
6800 (defun markdown-next-heading ()
6801 "Move to the next heading line of any level."
6802 (markdown-move-heading-common #'outline-next-heading))
6804 (defun markdown-previous-heading ()
6805 "Move to the previous heading line of any level."
6806 (markdown-move-heading-common #'outline-previous-heading))
6808 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error)
6809 "Move back to the beginning of the previous heading.
6810 Returns t if the point is at a heading, the location if a heading
6811 was found, and nil otherwise.
6812 Only visible heading lines are considered, unless INVISIBLE-OK is
6813 non-nil. Throw an error if there is no previous heading unless
6814 NO-ERROR is non-nil.
6815 Leaves match data intact for `markdown-regex-header'."
6816 (beginning-of-line)
6817 (or (and (markdown-heading-at-point)
6818 (not (markdown-code-block-at-point-p)))
6819 (let (found)
6820 (save-excursion
6821 (while (and (not found)
6822 (re-search-backward markdown-regex-header nil t))
6823 (when (and (or invisible-ok (not (outline-invisible-p)))
6824 (not (markdown-code-block-at-point-p)))
6825 (setq found (point))))
6826 (if (not found)
6827 (unless no-error (user-error "Before first heading"))
6828 (setq found (point))))
6829 (when found (goto-char found)))))
6831 (defun markdown-forward-same-level (arg)
6832 "Move forward to the ARG'th heading at same level as this one.
6833 Stop at the first and last headings of a superior heading."
6834 (interactive "p")
6835 (markdown-back-to-heading-over-code-block)
6836 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust))
6838 (defun markdown-backward-same-level (arg)
6839 "Move backward to the ARG'th heading at same level as this one.
6840 Stop at the first and last headings of a superior heading."
6841 (interactive "p")
6842 (markdown-back-to-heading-over-code-block)
6843 (while (> arg 0)
6844 (let ((point-to-move-to
6845 (save-excursion
6846 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust))))
6847 (if point-to-move-to
6848 (progn
6849 (goto-char point-to-move-to)
6850 (setq arg (1- arg)))
6851 (user-error "No previous same-level heading")))))
6853 (defun markdown-up-heading (arg &optional interactive)
6854 "Move to the visible heading line of which the present line is a subheading.
6855 With argument, move up ARG levels. When called interactively (or
6856 INTERACTIVE is non-nil), also push the mark."
6857 (interactive "p\np")
6858 (and interactive (not (eq last-command 'markdown-up-heading))
6859 (push-mark))
6860 (markdown-move-heading-common #'outline-up-heading arg 'adjust))
6862 (defun markdown-back-to-heading (&optional invisible-ok)
6863 "Move to previous heading line, or beg of this line if it's a heading.
6864 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
6865 (interactive)
6866 (markdown-move-heading-common #'outline-back-to-heading invisible-ok))
6868 (defalias 'markdown-end-of-heading 'outline-end-of-heading)
6870 (defun markdown-on-heading-p ()
6871 "Return non-nil if point is on a heading line."
6872 (get-text-property (line-beginning-position) 'markdown-heading))
6874 (defun markdown-end-of-subtree (&optional invisible-OK)
6875 "Move to the end of the current subtree.
6876 Only visible heading lines are considered, unless INVISIBLE-OK is
6877 non-nil.
6878 Derived from `org-end-of-subtree'."
6879 (markdown-back-to-heading invisible-OK)
6880 (let ((first t)
6881 (level (markdown-outline-level)))
6882 (while (and (not (eobp))
6883 (or first (> (markdown-outline-level) level)))
6884 (setq first nil)
6885 (markdown-next-heading))
6886 (if (memq (preceding-char) '(?\n ?\^M))
6887 (progn
6888 ;; Go to end of line before heading
6889 (forward-char -1)
6890 (if (memq (preceding-char) '(?\n ?\^M))
6891 ;; leave blank line before heading
6892 (forward-char -1)))))
6893 (point))
6895 (defun markdown-outline-fix-visibility ()
6896 "Hide any false positive headings that should not be shown.
6897 For example, headings inside preformatted code blocks may match
6898 `outline-regexp' but should not be shown as headings when cycling.
6899 Also, the ending --- line in metadata blocks appears to be a
6900 setext header, but should not be folded."
6901 (save-excursion
6902 (goto-char (point-min))
6903 ;; Unhide any false positives in metadata blocks
6904 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin)
6905 (let ((body (progn (forward-line)
6906 (markdown-text-property-at-point
6907 'markdown-yaml-metadata-section))))
6908 (when body
6909 (let ((end (progn (goto-char (cl-second body))
6910 (markdown-text-property-at-point
6911 'markdown-yaml-metadata-end))))
6912 (outline-flag-region (point-min) (1+ (cl-second end)) nil)))))
6913 ;; Hide any false positives in code blocks
6914 (unless (outline-on-heading-p)
6915 (outline-next-visible-heading 1))
6916 (while (< (point) (point-max))
6917 (when (markdown-code-block-at-point-p)
6918 (outline-flag-region (1- (line-beginning-position)) (line-end-position) t))
6919 (outline-next-visible-heading 1))))
6921 (defvar markdown-cycle-global-status 1)
6922 (defvar markdown-cycle-subtree-status nil)
6924 (defun markdown-next-preface ()
6925 (let (finish)
6926 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
6927 nil 'move))
6928 (unless (markdown-code-block-at-point-p)
6929 (goto-char (match-beginning 0))
6930 (setq finish t))))
6931 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
6932 (forward-char -1)))
6934 (defun markdown-show-entry ()
6935 (save-excursion
6936 (outline-back-to-heading t)
6937 (outline-flag-region (1- (point))
6938 (progn
6939 (markdown-next-preface)
6940 (if (= 1 (- (point-max) (point)))
6941 (point-max)
6942 (point)))
6943 nil)))
6945 ;; This function was originally derived from `org-cycle' from org.el.
6946 (defun markdown-cycle (&optional arg)
6947 "Visibility cycling for Markdown mode.
6948 This function is called with a `\\[universal-argument]' or if ARG is t, perform
6949 global visibility cycling. If the point is at an atx-style header, cycle
6950 visibility of the corresponding subtree. Otherwise, indent the current line
6951 or insert a tab, as appropriate, by calling `indent-for-tab-command'."
6952 (interactive "P")
6953 (cond
6955 ;; Global cycling
6956 (arg
6957 (cond
6958 ;; Move from overview to contents
6959 ((and (eq last-command this-command)
6960 (eq markdown-cycle-global-status 2))
6961 (outline-hide-sublevels 1)
6962 (message "CONTENTS")
6963 (setq markdown-cycle-global-status 3)
6964 (markdown-outline-fix-visibility))
6965 ;; Move from contents to all
6966 ((and (eq last-command this-command)
6967 (eq markdown-cycle-global-status 3))
6968 (outline-show-all)
6969 (message "SHOW ALL")
6970 (setq markdown-cycle-global-status 1))
6971 ;; Defaults to overview
6973 (outline-hide-body)
6974 (message "OVERVIEW")
6975 (setq markdown-cycle-global-status 2)
6976 (markdown-outline-fix-visibility))))
6978 ;; At a heading: rotate between three different views
6979 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
6980 (markdown-back-to-heading)
6981 (let ((goal-column 0) eoh eol eos)
6982 ;; Determine boundaries
6983 (save-excursion
6984 (markdown-back-to-heading)
6985 (save-excursion
6986 (beginning-of-line 2)
6987 (while (and (not (eobp)) ;; this is like `next-line'
6988 (get-char-property (1- (point)) 'invisible))
6989 (beginning-of-line 2)) (setq eol (point)))
6990 (markdown-end-of-heading) (setq eoh (point))
6991 (markdown-end-of-subtree t)
6992 (skip-chars-forward " \t\n")
6993 (beginning-of-line 1) ; in case this is an item
6994 (setq eos (1- (point))))
6995 ;; Find out what to do next and set `this-command'
6996 (cond
6997 ;; Nothing is hidden behind this heading
6998 ((= eos eoh)
6999 (message "EMPTY ENTRY")
7000 (setq markdown-cycle-subtree-status nil))
7001 ;; Entire subtree is hidden in one line: open it
7002 ((>= eol eos)
7003 (markdown-show-entry)
7004 (outline-show-children)
7005 (message "CHILDREN")
7006 (setq markdown-cycle-subtree-status 'children))
7007 ;; We just showed the children, now show everything.
7008 ((and (eq last-command this-command)
7009 (eq markdown-cycle-subtree-status 'children))
7010 (outline-show-subtree)
7011 (message "SUBTREE")
7012 (setq markdown-cycle-subtree-status 'subtree))
7013 ;; Default action: hide the subtree.
7015 (outline-hide-subtree)
7016 (message "FOLDED")
7017 (setq markdown-cycle-subtree-status 'folded)))))
7019 ;; In a table, move forward by one cell
7020 ((markdown-table-at-point-p)
7021 (call-interactively #'markdown-table-forward-cell))
7023 ;; Otherwise, indent as appropriate
7025 (indent-for-tab-command))))
7027 (defun markdown-shifttab ()
7028 "Handle S-TAB keybinding based on context.
7029 When in a table, move backward one cell.
7030 Otherwise, cycle global heading visibility by calling
7031 `markdown-cycle' with argument t."
7032 (interactive)
7033 (cond ((markdown-table-at-point-p)
7034 (call-interactively #'markdown-table-backward-cell))
7035 (t (markdown-cycle t))))
7037 (defun markdown-outline-level ()
7038 "Return the depth to which a statement is nested in the outline."
7039 (cond
7040 ((and (match-beginning 0)
7041 (markdown-code-block-at-pos (match-beginning 0)))
7042 7) ;; Only 6 header levels are defined.
7043 ((match-end 2) 1)
7044 ((match-end 3) 2)
7045 ((match-end 4)
7046 (length (markdown-trim-whitespace (match-string-no-properties 4))))))
7048 (defun markdown-promote-subtree (&optional arg)
7049 "Promote the current subtree of ATX headings.
7050 Note that Markdown does not support heading levels higher than
7051 six and therefore level-six headings will not be promoted
7052 further. If ARG is non-nil promote the heading, otherwise
7053 demote."
7054 (interactive "*P")
7055 (save-excursion
7056 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx)
7057 (re-search-backward markdown-regex-header-atx nil t))
7058 (not (markdown-code-block-at-point-p)))
7059 (let ((level (length (match-string 1)))
7060 (promote-or-demote (if arg 1 -1))
7061 (remove 't))
7062 (markdown-cycle-atx promote-or-demote remove)
7063 (catch 'end-of-subtree
7064 (while (and (markdown-next-heading)
7065 (looking-at markdown-regex-header-atx))
7066 ;; Exit if this not a higher level heading; promote otherwise.
7067 (if (and (looking-at markdown-regex-header-atx)
7068 (<= (length (match-string-no-properties 1)) level))
7069 (throw 'end-of-subtree nil)
7070 (markdown-cycle-atx promote-or-demote remove))))))))
7072 (defun markdown-demote-subtree ()
7073 "Demote the current subtree of ATX headings."
7074 (interactive)
7075 (markdown-promote-subtree t))
7077 (defun markdown-move-subtree-up ()
7078 "Move the current subtree of ATX headings up."
7079 (interactive)
7080 (outline-move-subtree-up 1))
7082 (defun markdown-move-subtree-down ()
7083 "Move the current subtree of ATX headings down."
7084 (interactive)
7085 (outline-move-subtree-down 1))
7087 (defun markdown-outline-next ()
7088 "Move to next list item, when in a list, or next visible heading."
7089 (interactive)
7090 (let ((bounds (markdown-next-list-item-bounds)))
7091 (if bounds
7092 (goto-char (nth 0 bounds))
7093 (markdown-next-visible-heading 1))))
7095 (defun markdown-outline-previous ()
7096 "Move to previous list item, when in a list, or previous visible heading."
7097 (interactive)
7098 (let ((bounds (markdown-prev-list-item-bounds)))
7099 (if bounds
7100 (goto-char (nth 0 bounds))
7101 (markdown-previous-visible-heading 1))))
7103 (defun markdown-outline-next-same-level ()
7104 "Move to next list item or heading of same level."
7105 (interactive)
7106 (let ((bounds (markdown-cur-list-item-bounds)))
7107 (if bounds
7108 (markdown-next-list-item (nth 3 bounds))
7109 (markdown-forward-same-level 1))))
7111 (defun markdown-outline-previous-same-level ()
7112 "Move to previous list item or heading of same level."
7113 (interactive)
7114 (let ((bounds (markdown-cur-list-item-bounds)))
7115 (if bounds
7116 (markdown-prev-list-item (nth 3 bounds))
7117 (markdown-backward-same-level 1))))
7119 (defun markdown-outline-up ()
7120 "Move to previous list item, when in a list, or previous heading."
7121 (interactive)
7122 (unless (markdown-up-list)
7123 (markdown-up-heading 1)))
7126 ;;; Marking and Narrowing =====================================================
7128 (defun markdown-mark-paragraph ()
7129 "Put mark at end of this block, point at beginning.
7130 The block marked is the one that contains point or follows point.
7132 Interactively, if this command is repeated or (in Transient Mark
7133 mode) if the mark is active, it marks the next block after the
7134 ones already marked."
7135 (interactive)
7136 (if (or (and (eq last-command this-command) (mark t))
7137 (and transient-mark-mode mark-active))
7138 (set-mark
7139 (save-excursion
7140 (goto-char (mark))
7141 (markdown-forward-paragraph)
7142 (point)))
7143 (let ((beginning-of-defun-function #'markdown-backward-paragraph)
7144 (end-of-defun-function #'markdown-forward-paragraph))
7145 (mark-defun))))
7147 (defun markdown-mark-block ()
7148 "Put mark at end of this block, point at beginning.
7149 The block marked is the one that contains point or follows point.
7151 Interactively, if this command is repeated or (in Transient Mark
7152 mode) if the mark is active, it marks the next block after the
7153 ones already marked."
7154 (interactive)
7155 (if (or (and (eq last-command this-command) (mark t))
7156 (and transient-mark-mode mark-active))
7157 (set-mark
7158 (save-excursion
7159 (goto-char (mark))
7160 (markdown-forward-block)
7161 (point)))
7162 (let ((beginning-of-defun-function #'markdown-backward-block)
7163 (end-of-defun-function #'markdown-forward-block))
7164 (mark-defun))))
7166 (defun markdown-narrow-to-block ()
7167 "Make text outside current block invisible.
7168 The current block is the one that contains point or follows point."
7169 (interactive)
7170 (let ((beginning-of-defun-function #'markdown-backward-block)
7171 (end-of-defun-function #'markdown-forward-block))
7172 (narrow-to-defun)))
7174 (defun markdown-mark-text-block ()
7175 "Put mark at end of this plain text block, point at beginning.
7176 The block marked is the one that contains point or follows point.
7178 Interactively, if this command is repeated or (in Transient Mark
7179 mode) if the mark is active, it marks the next block after the
7180 ones already marked."
7181 (interactive)
7182 (if (or (and (eq last-command this-command) (mark t))
7183 (and transient-mark-mode mark-active))
7184 (set-mark
7185 (save-excursion
7186 (goto-char (mark))
7187 (markdown-end-of-text-block)
7188 (point)))
7189 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block)
7190 (end-of-defun-function #'markdown-end-of-text-block))
7191 (mark-defun))))
7193 (defun markdown-mark-page ()
7194 "Put mark at end of this top level section, point at beginning.
7195 The top level section marked is the one that contains point or
7196 follows point.
7198 Interactively, if this command is repeated or (in Transient Mark
7199 mode) if the mark is active, it marks the next page after the
7200 ones already marked."
7201 (interactive)
7202 (if (or (and (eq last-command this-command) (mark t))
7203 (and transient-mark-mode mark-active))
7204 (set-mark
7205 (save-excursion
7206 (goto-char (mark))
7207 (markdown-forward-page)
7208 (point)))
7209 (let ((beginning-of-defun-function #'markdown-backward-page)
7210 (end-of-defun-function #'markdown-forward-page))
7211 (mark-defun))))
7213 (defun markdown-narrow-to-page ()
7214 "Make text outside current top level section invisible.
7215 The current section is the one that contains point or follows point."
7216 (interactive)
7217 (let ((beginning-of-defun-function #'markdown-backward-page)
7218 (end-of-defun-function #'markdown-forward-page))
7219 (narrow-to-defun)))
7221 (defun markdown-mark-subtree ()
7222 "Mark the current subtree.
7223 This puts point at the start of the current subtree, and mark at the end."
7224 (interactive)
7225 (let ((beg))
7226 (if (markdown-heading-at-point)
7227 (beginning-of-line)
7228 (markdown-previous-visible-heading 1))
7229 (setq beg (point))
7230 (markdown-end-of-subtree)
7231 (push-mark (point) nil t)
7232 (goto-char beg)))
7234 (defun markdown-narrow-to-subtree ()
7235 "Narrow buffer to the current subtree."
7236 (interactive)
7237 (save-excursion
7238 (save-match-data
7239 (narrow-to-region
7240 (progn (markdown-back-to-heading-over-code-block t) (point))
7241 (progn (markdown-end-of-subtree)
7242 (if (and (markdown-heading-at-point) (not (eobp)))
7243 (backward-char 1))
7244 (point))))))
7247 ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
7249 (defun markdown-move-up ()
7250 "Move thing at point up.
7251 When in a list item, call `markdown-move-list-item-up'.
7252 When in a table, call `markdown-table-move-row-up'.
7253 Otherwise, move the current heading subtree up with
7254 `markdown-move-subtree-up'."
7255 (interactive)
7256 (cond
7257 ((markdown-list-item-at-point-p)
7258 (call-interactively #'markdown-move-list-item-up))
7259 ((markdown-table-at-point-p)
7260 (call-interactively #'markdown-table-move-row-up))
7262 (call-interactively #'markdown-move-subtree-up))))
7264 (defun markdown-move-down ()
7265 "Move thing at point down.
7266 When in a list item, call `markdown-move-list-item-down'.
7267 Otherwise, move the current heading subtree up with
7268 `markdown-move-subtree-down'."
7269 (interactive)
7270 (cond
7271 ((markdown-list-item-at-point-p)
7272 (call-interactively #'markdown-move-list-item-down))
7273 ((markdown-table-at-point-p)
7274 (call-interactively #'markdown-table-move-row-down))
7276 (call-interactively #'markdown-move-subtree-down))))
7278 (defun markdown-promote ()
7279 "Promote or move element at point to the left.
7280 Depending on the context, this function will promote a heading or
7281 list item at the point, move a table column to the left, or cycle
7282 markup."
7283 (interactive)
7284 (let (bounds)
7285 (cond
7286 ;; Promote atx heading subtree
7287 ((thing-at-point-looking-at markdown-regex-header-atx)
7288 (markdown-promote-subtree))
7289 ;; Promote setext heading
7290 ((thing-at-point-looking-at markdown-regex-header-setext)
7291 (markdown-cycle-setext -1))
7292 ;; Promote horizontal rule
7293 ((thing-at-point-looking-at markdown-regex-hr)
7294 (markdown-cycle-hr -1))
7295 ;; Promote list item
7296 ((setq bounds (markdown-cur-list-item-bounds))
7297 (markdown-promote-list-item bounds))
7298 ;; Move table column to the left
7299 ((markdown-table-at-point-p)
7300 (call-interactively #'markdown-table-move-column-left))
7301 ;; Promote bold
7302 ((thing-at-point-looking-at markdown-regex-bold)
7303 (markdown-cycle-bold))
7304 ;; Promote italic
7305 ((thing-at-point-looking-at markdown-regex-italic)
7306 (markdown-cycle-italic))
7308 (user-error "Nothing to promote at point")))))
7310 (defun markdown-demote ()
7311 "Demote or move element at point to the right.
7312 Depending on the context, this function will demote a heading or
7313 list item at the point, move a table column to the right, or cycle
7314 or remove markup."
7315 (interactive)
7316 (let (bounds)
7317 (cond
7318 ;; Demote atx heading subtree
7319 ((thing-at-point-looking-at markdown-regex-header-atx)
7320 (markdown-demote-subtree))
7321 ;; Demote setext heading
7322 ((thing-at-point-looking-at markdown-regex-header-setext)
7323 (markdown-cycle-setext 1))
7324 ;; Demote horizontal rule
7325 ((thing-at-point-looking-at markdown-regex-hr)
7326 (markdown-cycle-hr 1))
7327 ;; Demote list item
7328 ((setq bounds (markdown-cur-list-item-bounds))
7329 (markdown-demote-list-item bounds))
7330 ;; Move table column to the right
7331 ((markdown-table-at-point-p)
7332 (call-interactively #'markdown-table-move-column-right))
7333 ;; Demote bold
7334 ((thing-at-point-looking-at markdown-regex-bold)
7335 (markdown-cycle-bold))
7336 ;; Demote italic
7337 ((thing-at-point-looking-at markdown-regex-italic)
7338 (markdown-cycle-italic))
7340 (user-error "Nothing to demote at point")))))
7343 ;;; Commands ==================================================================
7345 (defun markdown (&optional output-buffer-name)
7346 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
7347 The output buffer name defaults to `markdown-output-buffer-name'.
7348 Return the name of the output buffer used."
7349 (interactive)
7350 (save-window-excursion
7351 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command))
7352 ((listp markdown-command) markdown-command)))
7353 (command (car-safe commands))
7354 (command-args (cdr-safe commands))
7355 begin-region end-region)
7356 (if (use-region-p)
7357 (setq begin-region (region-beginning)
7358 end-region (region-end))
7359 (setq begin-region (point-min)
7360 end-region (point-max)))
7362 (unless output-buffer-name
7363 (setq output-buffer-name markdown-output-buffer-name))
7364 (when (and (stringp command) (not (executable-find command)))
7365 (user-error "Markdown command %s is not found" command))
7366 (let ((exit-code
7367 (cond
7368 ;; Handle case when `markdown-command' does not read from stdin
7369 ((and (stringp command) markdown-command-needs-filename)
7370 (if (not buffer-file-name)
7371 (user-error "Must be visiting a file")
7372 ;; Don’t use ‘shell-command’ because it’s not guaranteed to
7373 ;; return the exit code of the process.
7374 (let ((command (if (listp markdown-command)
7375 (string-join markdown-command " ")
7376 markdown-command)))
7377 (shell-command-on-region
7378 ;; Pass an empty region so that stdin is empty.
7379 (point) (point)
7380 (concat command " "
7381 (shell-quote-argument buffer-file-name))
7382 output-buffer-name))))
7383 ;; Pass region to `markdown-command' via stdin
7385 (let ((buf (get-buffer-create output-buffer-name)))
7386 (with-current-buffer buf
7387 (setq buffer-read-only nil)
7388 (erase-buffer))
7389 (if (stringp command)
7390 (if (not (null command-args))
7391 (apply #'call-process-region begin-region end-region command nil buf nil command-args)
7392 (call-process-region begin-region end-region command nil buf))
7393 (if markdown-command-needs-filename
7394 (if (not buffer-file-name)
7395 (user-error "Must be visiting a file")
7396 (funcall markdown-command begin-region end-region buf buffer-file-name))
7397 (funcall markdown-command begin-region end-region buf))
7398 ;; If the ‘markdown-command’ function didn’t signal an
7399 ;; error, assume it succeeded by binding ‘exit-code’ to 0.
7400 0))))))
7401 ;; The exit code can be a signal description string, so don’t use ‘=’
7402 ;; or ‘zerop’.
7403 (unless (eq exit-code 0)
7404 (user-error "%s failed with exit code %s"
7405 markdown-command exit-code))))
7406 output-buffer-name))
7408 (defun markdown-standalone (&optional output-buffer-name)
7409 "Special function to provide standalone HTML output.
7410 Insert the output in the buffer named OUTPUT-BUFFER-NAME."
7411 (interactive)
7412 (setq output-buffer-name (markdown output-buffer-name))
7413 (with-current-buffer output-buffer-name
7414 (set-buffer output-buffer-name)
7415 (unless (markdown-output-standalone-p)
7416 (markdown-add-xhtml-header-and-footer output-buffer-name))
7417 (goto-char (point-min))
7418 (html-mode))
7419 output-buffer-name)
7421 (defun markdown-other-window (&optional output-buffer-name)
7422 "Run `markdown-command' on current buffer and display in other window.
7423 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7424 that name."
7425 (interactive)
7426 (markdown-display-buffer-other-window
7427 (markdown-standalone output-buffer-name)))
7429 (defun markdown-output-standalone-p ()
7430 "Determine whether `markdown-command' output is standalone XHTML.
7431 Standalone XHTML output is identified by an occurrence of
7432 `markdown-xhtml-standalone-regexp' in the first five lines of output."
7433 (save-excursion
7434 (goto-char (point-min))
7435 (save-match-data
7436 (re-search-forward
7437 markdown-xhtml-standalone-regexp
7438 (save-excursion (goto-char (point-min)) (forward-line 4) (point))
7439 t))))
7441 (defun markdown-stylesheet-link-string (stylesheet-path)
7442 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
7443 (or (and (string-prefix-p "~" stylesheet-path)
7444 (expand-file-name stylesheet-path))
7445 stylesheet-path)
7446 "\" />"))
7448 (defun markdown-add-xhtml-header-and-footer (title)
7449 "Wrap XHTML header and footer with given TITLE around current buffer."
7450 (goto-char (point-min))
7451 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
7452 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
7453 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
7454 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
7455 "<head>\n<title>")
7456 (insert title)
7457 (insert "</title>\n")
7458 (unless (= (length markdown-content-type) 0)
7459 (insert
7460 (format
7461 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
7462 markdown-content-type
7463 (or (and markdown-coding-system
7464 (coding-system-get markdown-coding-system
7465 'mime-charset))
7466 (coding-system-get buffer-file-coding-system
7467 'mime-charset)
7468 "utf-8"))))
7469 (if (> (length markdown-css-paths) 0)
7470 (insert (mapconcat #'markdown-stylesheet-link-string
7471 markdown-css-paths "\n")))
7472 (when (> (length markdown-xhtml-header-content) 0)
7473 (insert markdown-xhtml-header-content))
7474 (insert "\n</head>\n\n"
7475 "<body>\n\n")
7476 (when (> (length markdown-xhtml-body-preamble) 0)
7477 (insert markdown-xhtml-body-preamble "\n"))
7478 (goto-char (point-max))
7479 (when (> (length markdown-xhtml-body-epilogue) 0)
7480 (insert "\n" markdown-xhtml-body-epilogue))
7481 (insert "\n"
7482 "</body>\n"
7483 "</html>\n"))
7485 (defun markdown-preview (&optional output-buffer-name)
7486 "Run `markdown-command' on the current buffer and view output in browser.
7487 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7488 that name."
7489 (interactive)
7490 (browse-url-of-buffer
7491 (markdown-standalone (or output-buffer-name markdown-output-buffer-name))))
7493 (defun markdown-export-file-name (&optional extension)
7494 "Attempt to generate a filename for Markdown output.
7495 The file extension will be EXTENSION if given, or .html by default.
7496 If the current buffer is visiting a file, we construct a new
7497 output filename based on that filename. Otherwise, return nil."
7498 (when (buffer-file-name)
7499 (unless extension
7500 (setq extension ".html"))
7501 (let ((candidate
7502 (concat
7503 (cond
7504 ((buffer-file-name)
7505 (file-name-sans-extension (buffer-file-name)))
7506 (t (buffer-name)))
7507 extension)))
7508 (cond
7509 ((equal candidate (buffer-file-name))
7510 (concat candidate extension))
7512 candidate)))))
7514 (defun markdown-export (&optional output-file)
7515 "Run Markdown on the current buffer, save to file, and return the filename.
7516 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
7517 generated by `markdown-export-file-name', which will be constructed using the
7518 current filename, but with the extension removed and replaced with .html."
7519 (interactive)
7520 (unless output-file
7521 (setq output-file (markdown-export-file-name ".html")))
7522 (when output-file
7523 (let* ((init-buf (current-buffer))
7524 (init-point (point))
7525 (init-buf-string (buffer-string))
7526 (output-buffer (find-file-noselect output-file))
7527 (output-buffer-name (buffer-name output-buffer)))
7528 (run-hooks 'markdown-before-export-hook)
7529 (markdown-standalone output-buffer-name)
7530 (with-current-buffer output-buffer
7531 (run-hooks 'markdown-after-export-hook)
7532 (save-buffer)
7533 (when markdown-export-kill-buffer (kill-buffer)))
7534 ;; if modified, restore initial buffer
7535 (when (buffer-modified-p init-buf)
7536 (erase-buffer)
7537 (insert init-buf-string)
7538 (save-buffer)
7539 (goto-char init-point))
7540 output-file)))
7542 (defun markdown-export-and-preview ()
7543 "Export to XHTML using `markdown-export' and browse the resulting file."
7544 (interactive)
7545 (browse-url-of-file (markdown-export)))
7547 (defvar-local markdown-live-preview-buffer nil
7548 "Buffer used to preview markdown output in `markdown-live-preview-export'.")
7550 (defvar-local markdown-live-preview-source-buffer nil
7551 "Source buffer from which current buffer was generated.
7552 This is the inverse of `markdown-live-preview-buffer'.")
7554 (defvar markdown-live-preview-currently-exporting nil)
7556 (defun markdown-live-preview-get-filename ()
7557 "Standardize the filename exported by `markdown-live-preview-export'."
7558 (markdown-export-file-name ".html"))
7560 (defun markdown-live-preview-window-eww (file)
7561 "Preview FILE with eww.
7562 To be used with `markdown-live-preview-window-function'."
7563 (when (and (bound-and-true-p eww-auto-rename-buffer)
7564 markdown-live-preview-buffer)
7565 (kill-buffer markdown-live-preview-buffer))
7566 (eww-open-file file)
7567 ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*"
7568 ;; Try to find the buffer whose name ends with "eww*"
7569 (if (bound-and-true-p eww-auto-rename-buffer)
7570 (cl-loop for buf in (buffer-list)
7571 when (string-match-p "eww\\*\\'" (buffer-name buf))
7572 return buf)
7573 (get-buffer "*eww*")))
7575 (defun markdown-visual-lines-between-points (beg end)
7576 (save-excursion
7577 (goto-char beg)
7578 (cl-loop with count = 0
7579 while (progn (end-of-visual-line)
7580 (and (< (point) end) (line-move-visual 1 t)))
7581 do (cl-incf count)
7582 finally return count)))
7584 (defun markdown-live-preview-window-serialize (buf)
7585 "Get window point and scroll data for all windows displaying BUF."
7586 (when (buffer-live-p buf)
7587 (with-current-buffer buf
7588 (mapcar
7589 (lambda (win)
7590 (with-selected-window win
7591 (let* ((start (window-start))
7592 (pt (window-point))
7593 (pt-or-sym (cond ((= pt (point-min)) 'min)
7594 ((= pt (point-max)) 'max)
7595 (t pt)))
7596 (diff (markdown-visual-lines-between-points
7597 start pt)))
7598 (list win pt-or-sym diff))))
7599 (get-buffer-window-list buf)))))
7601 (defun markdown-get-point-back-lines (pt num-lines)
7602 (save-excursion
7603 (goto-char pt)
7604 (line-move-visual (- num-lines) t)
7605 ;; in testing, can occasionally overshoot the number of lines to traverse
7606 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt)))
7607 (when (> actual-num-lines num-lines)
7608 (line-move-visual (- actual-num-lines num-lines) t)))
7609 (point)))
7611 (defun markdown-live-preview-window-deserialize (window-posns)
7612 "Apply window point and scroll data from WINDOW-POSNS.
7613 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
7614 (cl-destructuring-bind (win pt-or-sym diff) window-posns
7615 (when (window-live-p win)
7616 (with-current-buffer markdown-live-preview-buffer
7617 (set-window-buffer win (current-buffer))
7618 (cl-destructuring-bind (actual-pt actual-diff)
7619 (cl-case pt-or-sym
7620 (min (list (point-min) 0))
7621 (max (list (point-max) diff))
7622 (t (list pt-or-sym diff)))
7623 (set-window-start
7624 win (markdown-get-point-back-lines actual-pt actual-diff))
7625 (set-window-point win actual-pt))))))
7627 (defun markdown-live-preview-export ()
7628 "Export to XHTML using `markdown-export'.
7629 Browse the resulting file within Emacs using
7630 `markdown-live-preview-window-function' Return the buffer
7631 displaying the rendered output."
7632 (interactive)
7633 (let ((filename (markdown-live-preview-get-filename)))
7634 (when filename
7635 (let* ((markdown-live-preview-currently-exporting t)
7636 (cur-buf (current-buffer))
7637 (export-file (markdown-export filename))
7638 ;; get positions in all windows currently displaying output buffer
7639 (window-data
7640 (markdown-live-preview-window-serialize
7641 markdown-live-preview-buffer)))
7642 (save-window-excursion
7643 (let ((output-buffer
7644 (funcall markdown-live-preview-window-function export-file)))
7645 (with-current-buffer output-buffer
7646 (setq markdown-live-preview-source-buffer cur-buf)
7647 (add-hook 'kill-buffer-hook
7648 #'markdown-live-preview-remove-on-kill t t))
7649 (with-current-buffer cur-buf
7650 (setq markdown-live-preview-buffer output-buffer))))
7651 (with-current-buffer cur-buf
7652 ;; reset all windows displaying output buffer to where they were,
7653 ;; now with the new output
7654 (mapc #'markdown-live-preview-window-deserialize window-data)
7655 ;; delete html editing buffer
7656 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf)))
7657 (when (and export-file (file-exists-p export-file)
7658 (eq markdown-live-preview-delete-export
7659 'delete-on-export))
7660 (delete-file export-file))
7661 markdown-live-preview-buffer)))))
7663 (defun markdown-live-preview-remove ()
7664 (when (buffer-live-p markdown-live-preview-buffer)
7665 (kill-buffer markdown-live-preview-buffer))
7666 (setq markdown-live-preview-buffer nil)
7667 ;; if set to 'delete-on-export, the output has already been deleted
7668 (when (eq markdown-live-preview-delete-export 'delete-on-destroy)
7669 (let ((outfile-name (markdown-live-preview-get-filename)))
7670 (when (and outfile-name (file-exists-p outfile-name))
7671 (delete-file outfile-name)))))
7673 (defun markdown-get-other-window ()
7674 "Find another window to display preview or output content."
7675 (cond
7676 ((memq markdown-split-window-direction '(vertical below))
7677 (or (window-in-direction 'below) (split-window-vertically)))
7678 ((memq markdown-split-window-direction '(horizontal right))
7679 (or (window-in-direction 'right) (split-window-horizontally)))
7680 (t (split-window-sensibly (get-buffer-window)))))
7682 (defun markdown-display-buffer-other-window (buf)
7683 "Display preview or output buffer BUF in another window."
7684 (if (and display-buffer-alist (eq markdown-split-window-direction 'any))
7685 (display-buffer buf)
7686 (let ((cur-buf (current-buffer))
7687 (window (markdown-get-other-window)))
7688 (set-window-buffer window buf)
7689 (set-buffer cur-buf))))
7691 (defun markdown-live-preview-if-markdown ()
7692 (when (and (derived-mode-p 'markdown-mode)
7693 markdown-live-preview-mode)
7694 (unless markdown-live-preview-currently-exporting
7695 (if (buffer-live-p markdown-live-preview-buffer)
7696 (markdown-live-preview-export)
7697 (markdown-display-buffer-other-window
7698 (markdown-live-preview-export))))))
7700 (defun markdown-live-preview-remove-on-kill ()
7701 (cond ((and (derived-mode-p 'markdown-mode)
7702 markdown-live-preview-mode)
7703 (markdown-live-preview-remove))
7704 (markdown-live-preview-source-buffer
7705 (with-current-buffer markdown-live-preview-source-buffer
7706 (setq markdown-live-preview-buffer nil))
7707 (setq markdown-live-preview-source-buffer nil))))
7709 (defun markdown-live-preview-switch-to-output ()
7710 "Turn on `markdown-live-preview-mode' and switch to output buffer.
7711 The output buffer is opened in another window."
7712 (interactive)
7713 (if markdown-live-preview-mode
7714 (markdown-display-buffer-other-window (markdown-live-preview-export)))
7715 (markdown-live-preview-mode))
7717 (defun markdown-live-preview-re-export ()
7718 "Re-export the current live previewed content.
7719 If the current buffer is a buffer displaying the exported version of a
7720 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
7721 update this buffer's contents."
7722 (interactive)
7723 (when markdown-live-preview-source-buffer
7724 (with-current-buffer markdown-live-preview-source-buffer
7725 (markdown-live-preview-export))))
7727 (defun markdown-open ()
7728 "Open file for the current buffer with `markdown-open-command'."
7729 (interactive)
7730 (unless markdown-open-command
7731 (user-error "Variable `markdown-open-command' must be set"))
7732 (if (stringp markdown-open-command)
7733 (if (not buffer-file-name)
7734 (user-error "Must be visiting a file")
7735 (save-buffer)
7736 (let ((exit-code (call-process markdown-open-command nil nil nil
7737 buffer-file-name)))
7738 ;; The exit code can be a signal description string, so don’t use ‘=’
7739 ;; or ‘zerop’.
7740 (unless (eq exit-code 0)
7741 (user-error "%s failed with exit code %s"
7742 markdown-open-command exit-code))))
7743 (funcall markdown-open-command))
7744 nil)
7746 (defun markdown-kill-ring-save ()
7747 "Run Markdown on file and store output in the kill ring."
7748 (interactive)
7749 (save-window-excursion
7750 (markdown)
7751 (with-current-buffer markdown-output-buffer-name
7752 (kill-ring-save (point-min) (point-max)))))
7755 ;;; Links =====================================================================
7757 (defun markdown-backward-to-link-start ()
7758 "Backward link start position if current position is in link title."
7759 ;; Issue #305
7760 (when (eq (get-text-property (point) 'face) 'markdown-link-face)
7761 (skip-chars-backward "^[")
7762 (forward-char -1)))
7764 (defun markdown-link-p ()
7765 "Return non-nil when `point' is at a non-wiki link.
7766 See `markdown-wiki-link-p' for more information."
7767 (save-excursion
7768 (let ((case-fold-search nil))
7769 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p)))
7770 (markdown-backward-to-link-start)
7771 (or (thing-at-point-looking-at markdown-regex-link-inline)
7772 (thing-at-point-looking-at markdown-regex-link-reference)
7773 (thing-at-point-looking-at markdown-regex-uri)
7774 (thing-at-point-looking-at markdown-regex-angle-uri))))))
7776 (defun markdown-link-at-pos (pos)
7777 "Return properties of link or image at position POS.
7778 Value is a list of elements describing the link:
7779 0. beginning position
7780 1. end position
7781 2. link text
7782 3. URL
7783 4. reference label
7784 5. title text
7785 6. bang (nil or \"!\")"
7786 (save-excursion
7787 (goto-char pos)
7788 (markdown-backward-to-link-start)
7789 (let (begin end text url reference title bang)
7790 (cond
7791 ;; Inline image or link at point.
7792 ((thing-at-point-looking-at markdown-regex-link-inline)
7793 (setq bang (match-string-no-properties 1)
7794 begin (match-beginning 0)
7795 end (match-end 0)
7796 text (match-string-no-properties 3)
7797 url (match-string-no-properties 6))
7798 (if (match-end 7)
7799 (setq title (substring (match-string-no-properties 7) 1 -1))
7800 ;; #408 URL contains close parenthesis case
7801 (goto-char (match-beginning 5))
7802 (let ((paren-end (scan-sexps (point) 1)))
7803 (when (and paren-end (< end paren-end))
7804 (setq url (buffer-substring (match-beginning 6) (1- paren-end)))))))
7805 ;; Reference link at point.
7806 ((or (thing-at-point-looking-at markdown-regex-link-inline)
7807 (thing-at-point-looking-at markdown-regex-link-reference))
7808 (setq bang (match-string-no-properties 1)
7809 begin (match-beginning 0)
7810 end (match-end 0)
7811 text (match-string-no-properties 3))
7812 (when (char-equal (char-after (match-beginning 5)) ?\[)
7813 (setq reference (match-string-no-properties 6))))
7814 ;; Angle bracket URI at point.
7815 ((thing-at-point-looking-at markdown-regex-angle-uri)
7816 (setq begin (match-beginning 0)
7817 end (match-end 0)
7818 url (match-string-no-properties 2)))
7819 ;; Plain URI at point.
7820 ((thing-at-point-looking-at markdown-regex-uri)
7821 (setq begin (match-beginning 0)
7822 end (match-end 0)
7823 url (match-string-no-properties 1))))
7824 (list begin end text url reference title bang))))
7826 (defun markdown-link-url ()
7827 "Return the URL part of the regular (non-wiki) link at point.
7828 Works with both inline and reference style links, and with images.
7829 If point is not at a link or the link reference is not defined
7830 returns nil."
7831 (let* ((values (markdown-link-at-pos (point)))
7832 (text (nth 2 values))
7833 (url (nth 3 values))
7834 (ref (nth 4 values)))
7835 (or url (and ref (car (markdown-reference-definition
7836 (downcase (if (string= ref "") text ref))))))))
7838 (defun markdown--browse-url (url)
7839 (let* ((struct (url-generic-parse-url url))
7840 (full (url-fullness struct))
7841 (file url))
7842 ;; Parse URL, determine fullness, strip query string
7843 (setq file (car (url-path-and-query struct)))
7844 ;; Open full URLs in browser, files in Emacs
7845 (if full
7846 (browse-url url)
7847 (when (and file (> (length file) 0))
7848 (let ((link-file (funcall markdown-translate-filename-function file)))
7849 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file))
7850 (if (functionp markdown-open-image-command)
7851 (funcall markdown-open-image-command link-file)
7852 (process-file markdown-open-image-command nil nil nil link-file))
7853 (find-file link-file)))))))
7855 (defun markdown-follow-link-at-point (&optional event)
7856 "Open the non-wiki link at point or EVENT.
7857 If the link is a complete URL, open in browser with `browse-url'.
7858 Otherwise, open with `find-file' after stripping anchor and/or query string.
7859 Translate filenames using `markdown-filename-translate-function'."
7860 (interactive (list last-command-event))
7861 (save-excursion
7862 (if event (posn-set-point (event-start event)))
7863 (if (markdown-link-p)
7864 (markdown--browse-url (markdown-link-url))
7865 (user-error "Point is not at a Markdown link or URL"))))
7867 (defun markdown-fontify-inline-links (last)
7868 "Add text properties to next inline link from point to LAST."
7869 (when (markdown-match-generic-links last nil)
7870 (let* ((link-start (match-beginning 3))
7871 (link-end (match-end 3))
7872 (url-start (match-beginning 6))
7873 (url-end (match-end 6))
7874 (url (match-string-no-properties 6))
7875 (title-start (match-beginning 7))
7876 (title-end (match-end 7))
7877 (title (match-string-no-properties 7))
7878 ;; Markup part
7879 (mp (list 'invisible 'markdown-markup
7880 'rear-nonsticky t
7881 'font-lock-multiline t))
7882 ;; Link part (without face)
7883 (lp (list 'keymap markdown-mode-mouse-map
7884 'mouse-face 'markdown-highlight-face
7885 'font-lock-multiline t
7886 'help-echo (if title (concat title "\n" url) url)))
7887 ;; URL part
7888 (up (list 'keymap markdown-mode-mouse-map
7889 'invisible 'markdown-markup
7890 'mouse-face 'markdown-highlight-face
7891 'font-lock-multiline t))
7892 ;; URL composition character
7893 (url-char (markdown--first-displayable markdown-url-compose-char))
7894 ;; Title part
7895 (tp (list 'invisible 'markdown-markup
7896 'font-lock-multiline t)))
7897 (dolist (g '(1 2 4 5 8))
7898 (when (match-end g)
7899 (add-text-properties (match-beginning g) (match-end g) mp)
7900 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face)))
7901 ;; Preserve existing faces applied to link part (e.g., inline code)
7902 (when link-start
7903 (add-text-properties link-start link-end lp)
7904 (add-face-text-property link-start link-end 'markdown-link-face))
7905 (when url-start
7906 (add-text-properties url-start url-end up)
7907 (add-face-text-property url-start url-end 'markdown-url-face))
7908 (when title-start
7909 (add-text-properties url-end title-end tp)
7910 (add-face-text-property url-end title-end 'markdown-link-title-face))
7911 (when (and markdown-hide-urls url-start)
7912 (compose-region url-start (or title-end url-end) url-char))
7913 t)))
7915 (defun markdown-fontify-reference-links (last)
7916 "Add text properties to next reference link from point to LAST."
7917 (when (markdown-match-generic-links last t)
7918 (let* ((link-start (match-beginning 3))
7919 (link-end (match-end 3))
7920 (ref-start (match-beginning 6))
7921 (ref-end (match-end 6))
7922 ;; Markup part
7923 (mp (list 'invisible 'markdown-markup
7924 'rear-nonsticky t
7925 'font-lock-multiline t))
7926 ;; Link part
7927 (lp (list 'keymap markdown-mode-mouse-map
7928 'mouse-face 'markdown-highlight-face
7929 'font-lock-multiline t
7930 'help-echo (lambda (_ __ pos)
7931 (save-match-data
7932 (save-excursion
7933 (goto-char pos)
7934 (or (markdown-link-url)
7935 "Undefined reference"))))))
7936 ;; URL composition character
7937 (url-char (markdown--first-displayable markdown-url-compose-char))
7938 ;; Reference part
7939 (rp (list 'invisible 'markdown-markup
7940 'font-lock-multiline t)))
7941 (dolist (g '(1 2 4 5 8))
7942 (when (match-end g)
7943 (add-text-properties (match-beginning g) (match-end g) mp)
7944 (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face)))
7945 (when link-start
7946 (add-text-properties link-start link-end lp)
7947 (add-face-text-property link-start link-end 'markdown-link-face))
7948 (when ref-start
7949 (add-text-properties ref-start ref-end rp)
7950 (add-face-text-property ref-start ref-end 'markdown-reference-face)
7951 (when (and markdown-hide-urls (> (- ref-end ref-start) 2))
7952 (compose-region ref-start ref-end url-char)))
7953 t)))
7955 (defun markdown-fontify-angle-uris (last)
7956 "Add text properties to angle URIs from point to LAST."
7957 (when (markdown-match-angle-uris last)
7958 (let* ((url-start (match-beginning 2))
7959 (url-end (match-end 2))
7960 ;; Markup part
7961 (mp (list 'face 'markdown-markup-face
7962 'invisible 'markdown-markup
7963 'rear-nonsticky t
7964 'font-lock-multiline t))
7965 ;; URI part
7966 (up (list 'keymap markdown-mode-mouse-map
7967 'face 'markdown-plain-url-face
7968 'mouse-face 'markdown-highlight-face
7969 'font-lock-multiline t)))
7970 (dolist (g '(1 3))
7971 (add-text-properties (match-beginning g) (match-end g) mp))
7972 (add-text-properties url-start url-end up)
7973 t)))
7975 (defun markdown-fontify-plain-uris (last)
7976 "Add text properties to plain URLs from point to LAST."
7977 (when (markdown-match-plain-uris last)
7978 (let* ((start (match-beginning 0))
7979 (end (match-end 0))
7980 (props (list 'keymap markdown-mode-mouse-map
7981 'face 'markdown-plain-url-face
7982 'mouse-face 'markdown-highlight-face
7983 'rear-nonsticky t
7984 'font-lock-multiline t)))
7985 (add-text-properties start end props)
7986 t)))
7988 (defun markdown-toggle-url-hiding (&optional arg)
7989 "Toggle the display or hiding of URLs.
7990 With a prefix argument ARG, enable URL hiding if ARG is positive,
7991 and disable it otherwise."
7992 (interactive (list (or current-prefix-arg 'toggle)))
7993 (setq markdown-hide-urls
7994 (if (eq arg 'toggle)
7995 (not markdown-hide-urls)
7996 (> (prefix-numeric-value arg) 0)))
7997 (if markdown-hide-urls
7998 (message "markdown-mode URL hiding enabled")
7999 (message "markdown-mode URL hiding disabled"))
8000 (markdown-reload-extensions))
8003 ;;; Wiki Links ================================================================
8005 (defun markdown-wiki-link-p ()
8006 "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
8007 A true wiki link name matches `markdown-regex-wiki-link' but does
8008 not match the current file name after conversion. This modifies
8009 the data returned by `match-data'. Note that the potential wiki
8010 link name must be available via `match-string'."
8011 (when markdown-enable-wiki-links
8012 (let ((case-fold-search nil))
8013 (and (thing-at-point-looking-at markdown-regex-wiki-link)
8014 (not (markdown-code-block-at-point-p))
8015 (or (not buffer-file-name)
8016 (not (string-equal (buffer-file-name)
8017 (markdown-convert-wiki-link-to-filename
8018 (markdown-wiki-link-link)))))))))
8020 (defun markdown-wiki-link-link ()
8021 "Return the link part of the wiki link using current match data.
8022 The location of the link component depends on the value of
8023 `markdown-wiki-link-alias-first'."
8024 (if markdown-wiki-link-alias-first
8025 (or (match-string-no-properties 5) (match-string-no-properties 3))
8026 (match-string-no-properties 3)))
8028 (defun markdown-wiki-link-alias ()
8029 "Return the alias or text part of the wiki link using current match data.
8030 The location of the alias component depends on the value of
8031 `markdown-wiki-link-alias-first'."
8032 (if markdown-wiki-link-alias-first
8033 (match-string-no-properties 3)
8034 (or (match-string-no-properties 5) (match-string-no-properties 3))))
8036 (defun markdown--wiki-link-search-types ()
8037 (let ((ret (and markdown-wiki-link-search-type
8038 (cl-copy-list markdown-wiki-link-search-type))))
8039 (when (and markdown-wiki-link-search-subdirectories
8040 (not (memq 'sub-directories markdown-wiki-link-search-type)))
8041 (push 'sub-directories ret))
8042 (when (and markdown-wiki-link-search-parent-directories
8043 (not (memq 'parent-directories markdown-wiki-link-search-type)))
8044 (push 'parent-directories ret))
8045 ret))
8047 (defun markdown--project-root ()
8048 (or (cl-loop for dir in '(".git" ".hg" ".svn")
8049 when (locate-dominating-file default-directory dir)
8050 return it)
8051 (progn
8052 (require 'project)
8053 (let ((project (project-current t)))
8054 (with-no-warnings
8055 (if (fboundp 'project-root)
8056 (project-root project)
8057 (car (project-roots project))))))))
8059 (defun markdown-convert-wiki-link-to-filename (name)
8060 "Generate a filename from the wiki link NAME.
8061 Spaces in NAME are replaced with `markdown-link-space-sub-char'.
8062 When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
8063 and [[test test]] both map to Test-test.ext. Look in the current
8064 directory first, then in subdirectories if
8065 `markdown-wiki-link-search-subdirectories' is non-nil, and then
8066 in parent directories if
8067 `markdown-wiki-link-search-parent-directories' is non-nil."
8068 (save-match-data
8069 ;; This function must not overwrite match data(PR #590)
8070 (let* ((basename (replace-regexp-in-string
8071 "[[:space:]\n]" markdown-link-space-sub-char name))
8072 (basename (if (derived-mode-p 'gfm-mode)
8073 (concat (upcase (substring basename 0 1))
8074 (downcase (substring basename 1 nil)))
8075 basename))
8076 (search-types (markdown--wiki-link-search-types))
8077 directory extension default candidates dir)
8078 (when buffer-file-name
8079 (setq directory (file-name-directory buffer-file-name)
8080 extension (file-name-extension buffer-file-name)))
8081 (setq default (concat basename
8082 (when extension (concat "." extension))))
8083 (cond
8084 ;; Look in current directory first.
8085 ((or (null buffer-file-name)
8086 (file-exists-p default))
8087 default)
8088 ;; Possibly search in subdirectories, next.
8089 ((and (memq 'sub-directories search-types)
8090 (setq candidates
8091 (directory-files-recursively
8092 directory (concat "^" default "$"))))
8093 (car candidates))
8094 ;; Possibly search in parent directories as a last resort.
8095 ((and (memq 'parent-directories search-types)
8096 (setq dir (locate-dominating-file directory default)))
8097 (concat dir default))
8098 ((and (memq 'project search-types)
8099 (setq candidates
8100 (directory-files-recursively
8101 (markdown--project-root) (concat "^" default "$"))))
8102 (car candidates))
8103 ;; If nothing is found, return default in current directory.
8104 (t default)))))
8106 (defun markdown-follow-wiki-link (name &optional other)
8107 "Follow the wiki link NAME.
8108 Convert the name to a file name and call `find-file'. Ensure that
8109 the new buffer remains in `markdown-mode'. Open the link in another
8110 window when OTHER is non-nil."
8111 (let ((filename (markdown-convert-wiki-link-to-filename name))
8112 (wp (when buffer-file-name
8113 (file-name-directory buffer-file-name))))
8114 (if (not wp)
8115 (user-error "Must be visiting a file")
8116 (when other (other-window 1))
8117 (let ((default-directory wp))
8118 (find-file filename)))
8119 (unless (derived-mode-p 'markdown-mode)
8120 (markdown-mode))))
8122 (defun markdown-follow-wiki-link-at-point (&optional arg)
8123 "Find Wiki Link at point.
8124 With prefix argument ARG, open the file in other window.
8125 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
8126 (interactive "P")
8127 (if (markdown-wiki-link-p)
8128 (markdown-follow-wiki-link (markdown-wiki-link-link) arg)
8129 (user-error "Point is not at a Wiki Link")))
8131 (defun markdown-highlight-wiki-link (from to face)
8132 "Highlight the wiki link in the region between FROM and TO using FACE."
8133 (put-text-property from to 'font-lock-face face))
8135 (defun markdown-unfontify-region-wiki-links (from to)
8136 "Remove wiki link faces from the region specified by FROM and TO."
8137 (interactive "*r")
8138 (let ((modified (buffer-modified-p)))
8139 (remove-text-properties from to '(font-lock-face markdown-link-face))
8140 (remove-text-properties from to '(font-lock-face markdown-missing-link-face))
8141 ;; remove-text-properties marks the buffer modified in emacs 24.3,
8142 ;; undo that if it wasn't originally marked modified
8143 (set-buffer-modified-p modified)))
8145 (defun markdown-fontify-region-wiki-links (from to)
8146 "Search region given by FROM and TO for wiki links and fontify them.
8147 If a wiki link is found check to see if the backing file exists
8148 and highlight accordingly."
8149 (goto-char from)
8150 (save-match-data
8151 (while (re-search-forward markdown-regex-wiki-link to t)
8152 (when (not (markdown-code-block-at-point-p))
8153 (let ((highlight-beginning (match-beginning 1))
8154 (highlight-end (match-end 1))
8155 (file-name
8156 (markdown-convert-wiki-link-to-filename
8157 (markdown-wiki-link-link))))
8158 (if (condition-case nil (file-exists-p file-name) (error nil))
8159 (markdown-highlight-wiki-link
8160 highlight-beginning highlight-end 'markdown-link-face)
8161 (markdown-highlight-wiki-link
8162 highlight-beginning highlight-end 'markdown-missing-link-face)))))))
8164 (defun markdown-extend-changed-region (from to)
8165 "Extend region given by FROM and TO so that we can fontify all links.
8166 The region is extended to the first newline before and the first
8167 newline after."
8168 ;; start looking for the first new line before 'from
8169 (goto-char from)
8170 (re-search-backward "\n" nil t)
8171 (let ((new-from (point-min))
8172 (new-to (point-max)))
8173 (if (not (= (point) from))
8174 (setq new-from (point)))
8175 ;; do the same thing for the first new line after 'to
8176 (goto-char to)
8177 (re-search-forward "\n" nil t)
8178 (if (not (= (point) to))
8179 (setq new-to (point)))
8180 (cl-values new-from new-to)))
8182 (defun markdown-check-change-for-wiki-link (from to)
8183 "Check region between FROM and TO for wiki links and re-fontify as needed."
8184 (interactive "*r")
8185 (let* ((modified (buffer-modified-p))
8186 (buffer-undo-list t)
8187 (inhibit-read-only t)
8188 deactivate-mark
8189 buffer-file-truename)
8190 (unwind-protect
8191 (save-excursion
8192 (save-match-data
8193 (save-restriction
8194 (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29
8195 ;; Extend the region to fontify so that it starts
8196 ;; and ends at safe places.
8197 (cl-multiple-value-bind (new-from new-to)
8198 (markdown-extend-changed-region from to)
8199 (goto-char new-from)
8200 ;; Only refontify when the range contains text with a
8201 ;; wiki link face or if the wiki link regexp matches.
8202 (when (or (markdown-range-property-any
8203 new-from new-to 'font-lock-face
8204 '(markdown-link-face markdown-missing-link-face))
8205 (re-search-forward
8206 markdown-regex-wiki-link new-to t))
8207 ;; Unfontify existing fontification (start from scratch)
8208 (markdown-unfontify-region-wiki-links new-from new-to)
8209 ;; Now do the fontification.
8210 (markdown-fontify-region-wiki-links new-from new-to))))))
8211 (cursor-intangible-mode -1)
8212 (and (not modified)
8213 (buffer-modified-p)
8214 (set-buffer-modified-p nil)))))
8216 (defun markdown-check-change-for-wiki-link-after-change (from to _)
8217 "Check region between FROM and TO for wiki links and re-fontify as needed.
8218 Designed to be used with the `after-change-functions' hook."
8219 (markdown-check-change-for-wiki-link from to))
8221 (defun markdown-fontify-buffer-wiki-links ()
8222 "Refontify all wiki links in the buffer."
8223 (interactive)
8224 (markdown-check-change-for-wiki-link (point-min) (point-max)))
8226 (defun markdown-toggle-wiki-links (&optional arg)
8227 "Toggle support for wiki links.
8228 With a prefix argument ARG, enable wiki link support if ARG is positive,
8229 and disable it otherwise."
8230 (interactive (list (or current-prefix-arg 'toggle)))
8231 (setq markdown-enable-wiki-links
8232 (if (eq arg 'toggle)
8233 (not markdown-enable-wiki-links)
8234 (> (prefix-numeric-value arg) 0)))
8235 (if markdown-enable-wiki-links
8236 (message "markdown-mode wiki link support enabled")
8237 (message "markdown-mode wiki link support disabled"))
8238 (markdown-reload-extensions))
8240 (defun markdown-setup-wiki-link-hooks ()
8241 "Add or remove hooks for fontifying wiki links.
8242 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
8243 ;; Anytime text changes make sure it gets fontified correctly
8244 (if (and markdown-enable-wiki-links
8245 markdown-wiki-link-fontify-missing)
8246 (add-hook 'after-change-functions
8247 #'markdown-check-change-for-wiki-link-after-change t t)
8248 (remove-hook 'after-change-functions
8249 #'markdown-check-change-for-wiki-link-after-change t))
8250 ;; If we left the buffer there is a really good chance we were
8251 ;; creating one of the wiki link documents. Make sure we get
8252 ;; refontified when we come back.
8253 (if (and markdown-enable-wiki-links
8254 markdown-wiki-link-fontify-missing)
8255 (progn
8256 (add-hook 'window-configuration-change-hook
8257 #'markdown-fontify-buffer-wiki-links t t)
8258 (markdown-fontify-buffer-wiki-links))
8259 (remove-hook 'window-configuration-change-hook
8260 #'markdown-fontify-buffer-wiki-links t)
8261 (markdown-unfontify-region-wiki-links (point-min) (point-max))))
8264 ;;; Following & Doing =========================================================
8266 (defun markdown-follow-thing-at-point (arg)
8267 "Follow thing at point if possible, such as a reference link or wiki link.
8268 Opens inline and reference links in a browser. Opens wiki links
8269 to other files in the current window, or the another window if
8270 ARG is non-nil.
8271 See `markdown-follow-link-at-point' and
8272 `markdown-follow-wiki-link-at-point'."
8273 (interactive "P")
8274 (cond ((markdown-link-p)
8275 (markdown--browse-url (markdown-link-url)))
8276 ((markdown-wiki-link-p)
8277 (markdown-follow-wiki-link-at-point arg))
8279 (let* ((values (markdown-link-at-pos (point)))
8280 (url (nth 3 values)))
8281 (unless url
8282 (user-error "Nothing to follow at point"))
8283 (markdown--browse-url url)))))
8285 (defun markdown-do ()
8286 "Do something sensible based on context at point.
8287 Jumps between reference links and definitions; between footnote
8288 markers and footnote text."
8289 (interactive)
8290 (cond
8291 ;; Footnote definition
8292 ((markdown-footnote-text-positions)
8293 (markdown-footnote-return))
8294 ;; Footnote marker
8295 ((markdown-footnote-marker-positions)
8296 (markdown-footnote-goto-text))
8297 ;; Reference link
8298 ((thing-at-point-looking-at markdown-regex-link-reference)
8299 (markdown-reference-goto-definition))
8300 ;; Reference definition
8301 ((thing-at-point-looking-at markdown-regex-reference-definition)
8302 (markdown-reference-goto-link (match-string-no-properties 2)))
8303 ;; Link
8304 ((or (markdown-link-p) (markdown-wiki-link-p))
8305 (markdown-follow-thing-at-point nil))
8306 ;; GFM task list item
8307 ((markdown-gfm-task-list-item-at-point)
8308 (markdown-toggle-gfm-checkbox))
8309 ;; Align table
8310 ((markdown-table-at-point-p)
8311 (call-interactively #'markdown-table-align))
8312 ;; Otherwise
8314 (markdown-insert-gfm-checkbox))))
8317 ;;; Miscellaneous =============================================================
8319 (defun markdown-compress-whitespace-string (str)
8320 "Compress whitespace in STR and return result.
8321 Leading and trailing whitespace is removed. Sequences of multiple
8322 spaces, tabs, and newlines are replaced with single spaces."
8323 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
8324 (replace-regexp-in-string "[ \t\n]+" " " str)))
8326 (defun markdown--substitute-command-keys (string)
8327 "Like `substitute-command-keys' but, but prefers control characters.
8328 First pass STRING to `substitute-command-keys' and then
8329 substitute `C-i` for `TAB` and `C-m` for `RET`."
8330 (replace-regexp-in-string
8331 "\\<TAB\\>" "C-i"
8332 (replace-regexp-in-string
8333 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t))
8335 (defun markdown-line-number-at-pos (&optional pos)
8336 "Return (narrowed) buffer line number at position POS.
8337 If POS is nil, use current buffer location.
8338 This is an exact copy of `line-number-at-pos' for use in emacs21."
8339 (let ((opoint (or pos (point))) start)
8340 (save-excursion
8341 (goto-char (point-min))
8342 (setq start (point))
8343 (goto-char opoint)
8344 (forward-line 0)
8345 (1+ (count-lines start (point))))))
8347 (defun markdown-inside-link-p ()
8348 "Return t if point is within a link."
8349 (save-match-data
8350 (thing-at-point-looking-at (markdown-make-regex-link-generic))))
8352 (defun markdown-line-is-reference-definition-p ()
8353 "Return whether the current line is a (non-footnote) reference definition."
8354 (save-excursion
8355 (move-beginning-of-line 1)
8356 (and (looking-at-p markdown-regex-reference-definition)
8357 (not (looking-at-p "[ \t]*\\[^")))))
8359 (defun markdown-adaptive-fill-function ()
8360 "Return prefix for filling paragraph or nil if not determined."
8361 (cond
8362 ;; List item inside blockquote
8363 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
8364 (replace-regexp-in-string
8365 "[0-9\\.*+-]" " " (match-string-no-properties 0)))
8366 ;; Blockquote
8367 ((looking-at markdown-regex-blockquote)
8368 (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
8369 ;; List items
8370 ((looking-at markdown-regex-list)
8371 (match-string-no-properties 0))
8372 ;; Footnote definition
8373 ((looking-at-p markdown-regex-footnote-definition)
8374 " ") ; four spaces
8375 ;; No match
8376 (t nil)))
8378 (defun markdown-fill-paragraph (&optional justify)
8379 "Fill paragraph at or after point.
8380 This function is like \\[fill-paragraph], but it skips Markdown
8381 code blocks. If the point is in a code block, or just before one,
8382 do not fill. Otherwise, call `fill-paragraph' as usual. If
8383 JUSTIFY is non-nil, justify text as well. Since this function
8384 handles filling itself, it always returns t so that
8385 `fill-paragraph' doesn't run."
8386 (interactive "P")
8387 (unless (or (markdown-code-block-at-point-p)
8388 (save-excursion
8389 (back-to-indentation)
8390 (skip-syntax-forward "-")
8391 (markdown-code-block-at-point-p)))
8392 (let ((fill-prefix (save-excursion
8393 (goto-char (line-beginning-position))
8394 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)")
8395 (match-string-no-properties 1)))))
8396 (fill-paragraph justify)))
8399 (defun markdown-fill-forward-paragraph (&optional arg)
8400 "Function used by `fill-paragraph' to move over ARG paragraphs.
8401 This is a `fill-forward-paragraph-function' for `markdown-mode'.
8402 It is called with a single argument specifying the number of
8403 paragraphs to move. Just like `forward-paragraph', it should
8404 return the number of paragraphs left to move."
8405 (or arg (setq arg 1))
8406 (if (> arg 0)
8407 ;; With positive ARG, move across ARG non-code-block paragraphs,
8408 ;; one at a time. When passing a code block, don't decrement ARG.
8409 (while (and (not (eobp))
8410 (> arg 0)
8411 (= (forward-paragraph 1) 0)
8412 (or (markdown-code-block-at-pos (line-beginning-position 0))
8413 (setq arg (1- arg)))))
8414 ;; Move backward by one paragraph with negative ARG (always -1).
8415 (let ((start (point)))
8416 (setq arg (forward-paragraph arg))
8417 (while (and (not (eobp))
8418 (progn (move-to-left-margin) (not (eobp)))
8419 (looking-at-p paragraph-separate))
8420 (forward-line 1))
8421 (cond
8422 ;; Move point past whitespace following list marker.
8423 ((looking-at markdown-regex-list)
8424 (goto-char (match-end 0)))
8425 ;; Move point past whitespace following pipe at beginning of line
8426 ;; to handle Pandoc line blocks.
8427 ((looking-at "^|\\s-*")
8428 (goto-char (match-end 0)))
8429 ;; Return point if the paragraph passed was a code block.
8430 ((markdown-code-block-at-pos (line-beginning-position 2))
8431 (goto-char start)))))
8432 arg)
8434 (defun markdown--inhibit-electric-quote ()
8435 "Function added to `electric-quote-inhibit-functions'.
8436 Return non-nil if the quote has been inserted inside a code block
8437 or span."
8438 (let ((pos (1- (point))))
8439 (or (markdown-inline-code-at-pos pos)
8440 (markdown-code-block-at-pos pos))))
8443 ;;; Extension Framework =======================================================
8445 (defun markdown-reload-extensions ()
8446 "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
8447 (interactive)
8448 (when (derived-mode-p 'markdown-mode)
8449 ;; Refontify buffer
8450 (font-lock-flush)
8451 ;; Add or remove hooks related to extensions
8452 (markdown-setup-wiki-link-hooks)))
8454 (defun markdown-handle-local-variables ()
8455 "Run in `hack-local-variables-hook' to update font lock rules.
8456 Checks to see if there is actually a ‘markdown-mode’ file local variable
8457 before regenerating font-lock rules for extensions."
8458 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist)
8459 (assoc 'markdown-enable-math file-local-variables-alist))
8460 (when (assoc 'markdown-enable-math file-local-variables-alist)
8461 (markdown-toggle-math markdown-enable-math))
8462 (markdown-reload-extensions)))
8465 ;;; Math Support ==============================================================
8467 (defconst markdown-mode-font-lock-keywords-math
8468 (list
8469 ;; Equation reference (eq:foo)
8470 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face)
8471 (2 markdown-reference-face)
8472 (3 markdown-markup-face)))
8473 ;; Equation reference \eqref{foo}
8474 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face)
8475 (2 markdown-reference-face)
8476 (3 markdown-markup-face))))
8477 "Font lock keywords to add and remove when toggling math support.")
8479 (defun markdown-toggle-math (&optional arg)
8480 "Toggle support for inline and display LaTeX math expressions.
8481 With a prefix argument ARG, enable math mode if ARG is positive,
8482 and disable it otherwise. If called from Lisp, enable the mode
8483 if ARG is omitted or nil."
8484 (interactive (list (or current-prefix-arg 'toggle)))
8485 (setq markdown-enable-math
8486 (if (eq arg 'toggle)
8487 (not markdown-enable-math)
8488 (> (prefix-numeric-value arg) 0)))
8489 (if markdown-enable-math
8490 (progn
8491 (font-lock-add-keywords
8492 'markdown-mode markdown-mode-font-lock-keywords-math)
8493 (message "markdown-mode math support enabled"))
8494 (font-lock-remove-keywords
8495 'markdown-mode markdown-mode-font-lock-keywords-math)
8496 (message "markdown-mode math support disabled"))
8497 (markdown-reload-extensions))
8500 ;;; GFM Checkboxes ============================================================
8502 (define-button-type 'markdown-gfm-checkbox-button
8503 'follow-link t
8504 'face 'markdown-gfm-checkbox-face
8505 'mouse-face 'markdown-highlight-face
8506 'action #'markdown-toggle-gfm-checkbox-button)
8508 (defun markdown-gfm-task-list-item-at-point (&optional bounds)
8509 "Return non-nil if there is a GFM task list item at the point.
8510 Optionally, the list item BOUNDS may be given if available, as
8511 returned by `markdown-cur-list-item-bounds'. When a task list item
8512 is found, the return value is the same value returned by
8513 `markdown-cur-list-item-bounds'."
8514 (unless bounds
8515 (setq bounds (markdown-cur-list-item-bounds)))
8516 (> (length (nth 5 bounds)) 0))
8518 (defun markdown-insert-gfm-checkbox ()
8519 "Add GFM checkbox at point.
8520 Returns t if added.
8521 Returns nil if non-applicable."
8522 (interactive)
8523 (let ((bounds (markdown-cur-list-item-bounds)))
8524 (if bounds
8525 (unless (cl-sixth bounds)
8526 (let ((pos (+ (cl-first bounds) (cl-fourth bounds)))
8527 (markup "[ ] "))
8528 (if (< pos (point))
8529 (save-excursion
8530 (goto-char pos)
8531 (insert markup))
8532 (goto-char pos)
8533 (insert markup))
8534 (syntax-propertize (+ (cl-second bounds) 4))
8536 (unless (save-excursion
8537 (back-to-indentation)
8538 (or (markdown-list-item-at-point-p)
8539 (markdown-heading-at-point)
8540 (markdown-in-comment-p)
8541 (markdown-code-block-at-point-p)))
8542 (let ((pos (save-excursion
8543 (back-to-indentation)
8544 (point)))
8545 (markup (concat (or (save-excursion
8546 (beginning-of-line 0)
8547 (cl-fifth (markdown-cur-list-item-bounds)))
8548 markdown-unordered-list-item-prefix)
8549 "[ ] ")))
8550 (if (< pos (point))
8551 (save-excursion
8552 (goto-char pos)
8553 (insert markup))
8554 (goto-char pos)
8555 (insert markup))
8556 (syntax-propertize (line-end-position))
8557 t)))))
8559 (defun markdown-toggle-gfm-checkbox ()
8560 "Toggle GFM checkbox at point.
8561 Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
8562 Returns nil if there is no task list item at the point."
8563 (interactive)
8564 (save-match-data
8565 (save-excursion
8566 (let ((bounds (markdown-cur-list-item-bounds)))
8567 (when bounds
8568 ;; Move to beginning of task list item
8569 (goto-char (cl-first bounds))
8570 ;; Advance to column of first non-whitespace after marker
8571 (forward-char (cl-fourth bounds))
8572 (cond ((looking-at "\\[ \\]")
8573 (replace-match
8574 (if markdown-gfm-uppercase-checkbox "[X]" "[x]")
8575 nil t)
8576 (match-string-no-properties 0))
8577 ((looking-at "\\[[xX]\\]")
8578 (replace-match "[ ]" nil t)
8579 (match-string-no-properties 0))))))))
8581 (defun markdown-toggle-gfm-checkbox-button (button)
8582 "Toggle GFM checkbox BUTTON on click."
8583 (save-match-data
8584 (save-excursion
8585 (goto-char (button-start button))
8586 (markdown-toggle-gfm-checkbox))))
8588 (defun markdown-make-gfm-checkboxes-buttons (start end)
8589 "Make GFM checkboxes buttons in region between START and END."
8590 (save-excursion
8591 (goto-char start)
8592 (let ((case-fold-search t))
8593 (save-excursion
8594 (while (re-search-forward markdown-regex-gfm-checkbox end t)
8595 (make-button (match-beginning 1) (match-end 1)
8596 :type 'markdown-gfm-checkbox-button))))))
8598 ;; Called when any modification is made to buffer text.
8599 (defun markdown-gfm-checkbox-after-change-function (beg end _)
8600 "Add to `after-change-functions' to setup GFM checkboxes as buttons.
8601 BEG and END are the limits of scanned region."
8602 (save-excursion
8603 (save-match-data
8604 ;; Rescan between start of line from `beg' and start of line after `end'.
8605 (markdown-make-gfm-checkboxes-buttons
8606 (progn (goto-char beg) (beginning-of-line) (point))
8607 (progn (goto-char end) (forward-line 1) (point))))))
8609 (defun markdown-remove-gfm-checkbox-overlays ()
8610 "Remove all GFM checkbox overlays in buffer."
8611 (save-excursion
8612 (save-restriction
8613 (widen)
8614 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face))))
8617 ;;; Display inline image ======================================================
8619 (defvar-local markdown-inline-image-overlays nil)
8621 (defun markdown-remove-inline-images ()
8622 "Remove inline image overlays from image links in the buffer.
8623 This can be toggled with `markdown-toggle-inline-images'
8624 or \\[markdown-toggle-inline-images]."
8625 (interactive)
8626 (mapc #'delete-overlay markdown-inline-image-overlays)
8627 (setq markdown-inline-image-overlays nil)
8628 (when (fboundp 'clear-image-cache) (clear-image-cache)))
8630 (defcustom markdown-display-remote-images nil
8631 "If non-nil, download and display remote images.
8632 See also `markdown-inline-image-overlays'.
8634 Only image URLs specified with a protocol listed in
8635 `markdown-remote-image-protocols' are displayed."
8636 :group 'markdown
8637 :type 'boolean)
8639 (defcustom markdown-remote-image-protocols '("https")
8640 "List of protocols to use to download remote images.
8641 See also `markdown-display-remote-images'."
8642 :group 'markdown
8643 :type '(repeat string))
8645 (defvar markdown--remote-image-cache
8646 (make-hash-table :test 'equal)
8647 "A map from URLs to image paths.")
8649 (defun markdown--get-remote-image (url)
8650 "Retrieve the image path for a given URL."
8651 (or (gethash url markdown--remote-image-cache)
8652 (let ((dl-path (make-temp-file "markdown-mode--image")))
8653 (require 'url)
8654 (url-copy-file url dl-path t)
8655 (puthash url dl-path markdown--remote-image-cache))))
8657 (defun markdown-display-inline-images ()
8658 "Add inline image overlays to image links in the buffer.
8659 This can be toggled with `markdown-toggle-inline-images'
8660 or \\[markdown-toggle-inline-images]."
8661 (interactive)
8662 (unless (display-images-p)
8663 (error "Cannot show images"))
8664 (save-excursion
8665 (save-restriction
8666 (widen)
8667 (goto-char (point-min))
8668 (while (re-search-forward markdown-regex-link-inline nil t)
8669 (let* ((start (match-beginning 0))
8670 (imagep (match-beginning 1))
8671 (end (match-end 0))
8672 (file (match-string-no-properties 6)))
8673 (when (and imagep
8674 (not (zerop (length file))))
8675 (unless (file-exists-p file)
8676 (let* ((download-file (funcall markdown-translate-filename-function file))
8677 (valid-url (ignore-errors
8678 (member (downcase (url-type (url-generic-parse-url download-file)))
8679 markdown-remote-image-protocols))))
8680 (if (and markdown-display-remote-images valid-url)
8681 (setq file (markdown--get-remote-image download-file))
8682 (when (not valid-url)
8683 ;; strip query parameter
8684 (setq file (replace-regexp-in-string "?.+\\'" "" file))
8685 (unless (file-exists-p file)
8686 (setq file (url-unhex-string file)))))))
8687 (when (file-exists-p file)
8688 (let* ((abspath (if (file-name-absolute-p file)
8689 file
8690 (concat default-directory file)))
8691 (image
8692 (cond ((and markdown-max-image-size
8693 (image-type-available-p 'imagemagick))
8694 (create-image
8695 abspath 'imagemagick nil
8696 :max-width (car markdown-max-image-size)
8697 :max-height (cdr markdown-max-image-size)))
8698 (markdown-max-image-size
8699 (create-image abspath nil nil
8700 :max-width (car markdown-max-image-size)
8701 :max-height (cdr markdown-max-image-size)))
8702 (t (create-image abspath)))))
8703 (when image
8704 (let ((ov (make-overlay start end)))
8705 (overlay-put ov 'display image)
8706 (overlay-put ov 'face 'default)
8707 (push ov markdown-inline-image-overlays)))))))))))
8709 (defun markdown-toggle-inline-images ()
8710 "Toggle inline image overlays in the buffer."
8711 (interactive)
8712 (if markdown-inline-image-overlays
8713 (markdown-remove-inline-images)
8714 (markdown-display-inline-images)))
8717 ;;; GFM Code Block Fontification ==============================================
8719 (defcustom markdown-fontify-code-blocks-natively nil
8720 "When non-nil, fontify code in code blocks using the native major mode.
8721 This only works for fenced code blocks where the language is
8722 specified where we can automatically determine the appropriate
8723 mode to use. The language to mode mapping may be customized by
8724 setting the variable `markdown-code-lang-modes'."
8725 :group 'markdown
8726 :type 'boolean
8727 :safe #'booleanp
8728 :package-version '(markdown-mode . "2.3"))
8730 (defcustom markdown-fontify-code-block-default-mode nil
8731 "Default mode to use to fontify code blocks.
8732 This mode is used when automatic detection fails, such as for GFM
8733 code blocks with no language specified."
8734 :group 'markdown
8735 :type '(choice function (const :tag "None" nil))
8736 :package-version '(markdown-mode . "2.4"))
8738 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg)
8739 "Toggle the native fontification of code blocks.
8740 With a prefix argument ARG, enable if ARG is positive,
8741 and disable otherwise."
8742 (interactive (list (or current-prefix-arg 'toggle)))
8743 (setq markdown-fontify-code-blocks-natively
8744 (if (eq arg 'toggle)
8745 (not markdown-fontify-code-blocks-natively)
8746 (> (prefix-numeric-value arg) 0)))
8747 (if markdown-fontify-code-blocks-natively
8748 (message "markdown-mode native code block fontification enabled")
8749 (message "markdown-mode native code block fontification disabled"))
8750 (markdown-reload-extensions))
8752 ;; This is based on `org-src-lang-modes' from org-src.el
8753 (defcustom markdown-code-lang-modes
8754 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
8755 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
8756 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
8757 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
8758 ("bash" . sh-mode))
8759 "Alist mapping languages to their major mode.
8760 The key is the language name, the value is the major mode. For
8761 many languages this is simple, but for language where this is not
8762 the case, this variable provides a way to simplify things on the
8763 user side. For example, there is no ocaml-mode in Emacs, but the
8764 mode to use is `tuareg-mode'."
8765 :group 'markdown
8766 :type '(repeat
8767 (cons
8768 (string "Language name")
8769 (symbol "Major mode")))
8770 :package-version '(markdown-mode . "2.3"))
8772 (defun markdown-get-lang-mode (lang)
8773 "Return major mode that should be used for LANG.
8774 LANG is a string, and the returned major mode is a symbol."
8775 (cl-find-if
8776 'fboundp
8777 (nconc (list (cdr (assoc lang markdown-code-lang-modes))
8778 (cdr (assoc (downcase lang) markdown-code-lang-modes)))
8779 (and (fboundp 'treesit-language-available-p)
8780 (list (and (treesit-language-available-p (intern lang))
8781 (intern (concat lang "-ts-mode")))
8782 (and (treesit-language-available-p (intern (downcase lang)))
8783 (intern (concat (downcase lang) "-ts-mode")))))
8784 (list
8785 (intern (concat lang "-mode"))
8786 (intern (concat (downcase lang) "-mode"))))))
8788 (defun markdown-fontify-code-blocks-generic (matcher last)
8789 "Add text properties to next code block from point to LAST.
8790 Use matching function MATCHER."
8791 (when (funcall matcher last)
8792 (save-excursion
8793 (save-match-data
8794 (let* ((start (match-beginning 0))
8795 (end (match-end 0))
8796 ;; Find positions outside opening and closing backquotes.
8797 (bol-prev (progn (goto-char start)
8798 (if (bolp) (line-beginning-position 0) (line-beginning-position))))
8799 (eol-next (progn (goto-char end)
8800 (if (bolp) (line-beginning-position 2) (line-beginning-position 3))))
8801 lang)
8802 (if (and markdown-fontify-code-blocks-natively
8803 (or (setq lang (markdown-code-block-lang))
8804 markdown-fontify-code-block-default-mode))
8805 (markdown-fontify-code-block-natively lang start end)
8806 (add-text-properties start end '(face markdown-pre-face)))
8807 ;; Set background for block as well as opening and closing lines.
8808 (font-lock-append-text-property
8809 bol-prev eol-next 'face 'markdown-code-face)
8810 ;; Set invisible property for lines before and after, including newline.
8811 (add-text-properties bol-prev start '(invisible markdown-markup))
8812 (add-text-properties end eol-next '(invisible markdown-markup)))))
8815 (defun markdown-fontify-gfm-code-blocks (last)
8816 "Add text properties to next GFM code block from point to LAST."
8817 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last))
8819 (defun markdown-fontify-fenced-code-blocks (last)
8820 "Add text properties to next tilde fenced code block from point to LAST."
8821 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last))
8823 ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
8824 (defun markdown-fontify-code-block-natively (lang start end)
8825 "Fontify given GFM or fenced code block.
8826 This function is called by Emacs for automatic fontification when
8827 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
8828 language used in the block. START and END specify the block
8829 position."
8830 (let ((lang-mode (if lang (markdown-get-lang-mode lang)
8831 markdown-fontify-code-block-default-mode)))
8832 (when (fboundp lang-mode)
8833 (let ((string (buffer-substring-no-properties start end))
8834 (modified (buffer-modified-p))
8835 (markdown-buffer (current-buffer)) pos next)
8836 (remove-text-properties start end '(face nil))
8837 (with-current-buffer
8838 (get-buffer-create
8839 (concat " markdown-code-fontification:" (symbol-name lang-mode)))
8840 ;; Make sure that modification hooks are not inhibited in
8841 ;; the org-src-fontification buffer in case we're called
8842 ;; from `jit-lock-function' (Bug#25132).
8843 (let ((inhibit-modification-hooks nil))
8844 (delete-region (point-min) (point-max))
8845 (insert string " ")) ;; so there's a final property change
8846 (unless (eq major-mode lang-mode) (funcall lang-mode))
8847 (font-lock-ensure)
8848 (setq pos (point-min))
8849 (while (setq next (next-single-property-change pos 'face))
8850 (let ((val (get-text-property pos 'face)))
8851 (when val
8852 (put-text-property
8853 (+ start (1- pos)) (1- (+ start next)) 'face
8854 val markdown-buffer)))
8855 (setq pos next)))
8856 (add-text-properties
8857 start end
8858 '(font-lock-fontified t fontified t font-lock-multiline t))
8859 (set-buffer-modified-p modified)))))
8861 (require 'edit-indirect nil t)
8862 (defvar edit-indirect-guess-mode-function)
8863 (defvar edit-indirect-after-commit-functions)
8865 (defun markdown--edit-indirect-after-commit-function (beg end)
8866 "Corrective logic run on code block content from lines BEG to END.
8867 Restores code block indentation from BEG to END, and ensures trailing newlines
8868 at the END of code blocks."
8869 ;; ensure trailing newlines
8870 (goto-char end)
8871 (unless (eq (char-before) ?\n)
8872 (insert "\n"))
8873 ;; restore code block indentation
8874 (goto-char (- beg 1))
8875 (let ((block-indentation (current-indentation)))
8876 (when (> block-indentation 0)
8877 (indent-rigidly beg end block-indentation)))
8878 (font-lock-ensure))
8880 (defun markdown-edit-code-block ()
8881 "Edit Markdown code block in an indirect buffer."
8882 (interactive)
8883 (save-excursion
8884 (if (fboundp 'edit-indirect-region)
8885 (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
8886 (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2)))
8887 (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1))))
8888 (if (and begin end)
8889 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation)))
8890 (lang (markdown-code-block-lang))
8891 (mode (or (and lang (markdown-get-lang-mode lang))
8892 markdown-edit-code-block-default-mode))
8893 (edit-indirect-guess-mode-function
8894 (lambda (_parent-buffer _beg _end)
8895 (funcall mode)))
8896 (indirect-buf (edit-indirect-region begin end 'display-buffer)))
8897 ;; reset `sh-shell' when indirect buffer
8898 (when (and (not (member system-type '(ms-dos windows-nt)))
8899 (member mode '(shell-script-mode sh-mode))
8900 (member lang (append
8901 (mapcar (lambda (e) (symbol-name (car e)))
8902 sh-ancestor-alist)
8903 '("csh" "rc" "sh"))))
8904 (with-current-buffer indirect-buf
8905 (sh-set-shell lang)))
8906 (when (> indentation 0) ;; un-indent in edit-indirect buffer
8907 (with-current-buffer indirect-buf
8908 (indent-rigidly (point-min) (point-max) (- indentation)))))
8909 (user-error "Not inside a GFM or tilde fenced code block")))
8910 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
8911 (progn (package-refresh-contents)
8912 (package-install 'edit-indirect)
8913 (markdown-edit-code-block))))))
8916 ;;; Table Editing =============================================================
8918 ;; These functions were originally adapted from `org-table.el'.
8920 ;; General helper functions
8922 (defmacro markdown--with-gensyms (symbols &rest body)
8923 (declare (debug (sexp body)) (indent 1))
8924 `(let ,(mapcar (lambda (s)
8925 `(,s (make-symbol (concat "--" (symbol-name ',s)))))
8926 symbols)
8927 ,@body))
8929 (defun markdown--split-string (string &optional separators)
8930 "Splits STRING into substrings at SEPARATORS.
8931 SEPARATORS is a regular expression. If nil it defaults to
8932 `split-string-default-separators'. This version returns no empty
8933 strings if there are matches at the beginning and end of string."
8934 (let ((start 0) notfirst list)
8935 (while (and (string-match
8936 (or separators split-string-default-separators)
8937 string
8938 (if (and notfirst
8939 (= start (match-beginning 0))
8940 (< start (length string)))
8941 (1+ start) start))
8942 (< (match-beginning 0) (length string)))
8943 (setq notfirst t)
8944 (or (eq (match-beginning 0) 0)
8945 (and (eq (match-beginning 0) (match-end 0))
8946 (eq (match-beginning 0) start))
8947 (push (substring string start (match-beginning 0)) list))
8948 (setq start (match-end 0)))
8949 (or (eq start (length string))
8950 (push (substring string start) list))
8951 (nreverse list)))
8953 (defun markdown--string-width (s)
8954 "Return width of string S.
8955 This version ignores characters with invisibility property
8956 `markdown-markup'."
8957 (let (b)
8958 (when (or (eq t buffer-invisibility-spec)
8959 (member 'markdown-markup buffer-invisibility-spec))
8960 (while (setq b (text-property-any
8961 0 (length s)
8962 'invisible 'markdown-markup s))
8963 (setq s (concat
8964 (substring s 0 b)
8965 (substring s (or (next-single-property-change
8966 b 'invisible s)
8967 (length s))))))))
8968 (string-width s))
8970 (defun markdown--remove-invisible-markup (s)
8971 "Remove Markdown markup from string S.
8972 This version removes characters with invisibility property
8973 `markdown-markup'."
8974 (let (b)
8975 (while (setq b (text-property-any
8976 0 (length s)
8977 'invisible 'markdown-markup s))
8978 (setq s (concat
8979 (substring s 0 b)
8980 (substring s (or (next-single-property-change
8981 b 'invisible s)
8982 (length s)))))))
8985 ;; Functions for maintaining tables
8987 (defvar markdown-table-at-point-p-function #'markdown--table-at-point-p
8988 "Function to decide if point is inside a table.
8990 The indirection serves to differentiate between standard markdown
8991 tables and gfm tables which are less strict about the markup.")
8993 (defconst markdown-table-line-regexp "^[ \t]*|"
8994 "Regexp matching any line inside a table.")
8996 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]"
8997 "Regexp matching hline inside a table.")
8999 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]"
9000 "Regexp matching dline inside a table.")
9002 (defun markdown-table-at-point-p ()
9003 "Return non-nil when point is inside a table."
9004 (funcall markdown-table-at-point-p-function))
9006 (defun markdown--table-at-point-p ()
9007 "Return non-nil when point is inside a table."
9008 (save-excursion
9009 (beginning-of-line)
9010 (and (looking-at-p markdown-table-line-regexp)
9011 (not (markdown-code-block-at-point-p)))))
9013 (defconst gfm-table-line-regexp "^.?*|"
9014 "Regexp matching any line inside a table.")
9016 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+"
9017 "Regexp matching hline inside a table.")
9019 ;; GFM simplified tables syntax is as follows:
9020 ;; - A header line for the column names, this is any text
9021 ;; separated by `|'.
9022 ;; - Followed by a string -|-|- ..., the number of dashes is optional
9023 ;; but must be higher than 1. The number of separators should match
9024 ;; the number of columns.
9025 ;; - Followed by the rows of data, which has the same format as the
9026 ;; header line.
9027 ;; Example:
9029 ;; foo | bar
9030 ;; ------|---------
9031 ;; bar | baz
9032 ;; bar | baz
9033 (defun gfm--table-at-point-p ()
9034 "Return non-nil when point is inside a gfm-compatible table."
9035 (or (markdown--table-at-point-p)
9036 (save-excursion
9037 (beginning-of-line)
9038 (when (looking-at-p gfm-table-line-regexp)
9039 ;; we might be at the first line of the table, check if the
9040 ;; line below is the hline
9041 (or (save-excursion
9042 (forward-line 1)
9043 (looking-at-p gfm-table-hline-regexp))
9044 ;; go up to find the header
9045 (catch 'done
9046 (while (looking-at-p gfm-table-line-regexp)
9047 (cond
9048 ((looking-at-p gfm-table-hline-regexp)
9049 (throw 'done t))
9050 ((bobp)
9051 (throw 'done nil)))
9052 (forward-line -1))
9053 nil))))))
9055 (defun markdown-table-hline-at-point-p ()
9056 "Return non-nil when point is on a hline in a table.
9057 This function assumes point is on a table."
9058 (save-excursion
9059 (beginning-of-line)
9060 (looking-at-p markdown-table-hline-regexp)))
9062 (defun markdown-table-begin ()
9063 "Find the beginning of the table and return its position.
9064 This function assumes point is on a table."
9065 (save-excursion
9066 (while (and (not (bobp))
9067 (markdown-table-at-point-p))
9068 (forward-line -1))
9069 (unless (or (eobp)
9070 (markdown-table-at-point-p))
9071 (forward-line 1))
9072 (point)))
9074 (defun markdown-table-end ()
9075 "Find the end of the table and return its position.
9076 This function assumes point is on a table."
9077 (save-excursion
9078 (while (and (not (eobp))
9079 (markdown-table-at-point-p))
9080 (forward-line 1))
9081 (point)))
9083 (defun markdown-table-get-dline ()
9084 "Return index of the table data line at point.
9085 This function assumes point is on a table."
9086 (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
9087 (save-excursion
9088 (goto-char (markdown-table-begin))
9089 (while (and (re-search-forward
9090 markdown-table-dline-regexp end t)
9091 (setq cnt (1+ cnt))
9092 (< (line-end-position) pos))))
9093 cnt))
9095 (defun markdown--thing-at-wiki-link (pos)
9096 (when markdown-enable-wiki-links
9097 (save-excursion
9098 (save-match-data
9099 (goto-char pos)
9100 (thing-at-point-looking-at markdown-regex-wiki-link)))))
9102 (defun markdown-table-get-column ()
9103 "Return table column at point.
9104 This function assumes point is on a table."
9105 (let ((pos (point)) (cnt 0))
9106 (save-excursion
9107 (beginning-of-line)
9108 (while (search-forward "|" pos t)
9109 (when (and (not (looking-back "\\\\|" (line-beginning-position)))
9110 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9111 (setq cnt (1+ cnt)))))
9112 cnt))
9114 (defun markdown-table-get-cell (&optional n)
9115 "Return the content of the cell in column N of current row.
9116 N defaults to column at point. This function assumes point is on
9117 a table."
9118 (and n (markdown-table-goto-column n))
9119 (skip-chars-backward "^|\n") (backward-char 1)
9120 (if (looking-at "|[^|\r\n]*")
9121 (let* ((pos (match-beginning 0))
9122 (val (buffer-substring (1+ pos) (match-end 0))))
9123 (goto-char (min (line-end-position) (+ 2 pos)))
9124 ;; Trim whitespaces
9125 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val)
9126 val (replace-regexp-in-string "[ \t]+\\'" "" val)))
9127 (forward-char 1) ""))
9129 (defun markdown-table-goto-dline (n)
9130 "Go to the Nth data line in the table at point.
9131 Return t when the line exists, nil otherwise. This function
9132 assumes point is on a table."
9133 (goto-char (markdown-table-begin))
9134 (let ((end (markdown-table-end)) (cnt 0))
9135 (while (and (re-search-forward
9136 markdown-table-dline-regexp end t)
9137 (< (setq cnt (1+ cnt)) n)))
9138 (= cnt n)))
9140 (defun markdown-table-goto-column (n &optional on-delim)
9141 "Go to the Nth column in the table line at point.
9142 With optional argument ON-DELIM, stop with point before the left
9143 delimiter of the cell. If there are less than N cells, just go
9144 beyond the last delimiter. This function assumes point is on a
9145 table."
9146 (beginning-of-line 1)
9147 (when (> n 0)
9148 (while (and (> n 0) (search-forward "|" (line-end-position) t))
9149 (when (and (not (looking-back "\\\\|" (line-beginning-position)))
9150 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9151 (cl-decf n)))
9152 (if on-delim
9153 (backward-char 1)
9154 (when (looking-at " ") (forward-char 1)))))
9156 (defmacro markdown-table-save-cell (&rest body)
9157 "Save cell at point, execute BODY and restore cell.
9158 This function assumes point is on a table."
9159 (declare (debug (body)))
9160 (markdown--with-gensyms (line column)
9161 `(let ((,line (copy-marker (line-beginning-position)))
9162 (,column (markdown-table-get-column)))
9163 (unwind-protect
9164 (progn ,@body)
9165 (goto-char ,line)
9166 (markdown-table-goto-column ,column)
9167 (set-marker ,line nil)))))
9169 (defun markdown-table-blank-line (s)
9170 "Convert a table line S into a line with blank cells."
9171 (if (string-match "^[ \t]*|-" s)
9172 (setq s (mapconcat
9173 (lambda (x) (if (member x '(?| ?+)) "|" " "))
9174 s ""))
9175 (with-temp-buffer
9176 (insert s)
9177 (goto-char (point-min))
9178 (when (re-search-forward "|" nil t)
9179 (let ((cur (point))
9180 ret)
9181 (while (re-search-forward "|" nil t)
9182 (when (and (not (eql (char-before (match-beginning 0)) ?\\))
9183 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9184 (push (make-string (- (match-beginning 0) cur) ? ) ret)
9185 (setq cur (match-end 0))))
9186 (format "|%s|" (string-join (nreverse ret) "|")))))))
9188 (defun markdown-table-colfmt (fmtspec)
9189 "Process column alignment specifier FMTSPEC for tables."
9190 (when (stringp fmtspec)
9191 (mapcar (lambda (x)
9192 (cond ((string-match-p "^:.*:$" x) 'c)
9193 ((string-match-p "^:" x) 'l)
9194 ((string-match-p ":$" x) 'r)
9195 (t 'd)))
9196 (markdown--split-string fmtspec "\\s-*|\\s-*"))))
9198 (defun markdown--first-column-p (bar-pos)
9199 (save-excursion
9200 (save-match-data
9201 (goto-char bar-pos)
9202 (looking-back "^\\s-*" (line-beginning-position)))))
9204 (defun markdown--table-line-to-columns (line)
9205 (with-temp-buffer
9206 (insert line)
9207 (goto-char (point-min))
9208 (let ((cur (point))
9209 ret)
9210 (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)
9211 (if (markdown--first-column-p (match-beginning 1))
9212 (setq cur (match-end 0))
9213 (cond ((eql (char-before (match-beginning 1)) ?\\)
9214 ;; keep spaces
9215 (goto-char (match-end 1)))
9216 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing
9218 (push (buffer-substring-no-properties cur (match-beginning 0)) ret)
9219 (setq cur (match-end 0))))))
9220 (when (< cur (length line))
9221 (push (buffer-substring-no-properties cur (point-max)) ret))
9222 (nreverse ret))))
9224 (defsubst markdown--is-delimiter-row (line)
9225 (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line)
9226 (cl-loop for c across line
9227 always (member c '(?| ?- ?: ?\t ? )))))
9229 (defun markdown-table-align ()
9230 "Align table at point.
9231 This function assumes point is on a table."
9232 (interactive)
9233 (let ((begin (markdown-table-begin))
9234 (end (copy-marker (markdown-table-end))))
9235 (markdown-table-save-cell
9236 (goto-char begin)
9237 (let* (fmtspec
9238 ;; Store table indent
9239 (indent (progn (looking-at "[ \t]*") (match-string 0)))
9240 ;; Split table in lines and save column format specifier
9241 (lines (mapcar (lambda (line)
9242 (if (markdown--is-delimiter-row line)
9243 (progn (setq fmtspec (or fmtspec line)) nil)
9244 line))
9245 (markdown--split-string (buffer-substring begin end) "\n")))
9246 ;; Split lines in cells
9247 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l))
9248 (remq nil lines)))
9249 ;; Calculate maximum number of cells in a line
9250 (maxcells (if cells
9251 (apply #'max (mapcar #'length cells))
9252 (user-error "Empty table")))
9253 ;; Empty cells to fill short lines
9254 (emptycells (make-list maxcells ""))
9255 maxwidths)
9256 ;; Calculate maximum width for each column
9257 (dotimes (i maxcells)
9258 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells)))
9259 (push (apply #'max 1 (mapcar #'markdown--string-width column))
9260 maxwidths)))
9261 (setq maxwidths (nreverse maxwidths))
9262 ;; Process column format specifier
9263 (setq fmtspec (markdown-table-colfmt fmtspec))
9264 ;; Compute formats needed for output of table lines
9265 (let ((hfmt (concat indent "|"))
9266 (rfmt (concat indent "|"))
9267 hfmt1 rfmt1 fmt)
9268 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|")))
9269 (setq fmt (pop fmtspec))
9270 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |"))
9271 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |"))
9272 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |"))
9273 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |")))
9274 (setq rfmt (concat rfmt (format rfmt1 width)))
9275 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-)))))
9276 ;; Replace modified lines only
9277 (dolist (line lines)
9278 (let ((line (if line
9279 (apply #'format rfmt (append (pop cells) emptycells))
9280 hfmt))
9281 (previous (buffer-substring (point) (line-end-position))))
9282 (if (equal previous line)
9283 (forward-line)
9284 (insert line "\n")
9285 (delete-region (point) (line-beginning-position 2))))))
9286 (set-marker end nil)))))
9288 (defun markdown-table-insert-row (&optional arg)
9289 "Insert a new row above the row at point into the table.
9290 With optional argument ARG, insert below the current row."
9291 (interactive "P")
9292 (unless (markdown-table-at-point-p)
9293 (user-error "Not at a table"))
9294 (let* ((line (buffer-substring
9295 (line-beginning-position) (line-end-position)))
9296 (new (markdown-table-blank-line line)))
9297 (beginning-of-line (if arg 2 1))
9298 (unless (bolp) (insert "\n"))
9299 (insert-before-markers new "\n")
9300 (beginning-of-line 0)
9301 (re-search-forward "| ?" (line-end-position) t)))
9303 (defun markdown-table-delete-row ()
9304 "Delete row or horizontal line at point from the table."
9305 (interactive)
9306 (unless (markdown-table-at-point-p)
9307 (user-error "Not at a table"))
9308 (let ((col (current-column)))
9309 (kill-region (line-beginning-position)
9310 (min (1+ (line-end-position)) (point-max)))
9311 (unless (markdown-table-at-point-p) (beginning-of-line 0))
9312 (move-to-column col)))
9314 (defun markdown-table-move-row (&optional up)
9315 "Move table line at point down.
9316 With optional argument UP, move it up."
9317 (interactive "P")
9318 (unless (markdown-table-at-point-p)
9319 (user-error "Not at a table"))
9320 (let* ((col (current-column)) (pos (point))
9321 (tonew (if up 0 2)) txt)
9322 (beginning-of-line tonew)
9323 (unless (markdown-table-at-point-p)
9324 (goto-char pos) (user-error "Cannot move row further"))
9325 (goto-char pos) (beginning-of-line 1) (setq pos (point))
9326 (setq txt (buffer-substring (point) (1+ (line-end-position))))
9327 (delete-region (point) (1+ (line-end-position)))
9328 (beginning-of-line tonew)
9329 (insert txt) (beginning-of-line 0)
9330 (move-to-column col)))
9332 (defun markdown-table-move-row-up ()
9333 "Move table row at point up."
9334 (interactive)
9335 (markdown-table-move-row 'up))
9337 (defun markdown-table-move-row-down ()
9338 "Move table row at point down."
9339 (interactive)
9340 (markdown-table-move-row nil))
9342 (defun markdown-table-insert-column ()
9343 "Insert a new table column."
9344 (interactive)
9345 (unless (markdown-table-at-point-p)
9346 (user-error "Not at a table"))
9347 (let* ((col (max 1 (markdown-table-get-column)))
9348 (begin (markdown-table-begin))
9349 (end (copy-marker (markdown-table-end))))
9350 (markdown-table-save-cell
9351 (goto-char begin)
9352 (while (< (point) end)
9353 (markdown-table-goto-column col t)
9354 (if (markdown-table-hline-at-point-p)
9355 (insert "|---")
9356 (insert "| "))
9357 (forward-line)))
9358 (set-marker end nil)
9359 (when markdown-table-align-p
9360 (markdown-table-align))))
9362 (defun markdown-table-delete-column ()
9363 "Delete column at point from table."
9364 (interactive)
9365 (unless (markdown-table-at-point-p)
9366 (user-error "Not at a table"))
9367 (let ((col (markdown-table-get-column))
9368 (begin (markdown-table-begin))
9369 (end (copy-marker (markdown-table-end))))
9370 (markdown-table-save-cell
9371 (goto-char begin)
9372 (while (< (point) end)
9373 (markdown-table-goto-column col t)
9374 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|")
9375 (replace-match "|"))
9376 (forward-line)))
9377 (set-marker end nil)
9378 (markdown-table-goto-column (max 1 (1- col)))
9379 (when markdown-table-align-p
9380 (markdown-table-align))))
9382 (defun markdown-table-move-column (&optional left)
9383 "Move table column at point to the right.
9384 With optional argument LEFT, move it to the left."
9385 (interactive "P")
9386 (unless (markdown-table-at-point-p)
9387 (user-error "Not at a table"))
9388 (let* ((col (markdown-table-get-column))
9389 (col1 (if left (1- col) col))
9390 (colpos (if left (1- col) (1+ col)))
9391 (begin (markdown-table-begin))
9392 (end (copy-marker (markdown-table-end))))
9393 (when (and left (= col 1))
9394 (user-error "Cannot move column further left"))
9395 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
9396 (user-error "Cannot move column further right"))
9397 (markdown-table-save-cell
9398 (goto-char begin)
9399 (while (< (point) end)
9400 (markdown-table-goto-column col1 t)
9401 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|")
9402 (replace-match "|\\2|\\1|"))
9403 (forward-line)))
9404 (set-marker end nil)
9405 (markdown-table-goto-column colpos)
9406 (when markdown-table-align-p
9407 (markdown-table-align))))
9409 (defun markdown-table-move-column-left ()
9410 "Move table column at point to the left."
9411 (interactive)
9412 (markdown-table-move-column 'left))
9414 (defun markdown-table-move-column-right ()
9415 "Move table column at point to the right."
9416 (interactive)
9417 (markdown-table-move-column nil))
9419 (defun markdown-table-next-row ()
9420 "Go to the next row (same column) in the table.
9421 Create new table lines if required."
9422 (interactive)
9423 (unless (markdown-table-at-point-p)
9424 (user-error "Not at a table"))
9425 (if (or (looking-at "[ \t]*$")
9426 (save-excursion (skip-chars-backward " \t") (bolp)))
9427 (newline)
9428 (when markdown-table-align-p
9429 (markdown-table-align))
9430 (let ((col (markdown-table-get-column)))
9431 (beginning-of-line 2)
9432 (if (or (not (markdown-table-at-point-p))
9433 (markdown-table-hline-at-point-p))
9434 (progn
9435 (beginning-of-line 0)
9436 (markdown-table-insert-row 'below)))
9437 (markdown-table-goto-column col)
9438 (skip-chars-backward "^|\n\r")
9439 (when (looking-at " ") (forward-char 1)))))
9441 (defun markdown-table-forward-cell ()
9442 "Go to the next cell in the table.
9443 Create new table lines if required."
9444 (interactive)
9445 (unless (markdown-table-at-point-p)
9446 (user-error "Not at a table"))
9447 (when markdown-table-align-p
9448 (markdown-table-align))
9449 (let ((end (markdown-table-end)))
9450 (when (markdown-table-hline-at-point-p) (end-of-line 1))
9451 (condition-case nil
9452 (progn
9453 (re-search-forward "\\(?:^\\|[^\\]\\)|" end)
9454 (when (looking-at "[ \t]*$")
9455 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end))
9456 (when (and (looking-at "[-:]")
9457 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t))
9458 (goto-char (match-beginning 1)))
9459 (if (looking-at "[-:]")
9460 (progn
9461 (beginning-of-line 0)
9462 (markdown-table-insert-row 'below))
9463 (when (looking-at " ") (forward-char 1))))
9464 (error (markdown-table-insert-row 'below)))))
9466 (defun markdown-table-backward-cell ()
9467 "Go to the previous cell in the table."
9468 (interactive)
9469 (unless (markdown-table-at-point-p)
9470 (user-error "Not at a table"))
9471 (when markdown-table-align-p
9472 (markdown-table-align))
9473 (when (markdown-table-hline-at-point-p) (beginning-of-line 1))
9474 (condition-case nil
9475 (progn
9476 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))
9477 ;; When this function is called while in the first cell in a
9478 ;; table, the point will now be at the beginning of a line. In
9479 ;; this case, we need to move past one additional table
9480 ;; boundary, the end of the table on the previous line.
9481 (when (= (point) (line-beginning-position))
9482 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
9483 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
9484 (error (user-error "Cannot move to previous table cell")))
9485 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0)))
9487 ;; This may have dropped point on the hline.
9488 (when (markdown-table-hline-at-point-p)
9489 (markdown-table-backward-cell)))
9491 (defun markdown-table-transpose ()
9492 "Transpose table at point.
9493 Horizontal separator lines will be eliminated."
9494 (interactive)
9495 (unless (markdown-table-at-point-p)
9496 (user-error "Not at a table"))
9497 (let* ((table (buffer-substring-no-properties
9498 (markdown-table-begin) (markdown-table-end)))
9499 ;; Convert table to Lisp structure
9500 (table (delq nil
9501 (mapcar
9502 (lambda (x)
9503 (unless (string-match-p
9504 markdown-table-hline-regexp x)
9505 (markdown--table-line-to-columns x)))
9506 (markdown--split-string table "[ \t]*\n[ \t]*"))))
9507 (dline_old (markdown-table-get-dline))
9508 (col_old (markdown-table-get-column))
9509 (contents (mapcar (lambda (_)
9510 (let ((tp table))
9511 (mapcar
9512 (lambda (_)
9513 (prog1
9514 (pop (car tp))
9515 (setq tp (cdr tp))))
9516 table)))
9517 (car table))))
9518 (goto-char (markdown-table-begin))
9519 (save-excursion
9520 (re-search-forward "|") (backward-char)
9521 (delete-region (point) (markdown-table-end))
9522 (insert (mapconcat
9523 (lambda(x)
9524 (concat "| " (mapconcat 'identity x " | " ) " |\n"))
9525 contents "")))
9526 (markdown-table-goto-dline col_old)
9527 (markdown-table-goto-column dline_old))
9528 (when markdown-table-align-p
9529 (markdown-table-align)))
9531 (defun markdown-table-sort-lines (&optional sorting-type)
9532 "Sort table lines according to the column at point.
9534 The position of point indicates the column to be used for
9535 sorting, and the range of lines is the range between the nearest
9536 horizontal separator lines, or the entire table of no such lines
9537 exist. If point is before the first column, user will be prompted
9538 for the sorting column. If there is an active region, the mark
9539 specifies the first line and the sorting column, while point
9540 should be in the last line to be included into the sorting.
9542 The command then prompts for the sorting type which can be
9543 alphabetically or numerically. Sorting in reverse order is also
9544 possible.
9546 If SORTING-TYPE is specified when this function is called from a
9547 Lisp program, no prompting will take place. SORTING-TYPE must be
9548 a character, any of (?a ?A ?n ?N) where the capital letters
9549 indicate that sorting should be done in reverse order."
9550 (interactive)
9551 (unless (markdown-table-at-point-p)
9552 (user-error "Not at a table"))
9553 ;; Set sorting type and column used for sorting
9554 (let ((column (let ((c (markdown-table-get-column)))
9555 (cond ((> c 0) c)
9556 ((called-interactively-p 'any)
9557 (read-number "Use column N for sorting: "))
9558 (t 1))))
9559 (sorting-type
9560 (or sorting-type
9561 (progn
9562 ;; workaround #641
9563 ;; Emacs < 28 hides prompt message by another message. This erases it.
9564 (message "")
9565 (read-char-exclusive
9566 "Sort type: [a]lpha [n]umeric (A/N means reversed): ")))))
9567 (save-restriction
9568 ;; Narrow buffer to appropriate sorting area
9569 (if (region-active-p)
9570 (narrow-to-region
9571 (save-excursion
9572 (progn
9573 (goto-char (region-beginning)) (line-beginning-position)))
9574 (save-excursion
9575 (progn
9576 (goto-char (region-end)) (line-end-position))))
9577 (let ((start (markdown-table-begin))
9578 (end (markdown-table-end)))
9579 (narrow-to-region
9580 (save-excursion
9581 (if (re-search-backward
9582 markdown-table-hline-regexp start t)
9583 (line-beginning-position 2)
9584 start))
9585 (if (save-excursion (re-search-forward
9586 markdown-table-hline-regexp end t))
9587 (match-beginning 0)
9588 end))))
9589 ;; Determine arguments for `sort-subr'
9590 (let* ((extract-key-from-cell
9591 (cl-case sorting-type
9592 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity)
9593 ((?n ?N) #'string-to-number)
9594 (t (user-error "Invalid sorting type: %c" sorting-type))))
9595 (predicate
9596 (cl-case sorting-type
9597 ((?n ?N) #'<)
9598 ((?a ?A) #'string<))))
9599 ;; Sort selected area
9600 (goto-char (point-min))
9601 (sort-subr (memq sorting-type '(?A ?N))
9602 (lambda ()
9603 (forward-line)
9604 (while (and (not (eobp))
9605 (not (looking-at
9606 markdown-table-dline-regexp)))
9607 (forward-line)))
9608 #'end-of-line
9609 (lambda ()
9610 (funcall extract-key-from-cell
9611 (markdown-table-get-cell column)))
9613 predicate)
9614 (goto-char (point-min))))))
9616 (defun markdown-table-convert-region (begin end &optional separator)
9617 "Convert region from BEGIN to END to table with SEPARATOR.
9619 If every line contains at least one TAB character, the function
9620 assumes that the material is tab separated (TSV). If every line
9621 contains a comma, comma-separated values (CSV) are assumed. If
9622 not, lines are split at whitespace into cells.
9624 You can use a prefix argument to force a specific separator:
9625 \\[universal-argument] once forces CSV, \\[universal-argument]
9626 twice forces TAB, and \\[universal-argument] three times will
9627 prompt for a regular expression to match the separator, and a
9628 numeric argument N indicates that at least N consecutive
9629 spaces, or alternatively a TAB should be used as the separator."
9631 (interactive "r\nP")
9632 (let* ((begin (min begin end)) (end (max begin end)) re)
9633 (goto-char begin) (beginning-of-line 1)
9634 (setq begin (point-marker))
9635 (goto-char end)
9636 (if (bolp) (backward-char 1) (end-of-line 1))
9637 (setq end (point-marker))
9638 (when (equal separator '(64))
9639 (setq separator (read-regexp "Regexp for cell separator: ")))
9640 (unless separator
9641 ;; Get the right cell separator
9642 (goto-char begin)
9643 (setq separator
9644 (cond
9645 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
9646 ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
9647 (t 1))))
9648 (goto-char begin)
9649 (if (equal separator '(4))
9650 ;; Parse CSV
9651 (while (< (point) end)
9652 (cond
9653 ((looking-at "^") (insert "| "))
9654 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
9655 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
9656 (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
9657 ((looking-at "[^,\n]+") (goto-char (match-end 0)))
9658 ((looking-at "[ \t]*,") (replace-match " | "))
9659 (t (beginning-of-line 2))))
9660 (setq re
9661 (cond
9662 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
9663 ((equal separator '(16)) "^\\|\t")
9664 ((integerp separator)
9665 (if (< separator 1)
9666 (user-error "Cell separator must contain one or more spaces")
9667 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator)))
9668 ((stringp separator) (format "^ *\\|%s" separator))
9669 (t (error "Invalid cell separator"))))
9670 (let (finish)
9671 (while (and (not finish) (re-search-forward re end t))
9672 (if (eolp)
9673 (progn
9674 (replace-match "|" t t)
9675 (forward-line 1)
9676 (when (eobp)
9677 (setq finish t)))
9678 (replace-match "| " t t)))))
9679 (goto-char begin)
9680 (when markdown-table-align-p
9681 (markdown-table-align))))
9683 (defun markdown-insert-table (&optional rows columns align)
9684 "Insert an empty pipe table.
9685 Optional arguments ROWS, COLUMNS, and ALIGN specify number of
9686 rows and columns and the column alignment."
9687 (interactive)
9688 (let* ((rows (or rows (string-to-number (read-string "Row size: "))))
9689 (columns (or columns (string-to-number (read-string "Column size: "))))
9690 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): ")))
9691 (align (cond ((equal align "l") ":--")
9692 ((equal align "r") "--:")
9693 ((equal align "c") ":-:")
9694 (t "---")))
9695 (pos (point))
9696 (indent (make-string (current-column) ?\ ))
9697 (line (concat
9698 (apply 'concat indent "|"
9699 (make-list columns " |")) "\n"))
9700 (hline (apply 'concat indent "|"
9701 (make-list columns (concat align "|")))))
9702 (if (string-match
9703 "^[ \t]*$" (buffer-substring-no-properties
9704 (line-beginning-position) (point)))
9705 (beginning-of-line 1)
9706 (newline))
9707 (dotimes (_ rows) (insert line))
9708 (goto-char pos)
9709 (if (> rows 1)
9710 (progn
9711 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos)))
9712 (markdown-table-forward-cell)))
9715 ;;; ElDoc Support =============================================================
9717 (defun markdown-eldoc-function (&rest _ignored)
9718 "Return a helpful string when appropriate based on context.
9719 * Report URL when point is at a hidden URL.
9720 * Report language name when point is a code block with hidden markup."
9721 (cond
9722 ;; Hidden URL or reference for inline link
9723 ((and (or (thing-at-point-looking-at markdown-regex-link-inline)
9724 (thing-at-point-looking-at markdown-regex-link-reference))
9725 (or markdown-hide-urls markdown-hide-markup))
9726 (let* ((imagep (string-equal (match-string 1) "!"))
9727 (referencep (string-equal (match-string 5) "["))
9728 (link (match-string-no-properties 6))
9729 (edit-keys (markdown--substitute-command-keys
9730 (if imagep
9731 "\\[markdown-insert-image]"
9732 "\\[markdown-insert-link]")))
9733 (edit-str (propertize edit-keys 'face 'font-lock-constant-face))
9734 (object (if referencep "reference" "URL")))
9735 (format "Hidden %s (%s to edit): %s" object edit-str
9736 (if referencep
9737 (concat
9738 (propertize "[" 'face 'markdown-markup-face)
9739 (propertize link 'face 'markdown-reference-face)
9740 (propertize "]" 'face 'markdown-markup-face))
9741 (propertize link 'face 'markdown-url-face)))))
9742 ;; Hidden language name for fenced code blocks
9743 ((and (markdown-code-block-at-point-p)
9744 (not (get-text-property (point) 'markdown-pre))
9745 markdown-hide-markup)
9746 (let ((lang (save-excursion (markdown-code-block-lang))))
9747 (unless lang (setq lang "[unspecified]"))
9748 (format "Hidden code block language: %s (%s to toggle markup)"
9749 (propertize lang 'face 'markdown-language-keyword-face)
9750 (markdown--substitute-command-keys
9751 "\\[markdown-toggle-markup-hiding]"))))))
9754 ;;; Mode Definition ==========================================================
9756 (defun markdown-show-version ()
9757 "Show the version number in the minibuffer."
9758 (interactive)
9759 (message "markdown-mode, version %s" markdown-mode-version))
9761 (defun markdown-mode-info ()
9762 "Open the `markdown-mode' homepage."
9763 (interactive)
9764 (browse-url "https://jblevins.org/projects/markdown-mode/"))
9766 ;;;###autoload
9767 (define-derived-mode markdown-mode text-mode "Markdown"
9768 "Major mode for editing Markdown files."
9769 (when buffer-read-only
9770 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name)))
9771 (setq-local buffer-read-only nil)))
9772 ;; Natural Markdown tab width
9773 (setq tab-width 4)
9774 ;; Comments
9775 (setq-local comment-start "<!-- ")
9776 (setq-local comment-end " -->")
9777 (setq-local comment-start-skip "<!--[ \t]*")
9778 (setq-local comment-column 0)
9779 (setq-local comment-auto-fill-only-comments nil)
9780 (setq-local comment-use-syntax t)
9781 ;; Sentence
9782 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*")
9783 ;; Syntax
9784 (add-hook 'syntax-propertize-extend-region-functions
9785 #'markdown-syntax-propertize-extend-region nil t)
9786 (add-hook 'jit-lock-after-change-extend-region-functions
9787 #'markdown-font-lock-extend-region-function t t)
9788 (setq-local syntax-propertize-function #'markdown-syntax-propertize)
9789 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
9790 ;; Font lock.
9791 (setq font-lock-defaults
9792 '(markdown-mode-font-lock-keywords
9793 nil nil nil nil
9794 (font-lock-multiline . t)
9795 (font-lock-syntactic-face-function . markdown-syntactic-face)
9796 (font-lock-extra-managed-props
9797 . (composition display invisible rear-nonsticky
9798 keymap help-echo mouse-face))))
9799 (if markdown-hide-markup
9800 (add-to-invisibility-spec 'markdown-markup)
9801 (remove-from-invisibility-spec 'markdown-markup))
9802 ;; Wiki links
9803 (markdown-setup-wiki-link-hooks)
9804 ;; Math mode
9805 (when markdown-enable-math (markdown-toggle-math t))
9806 ;; Add a buffer-local hook to reload after file-local variables are read
9807 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t)
9808 ;; For imenu support
9809 (setq imenu-create-index-function
9810 (if markdown-nested-imenu-heading-index
9811 #'markdown-imenu-create-nested-index
9812 #'markdown-imenu-create-flat-index))
9814 ;; Defun movement
9815 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun)
9816 (setq-local end-of-defun-function #'markdown-end-of-defun)
9817 ;; Paragraph filling
9818 (setq-local fill-paragraph-function #'markdown-fill-paragraph)
9819 (setq-local paragraph-start
9820 ;; Should match start of lines that start or separate paragraphs
9821 (mapconcat #'identity
9823 "\f" ; starts with a literal line-feed
9824 "[ \t\f]*$" ; space-only line
9825 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9826 "[ \t]*[*+-][ \t]+" ; unordered list item
9827 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
9828 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
9829 "[ \t]*:[ \t]+" ; definition
9830 "^|" ; table or Pandoc line block
9832 "\\|"))
9833 (setq-local paragraph-separate
9834 ;; Should match lines that separate paragraphs without being
9835 ;; part of any paragraph:
9836 (mapconcat #'identity
9837 '("[ \t\f]*$" ; space-only line
9838 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9839 ;; The following is not ideal, but the Fill customization
9840 ;; options really only handle paragraph-starting prefixes,
9841 ;; not paragraph-ending suffixes:
9842 ".* $" ; line ending in two spaces
9843 "^#+"
9844 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext
9845 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
9846 "\\|"))
9847 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'")
9848 (setq-local adaptive-fill-regexp "\\s-*")
9849 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function)
9850 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph)
9851 ;; Outline mode
9852 (setq-local outline-regexp markdown-regex-header)
9853 (setq-local outline-level #'markdown-outline-level)
9854 ;; Cause use of ellipses for invisible text.
9855 (add-to-invisibility-spec '(outline . t))
9856 ;; ElDoc support
9857 (if (boundp 'eldoc-documentation-functions)
9858 (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t)
9859 (add-function :before-until (local 'eldoc-documentation-function)
9860 #'markdown-eldoc-function))
9861 ;; Inhibiting line-breaking:
9862 ;; Separating out each condition into a separate function so that users can
9863 ;; override if desired (with remove-hook)
9864 (add-hook 'fill-nobreak-predicate
9865 #'markdown-line-is-reference-definition-p nil t)
9866 (add-hook 'fill-nobreak-predicate
9867 #'markdown-pipe-at-bol-p nil t)
9869 ;; Indentation
9870 (setq-local indent-line-function markdown-indent-function)
9871 (setq-local indent-region-function #'markdown--indent-region)
9873 ;; Flyspell
9874 (setq-local flyspell-generic-check-word-predicate
9875 #'markdown-flyspell-check-word-p)
9877 ;; Electric quoting
9878 (add-hook 'electric-quote-inhibit-functions
9879 #'markdown--inhibit-electric-quote nil :local)
9881 ;; Make checkboxes buttons
9882 (when markdown-make-gfm-checkboxes-buttons
9883 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
9884 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t)
9885 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t))
9887 ;; edit-indirect
9888 (add-hook 'edit-indirect-after-commit-functions
9889 #'markdown--edit-indirect-after-commit-function
9890 nil 'local)
9892 ;; Marginalized headings
9893 (when markdown-marginalize-headers
9894 (add-hook 'window-configuration-change-hook
9895 #'markdown-marginalize-update-current nil t))
9897 ;; add live preview export hook
9898 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t)
9899 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t))
9901 ;;;###autoload
9902 (add-to-list 'auto-mode-alist
9903 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode))
9906 ;;; GitHub Flavored Markdown Mode ============================================
9908 (defun gfm--electric-pair-fence-code-block ()
9909 (when (and electric-pair-mode
9910 (not markdown-gfm-use-electric-backquote)
9911 (eql last-command-event ?`)
9912 (let ((count 0))
9913 (while (eql (char-before (- (point) count)) ?`)
9914 (cl-incf count))
9915 (= count 3))
9916 (eql (char-after) ?`))
9917 (save-excursion (insert (make-string 2 ?`)))))
9919 (defvar gfm-mode-hook nil
9920 "Hook run when entering GFM mode.")
9922 ;;;###autoload
9923 (define-derived-mode gfm-mode markdown-mode "GFM"
9924 "Major mode for editing GitHub Flavored Markdown files."
9925 (setq markdown-link-space-sub-char "-")
9926 (setq markdown-wiki-link-search-subdirectories t)
9927 (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p)
9928 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t)
9929 (markdown-gfm-parse-buffer-for-languages))
9932 ;;; Viewing modes =============================================================
9934 (defcustom markdown-hide-markup-in-view-modes t
9935 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
9936 :group 'markdown
9937 :type 'boolean
9938 :safe #'booleanp)
9940 (defvar markdown-view-mode-map
9941 (let ((map (make-sparse-keymap)))
9942 (define-key map (kbd "p") #'markdown-outline-previous)
9943 (define-key map (kbd "n") #'markdown-outline-next)
9944 (define-key map (kbd "f") #'markdown-outline-next-same-level)
9945 (define-key map (kbd "b") #'markdown-outline-previous-same-level)
9946 (define-key map (kbd "u") #'markdown-outline-up)
9947 (define-key map (kbd "DEL") #'scroll-down-command)
9948 (define-key map (kbd "SPC") #'scroll-up-command)
9949 (define-key map (kbd ">") #'end-of-buffer)
9950 (define-key map (kbd "<") #'beginning-of-buffer)
9951 (define-key map (kbd "q") #'kill-this-buffer)
9952 (define-key map (kbd "?") #'describe-mode)
9953 map)
9954 "Keymap for `markdown-view-mode'.")
9956 (defun markdown--filter-visible (beg end &optional delete)
9957 (let ((result "")
9958 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face)))
9959 (while (< beg end)
9960 (when (markdown--face-p beg invisible-faces)
9961 (cl-incf beg)
9962 (while (and (markdown--face-p beg invisible-faces) (< beg end))
9963 (cl-incf beg)))
9964 (let ((next (next-single-char-property-change beg 'invisible)))
9965 (unless (get-char-property beg 'invisible)
9966 (setq result (concat result (buffer-substring beg (min end next)))))
9967 (setq beg next)))
9968 (prog1 result
9969 (when delete
9970 (let ((inhibit-read-only t))
9971 (delete-region beg end))))))
9973 ;;;###autoload
9974 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View"
9975 "Major mode for viewing Markdown content."
9976 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
9977 (add-to-invisibility-spec 'markdown-markup)
9978 (setq-local filter-buffer-substring-function #'markdown--filter-visible)
9979 (read-only-mode 1))
9981 (defvar gfm-view-mode-map
9982 markdown-view-mode-map
9983 "Keymap for `gfm-view-mode'.")
9985 ;;;###autoload
9986 (define-derived-mode gfm-view-mode gfm-mode "GFM-View"
9987 "Major mode for viewing GitHub Flavored Markdown content."
9988 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
9989 (setq-local markdown-fontify-code-blocks-natively t)
9990 (setq-local filter-buffer-substring-function #'markdown--filter-visible)
9991 (add-to-invisibility-spec 'markdown-markup)
9992 (read-only-mode 1))
9995 ;;; Live Preview Mode ========================================================
9996 ;;;###autoload
9997 (define-minor-mode markdown-live-preview-mode
9998 "Toggle native previewing on save for a specific markdown file."
9999 :lighter " MD-Preview"
10000 (if markdown-live-preview-mode
10001 (if (markdown-live-preview-get-filename)
10002 (markdown-display-buffer-other-window (markdown-live-preview-export))
10003 (markdown-live-preview-mode -1)
10004 (user-error "Buffer %s does not visit a file" (current-buffer)))
10005 (markdown-live-preview-remove)))
10008 (provide 'markdown-mode)
10010 ;; Local Variables:
10011 ;; indent-tabs-mode: nil
10012 ;; coding: utf-8
10013 ;; End:
10014 ;;; markdown-mode.el ends here