1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2007-2023 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
10 ;; Package-Requires: ((emacs "27.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/>.
31 ;; See the README.md file for details.
46 (defvar jit-lock-start
)
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")
54 (declare-function mailcap-file-name-to-mime-type
"mailcap")
55 (declare-function dnd-get-local-file-name
"dnd")
58 (declare-function mailcap-mime-type-to-extension
"mailcap")
59 (declare-function file-name-with-extension
"files")
60 (declare-function yank-media-handler
"yank-media")
63 ;;; Constants =================================================================
65 (defconst markdown-mode-version
"2.7-alpha"
66 "Markdown mode version number.")
68 (defconst markdown-output-buffer-name
"*markdown-output*"
69 "Name of temporary buffer for markdown command output.")
72 ;;; Global Variables ==========================================================
74 (defvar markdown-reference-label-history nil
75 "History of used reference labels.")
77 (defvar markdown-live-preview-mode nil
78 "Sentinel variable for command `markdown-live-preview-mode'.")
80 (defvar markdown-gfm-language-history nil
81 "History list of languages used in the current buffer in GFM code blocks.")
83 (defvar markdown-follow-link-functions nil
84 "Functions used to follow a link.
85 Each function is called with one argument, the link's URL. It
86 should return non-nil if it followed the link, or nil if not.
87 Functions are called in order until one of them returns non-nil;
88 otherwise the default link-following function is used.")
91 ;;; Customizable Variables ====================================================
93 (defvar markdown-mode-hook nil
94 "Hook run when entering Markdown mode.")
96 (defvar markdown-before-export-hook nil
97 "Hook run before running Markdown to export XHTML output.
98 The hook may modify the buffer, which will be restored to it's
99 original state after exporting is complete.")
101 (defvar markdown-after-export-hook nil
102 "Hook run after XHTML output has been saved.
103 Any changes to the output buffer made by this hook will be saved.")
105 (defgroup markdown nil
106 "Major mode for editing text files in Markdown format."
109 :link
'(url-link "https://jblevins.org/projects/markdown-mode/"))
111 (defcustom markdown-command
(let ((command (cl-loop for cmd in
'("markdown" "pandoc" "markdown_py")
112 when
(executable-find cmd
)
113 return
(file-name-nondirectory it
))))
114 (or command
"markdown"))
115 "Command to run markdown."
117 :type
'(choice (string :tag
"Shell command") (repeat (string)) function
))
119 (defcustom markdown-command-needs-filename nil
120 "Set to non-nil if `markdown-command' does not accept input from stdin.
121 Instead, it will be passed a filename as the final command line
122 option. As a result, you will only be able to run Markdown from
123 buffers which are visiting a file."
127 (defcustom markdown-open-command nil
128 "Command used for opening Markdown files directly.
129 For example, a standalone Markdown previewer. This command will
130 be called with a single argument: the filename of the current
131 buffer. It can also be a function, which will be called without
134 :type
'(choice file function
(const :tag
"None" nil
)))
136 (defcustom markdown-open-image-command nil
137 "Command used for opening image files directly.
138 This is used at `markdown-follow-link-at-point'."
140 :type
'(choice file function
(const :tag
"None" nil
)))
142 (defcustom markdown-hr-strings
143 '("-------------------------------------------------------------------------------"
144 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
145 "---------------------------------------"
146 "* * * * * * * * * * * * * * * * * * * *"
149 "Strings to use when inserting horizontal rules.
150 The first string in the list will be the default when inserting a
151 horizontal rule. Strings should be listed in decreasing order of
152 prominence (as in headings from level one to six) for use with
153 promotion and demotion functions."
155 :type
'(repeat string
))
157 (defcustom markdown-bold-underscore nil
158 "Use two underscores when inserting bold text instead of two asterisks."
162 (defcustom markdown-italic-underscore nil
163 "Use underscores when inserting italic text instead of asterisks."
167 (defcustom markdown-marginalize-headers nil
168 "When non-nil, put opening atx header markup in a left margin.
170 This setting goes well with `markdown-asymmetric-header'. But
171 sadly it conflicts with `linum-mode' since they both use the
176 :package-version
'(markdown-mode .
"2.4"))
178 (defcustom markdown-marginalize-headers-margin-width
6
179 "Character width of margin used for marginalized headers.
180 The default value is based on there being six heading levels
181 defined by Markdown and HTML. Increasing this produces extra
182 whitespace on the left. Decreasing it may be preferred when
183 fewer than six nested heading levels are used."
187 :package-version
'(markdown-mode .
"2.4"))
189 (defcustom markdown-asymmetric-header nil
190 "Determines if atx header style will be asymmetric.
191 Set to a non-nil value to use asymmetric header styling, placing
192 header markup only at the beginning of the line. By default,
193 balanced markup will be inserted at the beginning and end of the
194 line around the header title."
198 (defcustom markdown-indent-function
'markdown-indent-line
199 "Function to use to indent."
203 (defcustom markdown-indent-on-enter t
204 "Determines indentation behavior when pressing \\[newline].
205 Possible settings are nil, t, and \\='indent-and-new-item.
207 When non-nil, pressing \\[newline] will call `newline-and-indent'
208 to indent the following line according to the context using
209 `markdown-indent-function'. In this case, note that
210 \\[electric-newline-and-maybe-indent] can still be used to insert
211 a newline without indentation.
213 When set to \\='indent-and-new-item and the point is in a list item
214 when \\[newline] is pressed, the list will be continued on the next
215 line, where a new item will be inserted.
217 When set to nil, simply call `newline' as usual. In this case,
218 you can still indent lines using \\[markdown-cycle] and continue
219 lists with \\[markdown-insert-list-item].
221 Note that this assumes the variable `electric-indent-mode' is
222 non-nil (enabled). When it is *disabled*, the behavior of
223 \\[newline] and `\\[electric-newline-and-maybe-indent]' are
226 :type
'(choice (const :tag
"Don't automatically indent" nil
)
227 (const :tag
"Automatically indent" t
)
228 (const :tag
"Automatically indent and insert new list items" indent-and-new-item
)))
230 (defcustom markdown-enable-wiki-links nil
231 "Syntax highlighting for wiki links.
232 Set this to a non-nil value to turn on wiki link support by default.
233 Support can be toggled later using the `markdown-toggle-wiki-links'
234 function or \\[markdown-toggle-wiki-links]."
238 :package-version
'(markdown-mode .
"2.2"))
240 (defcustom markdown-wiki-link-alias-first t
241 "When non-nil, treat aliased wiki links like [[alias text|PageName]].
242 Otherwise, they will be treated as [[PageName|alias text]]."
247 (defcustom markdown-wiki-link-search-subdirectories nil
248 "When non-nil, search for wiki link targets in subdirectories.
249 This is the default search behavior for GitHub and is
250 automatically set to t in `gfm-mode'."
254 :package-version
'(markdown-mode .
"2.2"))
256 (defcustom markdown-wiki-link-search-parent-directories nil
257 "When non-nil, search for wiki link targets in parent directories.
258 This is the default search behavior of Ikiwiki."
262 :package-version
'(markdown-mode .
"2.2"))
264 (defcustom markdown-wiki-link-search-type nil
265 "Searching type for markdown wiki link.
267 sub-directories: search for wiki link targets in sub directories
268 parent-directories: search for wiki link targets in parent directories
269 project: search for wiki link targets under project root"
272 (const :tag
"search wiki link from subdirectories" sub-directories
)
273 (const :tag
"search wiki link from parent directories" parent-directories
)
274 (const :tag
"search wiki link under project root" project
))
275 :package-version
'(markdown-mode .
"2.5"))
277 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories
'markdown-wiki-link-search-type
"2.5")
278 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories
'markdown-wiki-link-search-type
"2.5")
280 (defcustom markdown-wiki-link-fontify-missing nil
281 "When non-nil, change wiki link face according to existence of target files.
282 This is expensive because it requires checking for the file each time the buffer
283 changes or the user switches windows. It is disabled by default because it may
284 cause lag when typing on slower machines."
288 :package-version
'(markdown-mode .
"2.2"))
290 (defcustom markdown-uri-types
291 '("acap" "cid" "data" "dav" "fax" "file" "ftp"
292 "geo" "gopher" "http" "https" "imap" "ldap" "mailto"
293 "mid" "message" "modem" "news" "nfs" "nntp"
294 "pop" "prospero" "rtsp" "service" "sip" "tel"
295 "telnet" "tip" "urn" "vemmi" "wais")
296 "Link types for syntax highlighting of URIs."
298 :type
'(repeat (string :tag
"URI scheme")))
300 (defcustom markdown-url-compose-char
302 "Placeholder character for hidden URLs.
303 This may be a single character or a list of characters. In case
304 of a list, the first one that satisfies `char-displayable-p' will
307 (character :tag
"Single URL replacement character")
308 (repeat :tag
"List of possible URL replacement characters"
310 :package-version
'(markdown-mode .
"2.3"))
312 (defcustom markdown-blockquote-display-char
314 "String to display when hiding blockquote markup.
315 This may be a single string or a list of string. In case of a
316 list, the first one that satisfies `char-displayable-p' will be
319 (string :tag
"Single blockquote display string")
320 (repeat :tag
"List of possible blockquote display strings" string
))
321 :package-version
'(markdown-mode .
"2.3"))
323 (defcustom markdown-hr-display-char
325 "Character for hiding horizontal rule markup.
326 This may be a single character or a list of characters. In case
327 of a list, the first one that satisfies `char-displayable-p' will
331 (character :tag
"Single HR display character")
332 (repeat :tag
"List of possible HR display characters" character
))
333 :package-version
'(markdown-mode .
"2.3"))
335 (defcustom markdown-definition-display-char
337 "Character for replacing definition list markup.
338 This may be a single character or a list of characters. In case
339 of a list, the first one that satisfies `char-displayable-p' will
342 (character :tag
"Single definition list character")
343 (repeat :tag
"List of possible definition list characters" character
))
344 :package-version
'(markdown-mode .
"2.3"))
346 (defcustom markdown-enable-math nil
347 "Syntax highlighting for inline LaTeX and itex expressions.
348 Set this to a non-nil value to turn on math support by default.
349 Math support can be enabled, disabled, or toggled later using
350 `markdown-toggle-math' or \\[markdown-toggle-math]."
354 (make-variable-buffer-local 'markdown-enable-math
)
356 (defcustom markdown-enable-html t
357 "Enable font-lock support for HTML tags and attributes."
361 :package-version
'(markdown-mode .
"2.4"))
363 (defcustom markdown-enable-highlighting-syntax nil
364 "Enable highlighting syntax."
368 :package-version
'(markdown-mode .
"2.5"))
370 (defcustom markdown-css-paths nil
371 "List of URLs of CSS files to link to in the output XHTML."
373 :type
'(repeat (string :tag
"CSS File Path")))
375 (defcustom markdown-content-type
"text/html"
376 "Content type string for the http-equiv header in XHTML output.
377 When set to an empty string, this attribute is omitted. Defaults to
382 (defcustom markdown-coding-system nil
383 "Character set string for the http-equiv header in XHTML output.
384 Defaults to `buffer-file-coding-system' (and falling back to
385 `utf-8' when not available). Common settings are `iso-8859-1'
386 and `iso-latin-1'. Use `list-coding-systems' for more choices."
388 :type
'coding-system
)
390 (defcustom markdown-export-kill-buffer t
391 "Kill output buffer after HTML export.
392 When non-nil, kill the HTML output buffer after
393 exporting with `markdown-export'."
397 :package-version
'(markdown-mode .
"2.4"))
399 (defcustom markdown-xhtml-header-content
""
400 "Additional content to include in the XHTML <head> block."
404 (defcustom markdown-xhtml-body-preamble
""
405 "Content to include in the XHTML <body> block, before the output."
409 :package-version
'(markdown-mode .
"2.4"))
411 (defcustom markdown-xhtml-body-epilogue
""
412 "Content to include in the XHTML <body> block, after the output."
416 :package-version
'(markdown-mode .
"2.4"))
418 (defcustom markdown-xhtml-standalone-regexp
419 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
420 "Regexp indicating whether `markdown-command' output is standalone XHTML."
424 (defcustom markdown-link-space-sub-char
"_"
425 "Character to use instead of spaces when mapping wiki links to filenames."
429 (defcustom markdown-reference-location
'header
430 "Position where new reference definitions are inserted in the document."
432 :type
'(choice (const :tag
"At the end of the document" end
)
433 (const :tag
"Immediately after the current block" immediately
)
434 (const :tag
"At the end of the subtree" subtree
)
435 (const :tag
"Before next header" header
)))
437 (defcustom markdown-footnote-location
'end
438 "Position where new footnotes are inserted in the document."
440 :type
'(choice (const :tag
"At the end of the document" end
)
441 (const :tag
"Immediately after the current block" immediately
)
442 (const :tag
"At the end of the subtree" subtree
)
443 (const :tag
"Before next header" header
)))
445 (defcustom markdown-footnote-display
'((raise 0.2) (height 0.8))
446 "Display specification for footnote markers and inline footnotes.
447 By default, footnote text is reduced in size and raised. Set to
448 nil to disable this."
450 :type
'(choice (sexp :tag
"Display specification")
451 (const :tag
"Don't set display property" nil
))
452 :package-version
'(markdown-mode .
"2.4"))
454 (defcustom markdown-sub-superscript-display
455 '(((raise -
0.3) (height 0.7)) .
((raise 0.3) (height 0.7)))
456 "Display specification for subscript and superscripts.
457 The car is used for subscript, the cdr is used for superscripts."
459 :type
'(cons (choice (sexp :tag
"Subscript form")
460 (const :tag
"No lowering" nil
))
461 (choice (sexp :tag
"Superscript form")
462 (const :tag
"No raising" nil
)))
463 :package-version
'(markdown-mode .
"2.4"))
465 (defcustom markdown-unordered-list-item-prefix
" * "
466 "String inserted before unordered list items."
470 (defcustom markdown-ordered-list-enumeration t
471 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker.
472 While nil, always uses '1.' for the marker"
475 :package-version
'(markdown-mode .
"2.5"))
477 (defcustom markdown-nested-imenu-heading-index t
478 "Use nested or flat imenu heading index.
479 A nested index may provide more natural browsing from the menu,
480 but a flat list may allow for faster keyboard navigation via tab
485 :package-version
'(markdown-mode .
"2.2"))
487 (defcustom markdown-add-footnotes-to-imenu t
488 "Add footnotes to end of imenu heading index."
492 :package-version
'(markdown-mode .
"2.4"))
494 (defcustom markdown-make-gfm-checkboxes-buttons t
495 "When non-nil, make GFM checkboxes into buttons."
499 (defcustom markdown-use-pandoc-style-yaml-metadata nil
500 "When non-nil, allow YAML metadata anywhere in the document."
504 (defcustom markdown-split-window-direction
'any
505 "Preference for splitting windows for static and live preview.
506 The default value is \\='any, which instructs Emacs to use
507 `split-window-sensibly' to automatically choose how to split
508 windows based on the values of `split-width-threshold' and
509 `split-height-threshold' and the available windows. To force
510 vertically split (left and right) windows, set this to \\='vertical
511 or \\='right. To force horizontally split (top and bottom) windows,
512 set this to \\='horizontal or \\='below.
514 If this value is \\='any and `display-buffer-alist' is set then
515 `display-buffer' is used for open buffer function"
517 :type
'(choice (const :tag
"Automatic" any
)
518 (const :tag
"Right (vertical)" right
)
519 (const :tag
"Below (horizontal)" below
))
520 :package-version
'(markdown-mode .
"2.2"))
522 (defcustom markdown-live-preview-window-function
523 #'markdown-live-preview-window-eww
524 "Function to display preview of Markdown output within Emacs.
525 Function must update the buffer containing the preview and return
530 (defcustom markdown-live-preview-delete-export
'delete-on-destroy
531 "Delete exported HTML file when using `markdown-live-preview-export'.
532 If set to \\='delete-on-export, delete on every export. When set to
533 \\='delete-on-destroy delete when quitting from command
534 `markdown-live-preview-mode'. Never delete if set to nil."
537 (const :tag
"Delete on every export" delete-on-export
)
538 (const :tag
"Delete when quitting live preview" delete-on-destroy
)
539 (const :tag
"Never delete" nil
)))
541 (defcustom markdown-list-indent-width
4
542 "Depth of indentation for markdown lists.
543 Used in `markdown-demote-list-item' and
544 `markdown-promote-list-item'."
548 (defcustom markdown-enable-prefix-prompts t
549 "Display prompts for certain prefix commands.
550 Set to nil to disable these prompts."
554 :package-version
'(markdown-mode .
"2.3"))
556 (defcustom markdown-gfm-additional-languages nil
557 "Extra languages made available when inserting GFM code blocks.
558 Language strings must have be trimmed of whitespace and not
559 contain any curly braces. They may be of arbitrary
560 capitalization, though."
562 :type
'(repeat (string :validate markdown-validate-language-string
)))
564 (defcustom markdown-gfm-use-electric-backquote t
565 "Use `markdown-electric-backquote' when backquote is hit three times."
569 (defcustom markdown-gfm-downcase-languages t
570 "If non-nil, downcase suggested languages.
571 This applies to insertions done with
572 `markdown-electric-backquote'."
576 (defcustom markdown-edit-code-block-default-mode
'normal-mode
577 "Default mode to use for editing code blocks.
578 This mode is used when automatic detection fails, such as for GFM
579 code blocks with no language specified."
581 :type
'(choice function
(const :tag
"None" nil
))
582 :package-version
'(markdown-mode .
"2.4"))
584 (defcustom markdown-gfm-uppercase-checkbox nil
585 "If non-nil, use [X] for completed checkboxes, [x] otherwise."
590 (defcustom markdown-hide-urls nil
591 "Hide URLs of inline links and reference tags of reference links.
592 Such URLs will be replaced by a single customizable
593 character, defined by `markdown-url-compose-char', but are still part
594 of the buffer. Links can be edited interactively with
595 \\[markdown-insert-link] or, for example, by deleting the final
596 parenthesis to remove the invisibility property. You can also
597 hover your mouse pointer over the link text to see the URL.
598 Set this to a non-nil value to turn this feature on by default.
599 You can interactively set the value of this variable by calling
600 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
601 or from the menu Markdown > Links & Images menu."
605 :package-version
'(markdown-mode .
"2.3"))
606 (make-variable-buffer-local 'markdown-hide-urls
)
608 (defcustom markdown-translate-filename-function
#'identity
609 "Function to use to translate filenames when following links.
610 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
611 call this function with the filename as only argument whenever
612 they encounter a filename (instead of a URL) to be visited and
613 use its return value instead of the filename in the link. For
614 example, if absolute filenames are actually relative to a server
615 root directory, you can set
616 `markdown-translate-filename-function' to a function that
617 prepends the root directory to the given filename."
621 :package-version
'(markdown-mode .
"2.4"))
623 (defcustom markdown-max-image-size nil
624 "Maximum width and height for displayed inline images.
625 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
626 When nil, use the actual size. Otherwise, use ImageMagick to
627 resize larger images to be of the given maximum dimensions. This
628 requires Emacs to be built with ImageMagick support."
630 :package-version
'(markdown-mode .
"2.4")
632 (const :tag
"Use actual image width" nil
)
633 (cons (choice (sexp :tag
"Maximum width in pixels")
634 (const :tag
"No maximum width" nil
))
635 (choice (sexp :tag
"Maximum height in pixels")
636 (const :tag
"No maximum height" nil
)))))
638 (defcustom markdown-mouse-follow-link t
639 "Non-nil means mouse on a link will follow the link.
640 This variable must be set before loading markdown-mode."
644 :package-version
'(markdown-mode .
"2.5"))
646 (defcustom markdown-table-align-p t
647 "Non-nil means that table is aligned after table operation."
651 :package-version
'(markdown-mode .
"2.5"))
653 (defcustom markdown-fontify-whole-heading-line nil
654 "Non-nil means fontify the whole line for headings.
655 This is useful when setting a background color for the
656 markdown-header-face-* faces."
660 :package-version
'(markdown-mode .
"2.5"))
663 ;;; Markdown-Specific `rx' Macro ==============================================
665 ;; Based on python-rx from python.el.
667 (defconst markdown-rx-constituents
668 `((newline .
,(rx "\n"))
669 ;; Note: #405 not consider markdown-list-indent-width however this is never used
670 (indent .
,(rx (or (repeat 4 " ") "\t")))
671 (block-end .
,(rx (and (or (one-or-more (zero-or-more blank
) "\n") line-end
))))
672 (numeral .
,(rx (and (one-or-more (any "0-9#")) ".")))
673 (bullet .
,(rx (any "*+:-")))
674 (list-marker .
,(rx (or (and (one-or-more (any "0-9#")) ".")
676 (checkbox .
,(rx "[" (any " xX") "]")))
677 "Markdown-specific sexps for `markdown-rx'")
679 (defun markdown-rx-to-string (form &optional no-group
)
680 "Markdown mode specialized `rx-to-string' function.
681 This variant supports named Markdown expressions in FORM.
682 NO-GROUP non-nil means don't put shy groups around the result."
683 (let ((rx-constituents (append markdown-rx-constituents rx-constituents
)))
684 (rx-to-string form no-group
)))
686 (defmacro markdown-rx
(&rest regexps
)
687 "Markdown mode specialized rx macro.
688 This variant of `rx' supports common Markdown named REGEXPS."
689 (cond ((null regexps
)
692 (markdown-rx-to-string `(and ,@regexps
) t
))
694 (markdown-rx-to-string (car regexps
) t
)))))
697 ;;; Regular Expressions =======================================================
699 (defconst markdown-regex-comment-start
701 "Regular expression matches HTML comment opening.")
703 (defconst markdown-regex-comment-end
705 "Regular expression matches HTML comment closing.")
707 (defconst markdown-regex-link-inline
708 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)"
709 "Regular expression for a [text](file) or an image link ![text](file).
710 Group 1 matches the leading exclamation point (optional).
711 Group 2 matches the opening square bracket.
712 Group 3 matches the text inside the square brackets.
713 Group 4 matches the closing square bracket.
714 Group 5 matches the opening parenthesis.
715 Group 6 matches the URL.
716 Group 7 matches the title (optional).
717 Group 8 matches the closing parenthesis.")
719 (defconst markdown-regex-link-reference
720 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)"
721 "Regular expression for a reference link [text][id].
722 Group 1 matches the leading exclamation point (optional).
723 Group 2 matches the opening square bracket for the link text.
724 Group 3 matches the text inside the square brackets.
725 Group 4 matches the closing square bracket for the link text.
726 Group 5 matches the opening square bracket for the reference label.
727 Group 6 matches the reference label.
728 Group 7 matches the closing square bracket for the reference label.")
730 (defconst markdown-regex-reference-definition
731 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)"
732 "Regular expression for a reference definition.
733 Group 1 matches the opening square bracket.
734 Group 2 matches the reference label.
735 Group 3 matches the closing square bracket.
736 Group 4 matches the colon.
737 Group 5 matches the URL.
738 Group 6 matches the title attribute (optional).")
740 (defconst markdown-regex-footnote
741 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)"
742 "Regular expression for a footnote marker [^fn].
743 Group 1 matches the opening square bracket and carat.
744 Group 2 matches only the label, without the surrounding markup.
745 Group 3 matches the closing square bracket.")
747 (defconst markdown-regex-header
748 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$"
749 "Regexp identifying Markdown headings.
750 Group 1 matches the text of a setext heading.
751 Group 2 matches the underline of a level-1 setext heading.
752 Group 3 matches the underline of a level-2 setext heading.
753 Group 4 matches the opening hash marks of an atx heading and whitespace.
754 Group 5 matches the text, without surrounding whitespace, of an atx heading.
755 Group 6 matches the closing whitespace and hash marks of an atx heading.")
757 (defconst markdown-regex-header-setext
758 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
759 "Regular expression for generic setext-style (underline) headers.")
761 (defconst markdown-regex-header-atx
762 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
763 "Regular expression for generic atx-style (hash mark) headers.")
765 (defconst markdown-regex-hr
767 (group (or (and (repeat 3 (and "*" (?
" "))) (* (any "* ")))
768 (and (repeat 3 (and "-" (?
" "))) (* (any "- ")))
769 (and (repeat 3 (and "_" (?
" "))) (* (any "_ ")))))
771 "Regular expression for matching Markdown horizontal rules.")
773 (defconst markdown-regex-code
774 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)"
775 "Regular expression for matching inline code fragments.
777 Group 1 matches the entire code fragment including the backquotes.
778 Group 2 matches the opening backquotes.
779 Group 3 matches the code fragment itself, without backquotes.
780 Group 4 matches the closing backquotes.
782 The leading, unnumbered group ensures that the leading backquote
783 character is not escaped.
784 The last group, also unnumbered, requires that the character
785 following the code fragment is not a backquote.
786 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
787 but not two newlines in a row.")
789 (defconst markdown-regex-kbd
790 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)"
791 "Regular expression for matching <kbd> tags.
792 Groups 1 and 3 match the opening and closing tags.
793 Group 2 matches the key sequence.")
795 (defconst markdown-regex-gfm-code-block-open
796 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$"
797 "Regular expression matching opening of GFM code blocks.
798 Group 1 matches the opening three backquotes and any following whitespace.
799 Group 2 matches the opening brace (optional) and surrounding whitespace.
800 Group 3 matches the language identifier (optional).
801 Group 4 matches the info string (optional).
802 Group 5 matches the closing brace (optional), whitespace, and newline.
803 Groups need to agree with `markdown-regex-tilde-fence-begin'.")
805 (defconst markdown-regex-gfm-code-block-close
806 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$"
807 "Regular expression matching closing of GFM code blocks.
808 Group 1 matches the closing three backquotes.
809 Group 2 matches any whitespace and the final newline.")
811 (defconst markdown-regex-pre
813 "Regular expression for matching preformatted text sections.")
815 (defconst markdown-regex-list
816 (markdown-rx line-start
817 ;; 1. Leading whitespace
819 ;; 2. List marker: a numeral, bullet, or colon
821 ;; 3. Trailing whitespace
823 ;; 4. Optional checkbox for GFM task list items
824 (opt (group (and checkbox
(* blank
)))))
825 "Regular expression for matching list items.")
827 (defconst markdown-regex-bold
828 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)"
829 "Regular expression for matching bold text.
830 Group 1 matches the character before the opening asterisk or
831 underscore, if any, ensuring that it is not a backslash escape.
832 Group 2 matches the entire expression, including delimiters.
833 Groups 3 and 5 matches the opening and closing delimiters.
834 Group 4 matches the text inside the delimiters.")
836 (defconst markdown-regex-italic
837 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)"
838 "Regular expression for matching italic text.
839 The leading unnumbered matches the character before the opening
840 asterisk or underscore, if any, ensuring that it is not a
842 Group 1 matches the entire expression, including delimiters.
843 Groups 2 and 4 matches the opening and closing delimiters.
844 Group 3 matches the text inside the delimiters.")
846 (defconst markdown-regex-strike-through
847 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)"
848 "Regular expression for matching strike-through text.
849 Group 1 matches the character before the opening tilde, if any,
850 ensuring that it is not a backslash escape.
851 Group 2 matches the entire expression, including delimiters.
852 Groups 3 and 5 matches the opening and closing delimiters.
853 Group 4 matches the text inside the delimiters.")
855 (defconst markdown-regex-gfm-italic
856 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)"
857 "Regular expression for matching italic text in GitHub Flavored Markdown.
858 Underscores in words are not treated as special.
859 Group 1 matches the entire expression, including delimiters.
860 Groups 2 and 4 matches the opening and closing delimiters.
861 Group 3 matches the text inside the delimiters.")
863 (defconst markdown-regex-blockquote
864 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$"
865 "Regular expression for matching blockquote lines.
866 Also accounts for a potential capital letter preceding the angle
867 bracket, for use with Leanpub blocks (asides, warnings, info
869 Group 1 matches the leading angle bracket.
870 Group 2 matches the separating whitespace.
871 Group 3 matches the text.")
873 (defconst markdown-regex-line-break
874 "[^ \n\t][ \t]*\\( \\)\n"
875 "Regular expression for matching line breaks.")
877 (defconst markdown-regex-escape
879 "Regular expression for matching escape sequences.")
881 (defconst markdown-regex-wiki-link
882 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)"
883 "Regular expression for matching wiki links.
884 This matches typical bracketed [[WikiLinks]] as well as \\='aliased
885 wiki links of the form [[PageName|link text]].
886 The meanings of the first and second components depend
887 on the value of `markdown-wiki-link-alias-first'.
889 Group 1 matches the entire link.
890 Group 2 matches the opening square brackets.
891 Group 3 matches the first component of the wiki link.
892 Group 4 matches the pipe separator, when present.
893 Group 5 matches the second component of the wiki link, when present.
894 Group 6 matches the closing square brackets.")
896 (defconst markdown-regex-uri
897 (concat "\\(" (regexp-opt markdown-uri-types
) ":[^]\t\n\r<>; ]+\\)")
898 "Regular expression for matching inline URIs.")
900 ;; CommanMark specification says scheme length is 2-32 characters
901 (defconst markdown-regex-angle-uri
902 (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)")
903 "Regular expression for matching inline URIs in angle brackets.")
905 (defconst markdown-regex-email
906 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
907 "Regular expression for matching inline email addresses.")
909 (defsubst markdown-make-regex-link-generic
()
910 "Make regular expression for matching any recognized link."
911 (concat "\\(?:" markdown-regex-link-inline
912 (when markdown-enable-wiki-links
913 (concat "\\|" markdown-regex-wiki-link
))
914 "\\|" markdown-regex-link-reference
915 "\\|" markdown-regex-angle-uri
"\\)"))
917 (defconst markdown-regex-gfm-checkbox
918 " \\(\\[[ xX]\\]\\) "
919 "Regular expression for matching GFM checkboxes.
920 Group 1 matches the text to become a button.")
922 (defconst markdown-regex-blank-line
924 "Regular expression that matches a blank line.")
926 (defconst markdown-regex-block-separator
928 "Regular expression for matching block boundaries.")
930 (defconst markdown-regex-block-separator-noindent
931 (concat "\\(\\`\\|\\(" markdown-regex-block-separator
"\\)[^\n\t\f ]\\)")
932 "Regexp for block separators before lines with no indentation.")
934 (defconst markdown-regex-math-inline-single
935 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)"
936 "Regular expression for itex $..$ math mode expressions.
937 Groups 1 and 3 match the opening and closing dollar signs.
938 Group 2 matches the mathematical expression contained within.")
940 (defconst markdown-regex-math-inline-double
941 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)"
942 "Regular expression for itex $$..$$ math mode expressions.
943 Groups 1 and 3 match opening and closing dollar signs.
944 Group 2 matches the mathematical expression contained within.")
946 (defconst markdown-regex-math-display
947 (rx line-start
(* blank
)
948 (group (group (repeat 1 2 "\\")) "[")
949 (group (*? anything
))
950 (group (backref 2) "]")
952 "Regular expression for \[..\] or \\[..\\] display math.
953 Groups 1 and 4 match the opening and closing markup.
954 Group 3 matches the mathematical expression contained within.
955 Group 2 matches the opening slashes, and is used internally to
956 match the closing slashes.")
958 (defsubst markdown-make-tilde-fence-regex
(num-tildes &optional end-of-line
)
959 "Return regexp matching a tilde code fence at least NUM-TILDES long.
960 END-OF-LINE is the regexp construct to indicate end of line; $ if
962 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes
",\\}\\)"
963 (or end-of-line
"$")))
965 (defconst markdown-regex-tilde-fence-begin
966 (markdown-make-tilde-fence-regex
967 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
968 "Regular expression for matching tilde-fenced code blocks.
969 Group 1 matches the opening tildes.
970 Group 2 matches (optional) opening brace and surrounding whitespace.
971 Group 3 matches the language identifier (optional).
972 Group 4 matches the info string (optional).
973 Group 5 matches the closing brace (optional) and any surrounding whitespace.
974 Groups need to agree with `markdown-regex-gfm-code-block-open'.")
976 (defconst markdown-regex-declarative-metadata
977 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
978 "Regular expression for matching declarative metadata statements.
979 This matches MultiMarkdown metadata as well as YAML and TOML
980 assignments such as the following:
988 (defconst markdown-regex-pandoc-metadata
989 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
990 "Regular expression for matching Pandoc metadata.")
992 (defconst markdown-regex-yaml-metadata-border
994 "Regular expression for matching YAML metadata.")
996 (defconst markdown-regex-yaml-pandoc-metadata-end-border
997 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
998 "Regular expression for matching YAML metadata end borders.")
1000 (defsubst markdown-get-yaml-metadata-start-border
()
1001 "Return YAML metadata start border depending upon whether Pandoc is used."
1003 (if markdown-use-pandoc-style-yaml-metadata
"^" "\\`")
1004 markdown-regex-yaml-metadata-border
))
1006 (defsubst markdown-get-yaml-metadata-end-border
(_)
1007 "Return YAML metadata end border depending upon whether Pandoc is used."
1008 (if markdown-use-pandoc-style-yaml-metadata
1009 markdown-regex-yaml-pandoc-metadata-end-border
1010 markdown-regex-yaml-metadata-border
))
1012 (defconst markdown-regex-inline-attributes
1013 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$"
1014 "Regular expression for matching inline identifiers or attribute lists.
1015 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
1017 (defconst markdown-regex-leanpub-sections
1020 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
1021 "\\)\\(}\\)[ \t]*\n")
1022 "Regular expression for Leanpub section markers and related syntax.")
1024 (defconst markdown-regex-sub-superscript
1025 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)"
1026 "The regular expression matching a sub- or superscript.
1027 The leading un-numbered group matches the character before the
1028 opening tilde or carat, if any, ensuring that it is not a
1029 backslash escape, carat, or tilde.
1030 Group 1 matches the entire expression, including markup.
1031 Group 2 matches the opening markup--a tilde or carat.
1032 Group 3 matches the text inside the delimiters.
1033 Group 4 matches the closing markup--a tilde or carat.")
1035 (defconst markdown-regex-include
1036 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$"
1037 "Regular expression matching common forms of include syntax.
1038 Marked 2, Leanpub, and other processors support some of these forms:
1040 <<[sections/section1.md]
1042 <<[Code title](folder/filename)
1043 <<{folder/raw_file.html}
1045 Group 1 matches the opening two angle brackets.
1046 Groups 2-4 match the opening square bracket, the text inside,
1047 and the closing square bracket, respectively.
1048 Groups 5-7 match the opening parenthesis, the text inside, and
1049 the closing parenthesis.
1050 Groups 8-10 match the opening brace, the text inside, and the brace.")
1052 (defconst markdown-regex-pandoc-inline-footnote
1053 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)"
1054 "Regular expression for Pandoc inline footnote^[footnote text].
1055 Group 1 matches the opening caret.
1056 Group 2 matches the opening square bracket.
1057 Group 3 matches the footnote text, without the surrounding markup.
1058 Group 4 matches the closing square bracket.")
1060 (defconst markdown-regex-html-attr
1061 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
1062 "Regular expression for matching HTML attributes and values.
1063 Group 1 matches the attribute name.
1064 Group 2 matches the following whitespace, equals sign, and value, if any.
1065 Group 3 matches the equals sign, if any.
1066 Group 4 matches single-, double-, or un-quoted attribute values.")
1068 (defconst markdown-regex-html-tag
1069 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
1070 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
1071 "Regular expression for matching HTML tags.
1072 Groups 1 and 9 match the beginning and ending angle brackets and slashes.
1073 Group 2 matches the tag name.
1074 Group 3 matches all attributes and whitespace following the tag name.")
1076 (defconst markdown-regex-html-entity
1077 "\\(&#?[[:alnum:]]+;\\)"
1078 "Regular expression for matching HTML entities.")
1080 (defconst markdown-regex-highlighting
1081 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)"
1082 "Regular expression for matching highlighting text.
1083 Group 1 matches the character before the opening equal, if any,
1084 ensuring that it is not a backslash escape.
1085 Group 2 matches the entire expression, including delimiters.
1086 Groups 3 and 5 matches the opening and closing delimiters.
1087 Group 4 matches the text inside the delimiters.")
1090 ;;; Syntax ====================================================================
1092 (defvar markdown--syntax-properties
1093 (list 'markdown-tilde-fence-begin nil
1094 'markdown-tilde-fence-end nil
1095 'markdown-fenced-code nil
1096 'markdown-yaml-metadata-begin nil
1097 'markdown-yaml-metadata-end nil
1098 'markdown-yaml-metadata-section nil
1099 'markdown-gfm-block-begin nil
1100 'markdown-gfm-block-end nil
1101 'markdown-gfm-code nil
1102 'markdown-list-item nil
1104 'markdown-blockquote nil
1106 'markdown-comment nil
1107 'markdown-heading nil
1108 'markdown-heading-1-setext nil
1109 'markdown-heading-2-setext nil
1110 'markdown-heading-1-atx nil
1111 'markdown-heading-2-atx nil
1112 'markdown-heading-3-atx nil
1113 'markdown-heading-4-atx nil
1114 'markdown-heading-5-atx nil
1115 'markdown-heading-6-atx nil
1116 'markdown-metadata-key nil
1117 'markdown-metadata-value nil
1118 'markdown-metadata-markup nil
)
1119 "Property list of all Markdown syntactic properties.")
1121 (defvar markdown-literal-faces
1122 '(markdown-inline-code-face
1126 markdown-plain-url-face
1127 markdown-language-keyword-face
1128 markdown-language-info-face
1129 markdown-metadata-key-face
1130 markdown-metadata-value-face
1131 markdown-html-entity-face
1132 markdown-html-tag-name-face
1133 markdown-html-tag-delimiter-face
1134 markdown-html-attr-name-face
1135 markdown-html-attr-value-face
1136 markdown-reference-face
1137 markdown-footnote-marker-face
1138 markdown-line-break-face
1139 markdown-comment-face
)
1140 "A list of markdown-mode faces that contain literal text.
1141 Literal text treats backslashes literally, rather than as an
1142 escape character (see `markdown-match-escape').")
1144 (defsubst markdown-in-comment-p
(&optional pos
)
1145 "Return non-nil if POS is in a comment.
1146 If POS is not given, use point instead."
1147 (get-text-property (or pos
(point)) 'markdown-comment
))
1149 (defun markdown--face-p (pos faces
)
1150 "Return non-nil if face of POS contain FACES."
1151 (let ((face-prop (get-text-property pos
'face
)))
1152 (if (listp face-prop
)
1153 (cl-loop for face in face-prop
1154 thereis
(memq face faces
))
1155 (memq face-prop faces
))))
1157 (defsubst markdown--math-block-p
(&optional pos
)
1158 (when markdown-enable-math
1159 (markdown--face-p (or pos
(point)) '(markdown-math-face))))
1161 (defun markdown-syntax-propertize-extend-region (start end
)
1162 "Extend START to END region to include an entire block of text.
1163 This helps improve syntax analysis for block constructs.
1164 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
1165 Function is called repeatedly until it returns nil. For details, see
1166 `syntax-propertize-extend-region-functions'."
1169 (let* ((new-start (progn (goto-char start
)
1170 (skip-chars-forward "\n")
1171 (if (re-search-backward "\n\n" nil t
)
1172 (min start
(match-end 0))
1174 (new-end (progn (goto-char end
)
1175 (skip-chars-backward "\n")
1176 (if (re-search-forward "\n\n" nil t
)
1177 (max end
(match-beginning 0))
1179 (code-match (markdown-code-block-at-pos new-start
))
1180 ;; FIXME: The `code-match' can return bogus values
1181 ;; when text has been inserted/deleted!
1182 (new-start (min (or (and code-match
(cl-first code-match
))
1185 (code-match (and (< end
(point-max))
1186 (markdown-code-block-at-pos end
)))
1187 (new-end (max (or (and code-match
(cl-second code-match
)) 0)
1190 (unless (and (eq new-start start
) (eq new-end end
))
1191 (cons new-start
(min new-end
(point-max))))))))
1193 (defun markdown-font-lock-extend-region-function (start end _
)
1194 "Used in `jit-lock-after-change-extend-region-functions'.
1195 Delegates to `markdown-syntax-propertize-extend-region'. START
1196 and END are the previous region to refontify."
1197 (let ((res (markdown-syntax-propertize-extend-region start end
)))
1199 ;; syntax-propertize-function is not called when character at
1200 ;; (point-max) is deleted, but font-lock-extend-region-functions
1201 ;; are called. Force a syntax property update in that case.
1202 (when (= end
(point-max))
1203 ;; This function is called in a buffer modification hook.
1204 ;; `markdown-syntax-propertize' doesn't save the match data,
1205 ;; so we have to do it here.
1207 (markdown-syntax-propertize (car res
) (cdr res
))))
1208 (setq jit-lock-start
(car res
)
1209 jit-lock-end
(cdr res
)))))
1211 (defun markdown--cur-list-item-bounds ()
1212 "Return a list describing the list item at point.
1213 Assumes that match data is set for `markdown-regex-list'. See the
1214 documentation for `markdown-cur-list-item-bounds' for the format of
1217 (let* ((begin (match-beginning 0))
1218 (indent (length (match-string-no-properties 1)))
1219 (nonlist-indent (- (match-end 3) (match-beginning 0)))
1220 (marker (buffer-substring-no-properties
1221 (match-beginning 2) (match-end 3)))
1222 (checkbox (match-string-no-properties 4))
1223 (match (butlast (match-data t
)))
1224 (end (markdown-cur-list-item-end nonlist-indent
)))
1225 (list begin end indent nonlist-indent marker checkbox match
))))
1227 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds
)
1228 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
1229 Here, MARKER is a string representing the type of list and INDENT
1230 is an integer giving the indentation, in spaces, of the current
1231 block. CUR-BOUNDS is a list of the form returned by
1232 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
1233 values for parent list items. When BOUNDS is nil, it means we are
1234 at baseline (not inside of a nested list)."
1235 (let ((prev-indent (or (cl-third (car bounds
)) 0)))
1237 ;; New list item at baseline.
1238 ((and marker
(null bounds
))
1240 ;; List item with greater indentation (four or more spaces).
1241 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
1242 ((and marker
(>= indent
(+ prev-indent markdown-list-indent-width
)))
1243 (cons cur-bounds bounds
))
1244 ;; List item with greater or equal indentation (less than four spaces).
1245 ;; Keep list level the same by replacing the car of BOUNDS.
1246 ((and marker
(>= indent prev-indent
))
1247 (cons cur-bounds
(cdr bounds
)))
1248 ;; Lesser indentation level.
1249 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
1250 ;; indentation could move back more than one list level). Note
1251 ;; that this block need not be the beginning of list item.
1252 ((< indent prev-indent
)
1253 (while (and (> (length bounds
) 1)
1254 (setq prev-indent
(cl-third (cadr bounds
)))
1255 (< indent
(+ prev-indent markdown-list-indent-width
)))
1256 (setq bounds
(cdr bounds
)))
1257 (cons cur-bounds bounds
))
1258 ;; Otherwise, do nothing.
1261 (defun markdown-syntax-propertize-list-items (start end
)
1262 "Propertize list items from START to END.
1263 Stores nested list item information in the `markdown-list-item'
1264 text property to make later syntax analysis easier. The value of
1265 this property is a list with elements of the form (begin . end)
1266 giving the bounds of the current and parent list items."
1269 (let ((prev-list-line -
100)
1270 bounds level pre-regexp
)
1271 ;; Find a baseline point with zero list indentation
1272 (markdown-search-backward-baseline)
1273 ;; Search for all list items between baseline and END
1274 (while (and (< (point) end
)
1275 (re-search-forward markdown-regex-list end
'limit
))
1276 ;; Level of list nesting
1277 (setq level
(length bounds
))
1278 ;; Pre blocks need to be indented one level past the list level
1279 (setq pre-regexp
(format "^\\( \\|\t\\)\\{%d\\}" (1+ level
)))
1282 ;; Reset at headings, horizontal rules, and top-level blank lines.
1283 ;; Propertize baseline when in range.
1284 ((markdown-new-baseline)
1286 ;; Make sure this is not a line from a pre block
1287 ((and (looking-at-p pre-regexp
)
1288 ;; too indented line is also treated as list if previous line is list
1289 (>= (- (line-number-at-pos) prev-list-line
) 2)))
1290 ;; If not, then update levels and propertize list item when in range.
1292 (let* ((indent (current-indentation))
1293 (cur-bounds (markdown--cur-list-item-bounds))
1294 (first (cl-first cur-bounds
))
1295 (last (cl-second cur-bounds
))
1296 (marker (cl-fifth cur-bounds
)))
1297 (setq bounds
(markdown--append-list-item-bounds
1298 marker indent cur-bounds bounds
))
1299 (when (and (<= start
(point)) (<= (point) end
))
1300 (setq prev-list-line
(line-number-at-pos first
))
1301 (put-text-property first last
'markdown-list-item bounds
)))))
1304 (defun markdown-syntax-propertize-pre-blocks (start end
)
1305 "Match preformatted text blocks from START to END."
1309 ;; Use loop for avoiding too many recursive calls
1310 ;; https://github.com/jrblevin/markdown-mode/issues/512
1312 (let ((levels (markdown-calculate-list-levels))
1313 indent pre-regexp close-regexp open close
)
1314 (while (and (< (point) end
) (not close
))
1315 ;; Search for a region with sufficient indentation
1318 (setq indent
(1+ (length levels
))))
1319 (setq pre-regexp
(format "^\\( \\|\t\\)\\{%d\\}" indent
))
1320 (setq close-regexp
(format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent
)))
1323 ;; If not at the beginning of a line, move forward
1324 ((not (bolp)) (forward-line))
1325 ;; Move past blank lines
1326 ((markdown-cur-line-blank-p) (forward-line))
1327 ;; At headers and horizontal rules, reset levels
1328 ((markdown-new-baseline) (forward-line) (setq levels nil
))
1329 ;; If the current line has sufficient indentation, mark out pre block
1330 ;; The opening should be preceded by a blank line.
1331 ((and (markdown-prev-line-blank) (looking-at pre-regexp
))
1332 (setq open
(match-beginning 0))
1333 (while (and (or (looking-at-p pre-regexp
) (markdown-cur-line-blank-p))
1336 (skip-syntax-backward "-")
1338 (setq close
(point)))
1339 ;; If current line has a list marker, update levels, move to end of block
1340 ((looking-at markdown-regex-list
)
1341 (setq levels
(markdown-update-list-levels
1342 (match-string 2) (current-indentation) levels
))
1343 (markdown-end-of-text-block))
1344 ;; If this is the end of the indentation level, adjust levels accordingly.
1345 ;; Only match end of indentation level if levels is not the empty list.
1346 ((and (car levels
) (looking-at-p close-regexp
))
1347 (setq levels
(markdown-update-list-levels
1348 nil
(current-indentation) levels
))
1349 (markdown-end-of-text-block))
1350 (t (markdown-end-of-text-block))))
1352 (if (and open close
)
1353 ;; Set text property data and continue to search
1354 (put-text-property open close
'markdown-pre
(list open close
))
1358 (defconst markdown-fenced-block-pairs
1359 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin
)
1360 (markdown-make-tilde-fence-regex markdown-tilde-fence-end
)
1361 markdown-fenced-code
)
1362 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin
)
1363 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end
)
1364 markdown-yaml-metadata-section
)
1365 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin
)
1366 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end
)
1368 "Mapping of regular expressions to \"fenced-block\" constructs.
1369 These constructs are distinguished by having a distinctive start
1370 and end pattern, both of which take up an entire line of text,
1371 but no special pattern to identify text within the fenced
1372 blocks (unlike blockquotes and indented-code sections).
1374 Each element within this list takes the form:
1376 ((START-REGEX-OR-FUN START-PROPERTY)
1377 (END-REGEX-OR-FUN END-PROPERTY)
1380 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
1381 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
1382 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
1383 which is the length of the first group of the START-REGEX-OR-FUN match, which
1384 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
1385 evaluate these into \"real\" regexps.
1387 The *-PROPERTY elements are the text properties applied to each part of the
1388 block construct when it is matched using
1389 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
1390 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
1391 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
1392 `match-data' when the regexp was matched to the text. In the case of
1393 MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with
1394 begin and end set to the edges of the \"middle\" text. This makes fontification
1397 (defun markdown-text-property-at-point (prop)
1398 (get-text-property (point) prop
))
1400 (defsubst markdown-maybe-funcall-regexp
(object &optional arg
)
1401 (cond ((functionp object
)
1402 (if arg
(funcall object arg
) (funcall object
)))
1403 ((stringp object
) object
)
1404 (t (error "Object cannot be turned into regex"))))
1406 (defsubst markdown-get-start-fence-regexp
()
1407 "Return regexp to find all \"start\" sections of fenced block constructs.
1408 Which construct is actually contained in the match must be found separately."
1411 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry
)))
1412 markdown-fenced-block-pairs
)
1415 (defun markdown-get-fenced-block-begin-properties ()
1416 (cl-mapcar (lambda (entry) (cl-cadar entry
)) markdown-fenced-block-pairs
))
1418 (defun markdown-get-fenced-block-end-properties ()
1419 (cl-mapcar (lambda (entry) (cl-cadadr entry
)) markdown-fenced-block-pairs
))
1421 (defun markdown-get-fenced-block-middle-properties ()
1422 (cl-mapcar #'cl-third markdown-fenced-block-pairs
))
1424 (defun markdown-find-previous-prop (prop &optional lim
)
1425 "Find previous place where property PROP is non-nil, up to LIM.
1426 Return a cons of (pos . property). pos is point if point contains
1429 (if (get-text-property (point) prop
) (point)
1430 (previous-single-property-change
1431 (point) prop nil
(or lim
(point-min))))))
1432 (when (and (not (get-text-property res prop
))
1434 (get-text-property (1- res
) prop
))
1436 (when (and res
(get-text-property res prop
)) (cons res prop
))))
1438 (defun markdown-find-next-prop (prop &optional lim
)
1439 "Find next place where property PROP is non-nil, up to LIM.
1440 Return a cons of (POS . PROPERTY) where POS is point if point
1441 contains non-nil PROP."
1443 (if (get-text-property (point) prop
) (point)
1444 (next-single-property-change
1445 (point) prop nil
(or lim
(point-max))))))
1446 (when (and res
(get-text-property res prop
)) (cons res prop
))))
1448 (defun markdown-min-of-seq (map-fn seq
)
1449 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
1450 (cl-loop for el in seq
1451 with min
= 1.0e
+INF
; infinity
1453 do
(let ((res (funcall map-fn el
)))
1457 finally return min-el
))
1459 (defun markdown-max-of-seq (map-fn seq
)
1460 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
1461 (cl-loop for el in seq
1462 with max
= -
1.0e
+INF
; negative infinity
1464 do
(let ((res (funcall map-fn el
)))
1465 (when (and res
(> res max
))
1468 finally return max-el
))
1470 (defun markdown-find-previous-block ()
1471 "Find previous block.
1472 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
1473 unable to propertize the entire block, but was able to propertize the beginning
1474 of the block. If so, return a cons of (pos . property) where the beginning of
1475 the block was propertized."
1476 (let ((start-pt (point))
1478 (markdown-max-of-seq
1483 #'markdown-find-previous-prop
1484 (markdown-get-fenced-block-begin-properties))))))
1486 (let* ((length-of-open-match
1488 (get-text-property (car closest-open
) (cdr closest-open
))))
1489 (- (cl-fourth match-d
) (cl-third match-d
))))
1491 (markdown-maybe-funcall-regexp
1494 (lambda (entry) (eq (cl-cadar entry
) (cdr closest-open
)))
1495 markdown-fenced-block-pairs
))
1496 length-of-open-match
))
1500 (goto-char (car closest-open
))
1501 (and (re-search-forward end-regexp start-pt t
)
1502 (match-beginning 0))))))
1503 (and (not end-prop-loc
) closest-open
)))))
1505 (defun markdown-get-fenced-block-from-start (prop)
1506 "Return limits of an enclosing fenced block from its start, using PROP.
1507 Return value is a list usable as `match-data'."
1508 (catch 'no-rest-of-block
1509 (let* ((correct-entry
1511 (lambda (entry) (eq (cl-cadar entry
) prop
))
1512 markdown-fenced-block-pairs
))
1513 (begin-of-begin (cl-first (markdown-text-property-at-point prop
)))
1514 (middle-prop (cl-third correct-entry
))
1515 (end-prop (cl-cadadr correct-entry
))
1518 (goto-char (match-end 0)) ; end of begin
1519 (unless (eobp) (forward-char))
1520 (let ((mid-prop-v (markdown-text-property-at-point middle-prop
)))
1521 (if (not mid-prop-v
) ; no middle
1523 ;; try to find end by advancing one
1525 (markdown-text-property-at-point end-prop
)))
1526 (if end-prop-v
(cl-second end-prop-v
)
1527 (throw 'no-rest-of-block nil
))))
1528 (set-match-data mid-prop-v
)
1529 (goto-char (match-end 0)) ; end of middle
1530 (beginning-of-line) ; into end
1531 (cl-second (markdown-text-property-at-point end-prop
)))))))
1532 (list begin-of-begin end-of-end
))))
1534 (defun markdown-get-fenced-block-from-middle (prop)
1535 "Return limits of an enclosing fenced block from its middle, using PROP.
1536 Return value is a list usable as `match-data'."
1537 (let* ((correct-entry
1539 (lambda (entry) (eq (cl-third entry
) prop
))
1540 markdown-fenced-block-pairs
))
1541 (begin-prop (cl-cadar correct-entry
))
1544 (goto-char (match-beginning 0))
1545 (unless (bobp) (forward-line -
1))
1547 (cl-first (markdown-text-property-at-point begin-prop
))))
1548 (end-prop (cl-cadadr correct-entry
))
1551 (goto-char (match-end 0))
1553 (cl-second (markdown-text-property-at-point end-prop
)))))
1554 (list begin-of-begin end-of-end
)))
1556 (defun markdown-get-fenced-block-from-end (prop)
1557 "Return limits of an enclosing fenced block from its end, using PROP.
1558 Return value is a list usable as `match-data'."
1559 (let* ((correct-entry
1561 (lambda (entry) (eq (cl-cadadr entry
) prop
))
1562 markdown-fenced-block-pairs
))
1563 (end-of-end (cl-second (markdown-text-property-at-point prop
)))
1564 (middle-prop (cl-third correct-entry
))
1565 (begin-prop (cl-cadar correct-entry
))
1568 (goto-char (match-beginning 0)) ; beginning of end
1569 (unless (bobp) (backward-char)) ; into middle
1570 (let ((mid-prop-v (markdown-text-property-at-point middle-prop
)))
1571 (if (not mid-prop-v
)
1574 (cl-first (markdown-text-property-at-point begin-prop
)))
1575 (set-match-data mid-prop-v
)
1576 (goto-char (match-beginning 0)) ; beginning of middle
1577 (unless (bobp) (forward-line -
1)) ; into beginning
1579 (cl-first (markdown-text-property-at-point begin-prop
)))))))
1580 (list begin-of-begin end-of-end
)))
1582 (defun markdown-get-enclosing-fenced-block-construct (&optional pos
)
1583 "Get \"fake\" match data for block enclosing POS.
1584 Returns fake match data which encloses the start, middle, and end
1585 of the block construct enclosing POS, if it exists. Used in
1586 `markdown-code-block-at-pos'."
1588 (when pos
(goto-char pos
))
1594 (lambda (fun-and-prop)
1595 (cl-destructuring-bind (fun prop
) fun-and-prop
1598 (set-match-data (markdown-text-property-at-point prop
))
1599 (funcall fun prop
)))))
1600 `((markdown-get-fenced-block-from-start
1602 #'markdown-text-property-at-point
1603 (markdown-get-fenced-block-begin-properties)))
1604 (markdown-get-fenced-block-from-middle
1606 #'markdown-text-property-at-point
1607 (markdown-get-fenced-block-middle-properties)))
1608 (markdown-get-fenced-block-from-end
1610 #'markdown-text-property-at-point
1611 (markdown-get-fenced-block-end-properties)))))))))
1613 (defun markdown-propertize-end-match (reg end fence-spec middle-begin
)
1614 "Get match for REG up to END, if exists, and propertize appropriately.
1615 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
1616 MIDDLE-BEGIN is the start of the \"middle\" section of the block."
1617 (when (re-search-forward reg end t
)
1618 (let ((close-begin (match-beginning 0)) ; Start of closing line.
1619 (close-end (match-end 0)) ; End of closing line.
1620 (close-data (match-data t
))) ; Match data for closing line.
1621 ;; Propertize middle section of fenced block.
1622 (put-text-property middle-begin close-begin
1623 (cl-third fence-spec
)
1624 (list middle-begin close-begin
))
1625 ;; If the block is a YAML block, propertize the declarations inside
1626 (when (< middle-begin close-begin
) ;; workaround #634
1627 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin
))
1628 ;; Propertize closing line of fenced block.
1629 (put-text-property close-begin close-end
1630 (cl-cadadr fence-spec
) close-data
))))
1632 (defun markdown--triple-quote-single-line-p (begin)
1636 (and (search-forward "```" nil t
)
1637 (search-forward "```" (line-end-position) t
)))))
1639 (defun markdown-syntax-propertize-fenced-block-constructs (start end
)
1640 "Propertize according to `markdown-fenced-block-pairs' from START to END.
1641 If unable to propertize an entire block (if the start of a block is within START
1642 and END, but the end of the block is not), propertize the start section of a
1643 block, then in a subsequent call propertize both middle and end by finding the
1644 start which was previously propertized."
1645 (let ((start-reg (markdown-get-start-fence-regexp)))
1648 ;; start from previous unclosed block, if exists
1649 (let ((prev-begin-block (markdown-find-previous-block)))
1650 (when prev-begin-block
1651 (let* ((correct-entry
1652 (cl-find-if (lambda (entry)
1653 (eq (cdr prev-begin-block
) (cl-cadar entry
)))
1654 markdown-fenced-block-pairs
))
1655 (enclosed-text-start (1+ (car prev-begin-block
)))
1658 (goto-char (car prev-begin-block
))
1660 (markdown-maybe-funcall-regexp
1661 (caar correct-entry
))
1663 (line-beginning-position) (line-end-position)))
1664 (- (match-end 1) (match-beginning 1))))
1665 (end-reg (markdown-maybe-funcall-regexp
1666 (cl-caadr correct-entry
) start-length
)))
1667 (markdown-propertize-end-match
1668 end-reg end correct-entry enclosed-text-start
))))
1669 ;; find all new blocks within region
1670 (while (re-search-forward start-reg end t
)
1671 ;; we assume the opening constructs take up (only) an entire line,
1672 ;; so we re-check the current line
1673 (let* ((block-start (match-beginning 0))
1674 (cur-line (buffer-substring (line-beginning-position) (line-end-position)))
1675 ;; find entry in `markdown-fenced-block-pairs' corresponding
1676 ;; to regex which was matched
1679 (lambda (fenced-pair)
1681 (markdown-maybe-funcall-regexp (caar fenced-pair
))
1683 markdown-fenced-block-pairs
))
1684 (enclosed-text-start
1685 (save-excursion (1+ (line-end-position))))
1687 (markdown-maybe-funcall-regexp
1688 (cl-caadr correct-entry
)
1689 (if (and (match-beginning 1) (match-end 1))
1690 (- (match-end 1) (match-beginning 1))
1692 (prop (cl-cadar correct-entry
)))
1693 (when (or (not (eq prop
'markdown-gfm-block-begin
))
1694 (not (markdown--triple-quote-single-line-p block-start
)))
1695 ;; get correct match data
1699 (markdown-maybe-funcall-regexp (caar correct-entry
))
1700 (line-end-position)))
1701 ;; mark starting, even if ending is outside of region
1702 (put-text-property (match-beginning 0) (match-end 0) prop
(match-data t
))
1703 (markdown-propertize-end-match
1704 end-reg end correct-entry enclosed-text-start
)))))))
1706 (defun markdown-syntax-propertize-blockquotes (start end
)
1707 "Match blockquotes from START to END."
1710 (while (and (re-search-forward markdown-regex-blockquote end t
)
1711 (not (markdown-code-block-at-pos (match-beginning 0))))
1712 (put-text-property (match-beginning 0) (match-end 0)
1713 'markdown-blockquote
1716 (defun markdown-syntax-propertize-hrs (start end
)
1717 "Match horizontal rules from START to END."
1720 (while (re-search-forward markdown-regex-hr end t
)
1721 (let ((beg (match-beginning 0))
1722 (end (match-end 0)))
1724 (unless (or (markdown-on-heading-p)
1725 (markdown-code-block-at-point-p))
1726 (put-text-property beg end
'markdown-hr
(match-data t
)))
1729 (defun markdown-syntax-propertize-yaml-metadata (start end
)
1730 "Propertize elements inside YAML metadata blocks from START to END.
1731 Assumes region from START and END is already known to be the interior
1732 region of a YAML metadata block as propertized by
1733 `markdown-syntax-propertize-fenced-block-constructs'."
1737 while
(re-search-forward markdown-regex-declarative-metadata end t
)
1739 (put-text-property (match-beginning 1) (match-end 1)
1740 'markdown-metadata-key
(match-data t
))
1741 (put-text-property (match-beginning 2) (match-end 2)
1742 'markdown-metadata-markup
(match-data t
))
1743 (put-text-property (match-beginning 3) (match-end 3)
1744 'markdown-metadata-value
(match-data t
))))))
1746 (defun markdown-syntax-propertize-headings (start end
)
1747 "Match headings of type SYMBOL with REGEX from START to END."
1749 (while (re-search-forward markdown-regex-header end t
)
1750 (unless (markdown-code-block-at-pos (match-beginning 0))
1752 (match-beginning 0) (match-end 0) 'markdown-heading
1755 (match-beginning 0) (match-end 0)
1756 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext
)
1757 ((match-string-no-properties 3) 'markdown-heading-2-setext
)
1758 (t (let ((atx-level (length (markdown-trim-whitespace
1759 (match-string-no-properties 4)))))
1760 (intern (format "markdown-heading-%d-atx" atx-level
)))))
1763 (defun markdown-syntax-propertize-comments (start end
)
1764 "Match HTML comments from the START to END."
1765 ;; Implement by loop instead of recursive call for avoiding
1766 ;; exceed max-lisp-eval-depth issue
1767 ;; https://github.com/jrblevin/markdown-mode/issues/536
1771 (let* ((in-comment (nth 4 (syntax-ppss)))
1772 (comment-begin (nth 8 (syntax-ppss))))
1775 ((and (not in-comment
)
1776 (re-search-forward markdown-regex-comment-start end t
)
1777 (not (markdown-inline-code-at-point-p))
1778 (not (markdown-code-block-at-point-p)))
1779 (let ((open-beg (match-beginning 0)))
1780 (put-text-property open-beg
(1+ open-beg
)
1781 'syntax-table
(string-to-syntax "<"))
1782 (goto-char (min (1+ (match-end 0)) end
(point-max)))))
1784 ((and in-comment comment-begin
1785 (re-search-forward markdown-regex-comment-end end t
))
1786 (let ((comment-end (match-end 0)))
1787 (put-text-property (1- comment-end
) comment-end
1788 'syntax-table
(string-to-syntax ">"))
1789 ;; Remove any other text properties inside the comment
1790 (remove-text-properties comment-begin comment-end
1791 markdown--syntax-properties
)
1792 (put-text-property comment-begin comment-end
1793 'markdown-comment
(list comment-begin comment-end
))
1794 (goto-char (min comment-end end
(point-max)))))
1796 (t (setq finish t
)))))
1799 (defun markdown-syntax-propertize (start end
)
1800 "Function used as `syntax-propertize-function'.
1801 START and END delimit region to propertize."
1802 (with-silent-modifications
1804 (remove-text-properties start end markdown--syntax-properties
)
1805 (markdown-syntax-propertize-fenced-block-constructs start end
)
1806 (markdown-syntax-propertize-list-items start end
)
1807 (markdown-syntax-propertize-pre-blocks start end
)
1808 (markdown-syntax-propertize-blockquotes start end
)
1809 (markdown-syntax-propertize-headings start end
)
1810 (markdown-syntax-propertize-hrs start end
)
1811 (markdown-syntax-propertize-comments start end
))))
1814 ;;; Markup Hiding =============================================================
1816 (defconst markdown-markup-properties
1817 '(face markdown-markup-face invisible markdown-markup
)
1818 "List of properties and values to apply to markup.")
1820 (defconst markdown-language-keyword-properties
1821 '(face markdown-language-keyword-face invisible markdown-markup
)
1822 "List of properties and values to apply to code block language names.")
1824 (defconst markdown-language-info-properties
1825 '(face markdown-language-info-face invisible markdown-markup
)
1826 "List of properties and values to apply to code block language info strings.")
1828 (defconst markdown-include-title-properties
1829 '(face markdown-link-title-face invisible markdown-markup
)
1830 "List of properties and values to apply to included code titles.")
1832 (defcustom markdown-hide-markup nil
1833 "Determines whether markup in the buffer will be hidden.
1834 When set to nil, all markup is displayed in the buffer as it
1835 appears in the file. An exception is when `markdown-hide-urls'
1837 Set this to a non-nil value to turn this feature on by default.
1838 You can interactively toggle the value of this variable with
1839 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
1840 or from the Markdown > Show & Hide menu.
1842 Markup hiding works by adding text properties to positions in the
1843 buffer---either the `invisible' property or the `display' property
1844 in cases where alternative glyphs are used (e.g., list bullets).
1845 This does not, however, affect printing or other output.
1846 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
1847 not honor these text properties. For printing, it would be better
1848 to first convert to HTML or PDF (e.g,. using Pandoc)."
1852 :package-version
'(markdown-mode .
"2.3"))
1853 (make-variable-buffer-local 'markdown-hide-markup
)
1855 (defun markdown-toggle-markup-hiding (&optional arg
)
1856 "Toggle the display or hiding of markup.
1857 With a prefix argument ARG, enable markup hiding if ARG is positive,
1858 and disable it otherwise.
1859 See `markdown-hide-markup' for additional details."
1860 (interactive (list (or current-prefix-arg
'toggle
)))
1861 (setq markdown-hide-markup
1862 (if (eq arg
'toggle
)
1863 (not markdown-hide-markup
)
1864 (> (prefix-numeric-value arg
) 0)))
1865 (if markdown-hide-markup
1866 (progn (add-to-invisibility-spec 'markdown-markup
)
1867 (message "markdown-mode markup hiding enabled"))
1868 (progn (remove-from-invisibility-spec 'markdown-markup
)
1869 (message "markdown-mode markup hiding disabled")))
1870 (markdown-reload-extensions))
1873 ;;; Font Lock =================================================================
1875 (require 'font-lock
)
1877 (defgroup markdown-faces nil
1878 "Faces used in Markdown Mode."
1882 (defface markdown-italic-face
1883 '((t (:inherit italic
)))
1884 "Face for italic text."
1885 :group
'markdown-faces
)
1887 (defface markdown-bold-face
1888 '((t (:inherit bold
)))
1889 "Face for bold text."
1890 :group
'markdown-faces
)
1892 (defface markdown-strike-through-face
1893 '((t (:strike-through t
)))
1894 "Face for strike-through text."
1895 :group
'markdown-faces
)
1897 (defface markdown-markup-face
1898 '((t (:inherit shadow
:slant normal
:weight normal
)))
1899 "Face for markup elements."
1900 :group
'markdown-faces
)
1902 (defface markdown-header-rule-face
1903 '((t (:inherit markdown-markup-face
)))
1904 "Base face for headers rules."
1905 :group
'markdown-faces
)
1907 (defface markdown-header-delimiter-face
1908 '((t (:inherit markdown-markup-face
)))
1909 "Base face for headers hash delimiter."
1910 :group
'markdown-faces
)
1912 (defface markdown-list-face
1913 '((t (:inherit markdown-markup-face
)))
1914 "Face for list item markers."
1915 :group
'markdown-faces
)
1917 (defface markdown-blockquote-face
1918 '((t (:inherit font-lock-doc-face
)))
1919 "Face for blockquote sections."
1920 :group
'markdown-faces
)
1922 (defface markdown-code-face
1923 '((t (:inherit fixed-pitch
)))
1924 "Face for inline code, pre blocks, and fenced code blocks.
1925 This may be used, for example, to add a contrasting background to
1926 inline code fragments and code blocks."
1927 :group
'markdown-faces
)
1929 (defface markdown-inline-code-face
1930 '((t (:inherit
(markdown-code-face font-lock-constant-face
))))
1931 "Face for inline code."
1932 :group
'markdown-faces
)
1934 (defface markdown-pre-face
1935 '((t (:inherit
(markdown-code-face font-lock-constant-face
))))
1936 "Face for preformatted text."
1937 :group
'markdown-faces
)
1939 (defface markdown-table-face
1940 '((t (:inherit
(markdown-code-face))))
1942 :group
'markdown-faces
)
1944 (defface markdown-language-keyword-face
1945 '((t (:inherit font-lock-type-face
)))
1946 "Face for programming language identifiers."
1947 :group
'markdown-faces
)
1949 (defface markdown-language-info-face
1950 '((t (:inherit font-lock-string-face
)))
1951 "Face for programming language info strings."
1952 :group
'markdown-faces
)
1954 (defface markdown-link-face
1955 '((t (:inherit link
)))
1957 :group
'markdown-faces
)
1959 (defface markdown-missing-link-face
1960 '((t (:inherit font-lock-warning-face
)))
1961 "Face for missing links."
1962 :group
'markdown-faces
)
1964 (defface markdown-reference-face
1965 '((t (:inherit markdown-markup-face
)))
1966 "Face for link references."
1967 :group
'markdown-faces
)
1969 (defface markdown-footnote-marker-face
1970 '((t (:inherit markdown-markup-face
)))
1971 "Face for footnote markers."
1972 :group
'markdown-faces
)
1974 (defface markdown-footnote-text-face
1975 '((t (:inherit font-lock-comment-face
)))
1976 "Face for footnote text."
1977 :group
'markdown-faces
)
1979 (defface markdown-url-face
1980 '((t (:inherit font-lock-string-face
)))
1981 "Face for URLs that are part of markup.
1982 For example, this applies to URLs in inline links:
1983 [link text](http://example.com/)."
1984 :group
'markdown-faces
)
1986 (defface markdown-plain-url-face
1987 '((t (:inherit markdown-link-face
)))
1988 "Face for URLs that are also links.
1989 For example, this applies to plain angle bracket URLs:
1990 <http://example.com/>."
1991 :group
'markdown-faces
)
1993 (defface markdown-link-title-face
1994 '((t (:inherit font-lock-comment-face
)))
1995 "Face for reference link titles."
1996 :group
'markdown-faces
)
1998 (defface markdown-line-break-face
1999 '((t (:inherit font-lock-constant-face
:underline t
)))
2000 "Face for hard line breaks."
2001 :group
'markdown-faces
)
2003 (defface markdown-comment-face
2004 '((t (:inherit font-lock-comment-face
)))
2005 "Face for HTML comments."
2006 :group
'markdown-faces
)
2008 (defface markdown-math-face
2009 '((t (:inherit font-lock-string-face
)))
2010 "Face for LaTeX expressions."
2011 :group
'markdown-faces
)
2013 (defface markdown-metadata-key-face
2014 '((t (:inherit font-lock-variable-name-face
)))
2015 "Face for metadata keys."
2016 :group
'markdown-faces
)
2018 (defface markdown-metadata-value-face
2019 '((t (:inherit font-lock-string-face
)))
2020 "Face for metadata values."
2021 :group
'markdown-faces
)
2023 (defface markdown-gfm-checkbox-face
2024 '((t (:inherit font-lock-builtin-face
)))
2025 "Face for GFM checkboxes."
2026 :group
'markdown-faces
)
2028 (defface markdown-highlight-face
2029 '((t (:inherit highlight
)))
2030 "Face for mouse highlighting."
2031 :group
'markdown-faces
)
2033 (defface markdown-hr-face
2034 '((t (:inherit markdown-markup-face
)))
2035 "Face for horizontal rules."
2036 :group
'markdown-faces
)
2038 (defface markdown-html-tag-name-face
2039 '((t (:inherit font-lock-type-face
)))
2040 "Face for HTML tag names."
2041 :group
'markdown-faces
)
2043 (defface markdown-html-tag-delimiter-face
2044 '((t (:inherit markdown-markup-face
)))
2045 "Face for HTML tag delimiters."
2046 :group
'markdown-faces
)
2048 (defface markdown-html-attr-name-face
2049 '((t (:inherit font-lock-variable-name-face
)))
2050 "Face for HTML attribute names."
2051 :group
'markdown-faces
)
2053 (defface markdown-html-attr-value-face
2054 '((t (:inherit font-lock-string-face
)))
2055 "Face for HTML attribute values."
2056 :group
'markdown-faces
)
2058 (defface markdown-html-entity-face
2059 '((t (:inherit font-lock-variable-name-face
)))
2060 "Face for HTML entities."
2061 :group
'markdown-faces
)
2063 (defface markdown-highlighting-face
2064 '((t (:background
"yellow" :foreground
"black")))
2065 "Face for highlighting."
2066 :group
'markdown-faces
)
2068 (defcustom markdown-header-scaling nil
2069 "Whether to use variable-height faces for headers.
2070 When non-nil, `markdown-header-face' will inherit from
2071 `variable-pitch' and the scaling values in
2072 `markdown-header-scaling-values' will be applied to
2073 headers of levels one through six respectively."
2075 :initialize
#'custom-initialize-default
2076 :set
(lambda (symbol value
)
2077 (set-default symbol value
)
2078 (markdown-update-header-faces value
))
2079 :group
'markdown-faces
2080 :package-version
'(markdown-mode .
"2.2"))
2082 (defcustom markdown-header-scaling-values
2083 '(2.0
1.7 1.4 1.1 1.0 1.0)
2084 "List of scaling values for headers of level one through six.
2085 Used when `markdown-header-scaling' is non-nil."
2086 :type
'(repeat float
)
2087 :initialize
#'custom-initialize-default
2088 :set
(lambda (symbol value
)
2089 (set-default symbol value
)
2090 (markdown-update-header-faces markdown-header-scaling value
)))
2092 (defmacro markdown--dotimes-when-compile
(i-n body
)
2093 (declare (indent 1) (debug ((symbolp form
) form
)))
2094 (let ((var (car i-n
))
2097 (dotimes (i (eval n t
))
2098 (push (eval body
`((,var .
,i
))) code
))
2099 `(progn ,@(nreverse code
))))
2101 (defface markdown-header-face
2102 `((t (:inherit
(,@(when markdown-header-scaling
'(variable-pitch))
2103 font-lock-function-name-face
)
2105 "Base face for headers.")
2107 (markdown--dotimes-when-compile (num 6)
2108 (let* ((num1 (1+ num
))
2109 (face-name (intern (format "markdown-header-face-%s" num1
))))
2110 `(defface ,face-name
2111 (,'\
` ((t (:inherit markdown-header-face
2113 (,'\
, (if markdown-header-scaling
2114 (float (nth ,num markdown-header-scaling-values
))
2116 (format "Face for level %s headers.
2117 You probably don't want to customize this face directly. Instead
2118 you can customize the base face `markdown-header-face' or the
2119 variable-height variable `markdown-header-scaling'." ,num1
))))
2121 (defun markdown-update-header-faces (&optional scaling scaling-values
)
2122 "Update header faces, depending on if header SCALING is desired.
2123 If so, use given list of SCALING-VALUES relative to the baseline
2124 size of `markdown-header-face'."
2126 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num
))))
2127 (scale (cond ((not scaling
) 1.0)
2128 (scaling-values (float (nth num scaling-values
)))
2129 (t (float (nth num markdown-header-scaling-values
))))))
2130 (unless (get face-name
'saved-face
) ; Don't update customized faces
2131 (set-face-attribute face-name nil
:height scale
)))))
2133 (defun markdown-syntactic-face (state)
2134 "Return font-lock face for characters with given STATE.
2135 See `font-lock-syntactic-face-function' for details."
2136 (let ((in-comment (nth 4 state
)))
2138 (in-comment 'markdown-comment-face
)
2141 (defcustom markdown-list-item-bullets
2142 '("●" "◎" "○" "◆" "◇" "►" "•")
2143 "List of bullets to use for unordered lists.
2144 It can contain any number of symbols, which will be repeated.
2145 Depending on your font, some reasonable choices are:
2146 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸."
2148 :type
'(repeat (string :tag
"Bullet character"))
2149 :package-version
'(markdown-mode .
"2.3"))
2151 (defun markdown--footnote-marker-properties ()
2152 "Return a font-lock facespec expression for footnote marker text."
2153 `(face markdown-footnote-marker-face
2154 ,@(when markdown-hide-markup
2155 `(display ,markdown-footnote-display
))))
2157 (defun markdown--pandoc-inline-footnote-properties ()
2158 "Return a font-lock facespec expression for Pandoc inline footnote text."
2159 `(face markdown-footnote-text-face
2160 ,@(when markdown-hide-markup
2161 `(display ,markdown-footnote-display
))))
2163 (defvar markdown-mode-font-lock-keywords
2164 `((markdown-match-yaml-metadata-begin .
((1 'markdown-markup-face
)))
2165 (markdown-match-yaml-metadata-end .
((1 'markdown-markup-face
)))
2166 (markdown-match-yaml-metadata-key .
((1 'markdown-metadata-key-face
)
2167 (2 'markdown-markup-face
)
2168 (3 'markdown-metadata-value-face
)))
2169 (markdown-match-gfm-open-code-blocks .
((1 markdown-markup-properties
)
2170 (2 markdown-markup-properties nil t
)
2171 (3 markdown-language-keyword-properties nil t
)
2172 (4 markdown-language-info-properties nil t
)
2173 (5 markdown-markup-properties nil t
)))
2174 (markdown-match-gfm-close-code-blocks .
((0 markdown-markup-properties
)))
2175 (markdown-fontify-gfm-code-blocks)
2176 (markdown-fontify-tables)
2177 (markdown-match-fenced-start-code-block .
((1 markdown-markup-properties
)
2178 (2 markdown-markup-properties nil t
)
2179 (3 markdown-language-keyword-properties nil t
)
2180 (4 markdown-language-info-properties nil t
)
2181 (5 markdown-markup-properties nil t
)))
2182 (markdown-match-fenced-end-code-block .
((0 markdown-markup-properties
)))
2183 (markdown-fontify-fenced-code-blocks)
2184 (markdown-match-pre-blocks .
((0 'markdown-pre-face
)))
2185 (markdown-fontify-headings)
2186 (markdown-match-declarative-metadata .
((1 'markdown-metadata-key-face
)
2187 (2 'markdown-markup-face
)
2188 (3 'markdown-metadata-value-face
)))
2189 (markdown-match-pandoc-metadata .
((1 'markdown-markup-face
)
2190 (2 'markdown-markup-face
)
2191 (3 'markdown-metadata-value-face
)))
2192 (markdown-fontify-hrs)
2193 (markdown-match-code .
((1 markdown-markup-properties prepend
)
2194 (2 'markdown-inline-code-face prepend
)
2195 (3 markdown-markup-properties prepend
)))
2196 (,markdown-regex-kbd .
((1 markdown-markup-properties
)
2197 (2 'markdown-inline-code-face
)
2198 (3 markdown-markup-properties
)))
2199 (markdown-fontify-angle-uris)
2200 (,markdown-regex-email .
'markdown-plain-url-face
)
2201 (markdown-match-html-tag .
((1 'markdown-html-tag-delimiter-face t
)
2202 (2 'markdown-html-tag-name-face t
)
2203 (3 'markdown-html-tag-delimiter-face t
)
2204 ;; Anchored matcher for HTML tag attributes
2205 (,markdown-regex-html-attr
2206 ;; Before searching, move past tag
2207 ;; name; set limit at tag close.
2209 (goto-char (match-end 2)) (match-end 3))
2211 .
((1 'markdown-html-attr-name-face
)
2212 (3 'markdown-html-tag-delimiter-face nil t
)
2213 (4 'markdown-html-attr-value-face nil t
)))))
2214 (,markdown-regex-html-entity .
'markdown-html-entity-face
)
2215 (markdown-fontify-list-items)
2216 (,markdown-regex-footnote .
((1 markdown-markup-properties
) ; [^
2217 (2 (markdown--footnote-marker-properties)) ; label
2218 (3 markdown-markup-properties
))) ; ]
2219 (,markdown-regex-pandoc-inline-footnote .
((1 markdown-markup-properties
) ; ^
2220 (2 markdown-markup-properties
) ; [
2221 (3 (markdown--pandoc-inline-footnote-properties)) ; text
2222 (4 markdown-markup-properties
))) ; ]
2223 (markdown-match-includes .
((1 markdown-markup-properties
)
2224 (2 markdown-markup-properties nil t
)
2225 (3 markdown-include-title-properties nil t
)
2226 (4 markdown-markup-properties nil t
)
2227 (5 markdown-markup-properties
)
2228 (6 'markdown-url-face
)
2229 (7 markdown-markup-properties
)))
2230 (markdown-fontify-inline-links)
2231 (markdown-fontify-reference-links)
2232 (,markdown-regex-reference-definition .
((1 'markdown-markup-face
) ; [
2233 (2 'markdown-reference-face
) ; label
2234 (3 'markdown-markup-face
) ; ]
2235 (4 'markdown-markup-face
) ; :
2236 (5 'markdown-url-face
) ; url
2237 (6 'markdown-link-title-face
))) ; "title" (optional)
2238 (markdown-fontify-plain-uris)
2240 (markdown-match-math-single .
((1 'markdown-markup-face prepend
)
2241 (2 'markdown-math-face append
)
2242 (3 'markdown-markup-face prepend
)))
2244 (markdown-match-math-double .
((1 'markdown-markup-face prepend
)
2245 (2 'markdown-math-face append
)
2246 (3 'markdown-markup-face prepend
)))
2247 ;; Math mode \[..\] and \\[..\\]
2248 (markdown-match-math-display .
((1 'markdown-markup-face prepend
)
2249 (3 'markdown-math-face append
)
2250 (4 'markdown-markup-face prepend
)))
2251 (markdown-match-bold .
((1 markdown-markup-properties prepend
)
2252 (2 'markdown-bold-face append
)
2253 (3 markdown-markup-properties prepend
)))
2254 (markdown-match-italic .
((1 markdown-markup-properties prepend
)
2255 (2 'markdown-italic-face append
)
2256 (3 markdown-markup-properties prepend
)))
2257 (,markdown-regex-strike-through .
((3 markdown-markup-properties
)
2258 (4 'markdown-strike-through-face
)
2259 (5 markdown-markup-properties
)))
2260 (markdown--match-highlighting .
((3 markdown-markup-properties
)
2261 (4 'markdown-highlighting-face
)
2262 (5 markdown-markup-properties
)))
2263 (,markdown-regex-line-break .
(1 'markdown-line-break-face prepend
))
2264 (markdown-match-escape .
((1 markdown-markup-properties prepend
)))
2265 (markdown-fontify-sub-superscripts)
2266 (markdown-match-inline-attributes .
((0 markdown-markup-properties prepend
)))
2267 (markdown-match-leanpub-sections .
((0 markdown-markup-properties
)))
2268 (markdown-fontify-blockquotes)
2269 (markdown-match-wiki-link .
((0 'markdown-link-face prepend
))))
2270 "Syntax highlighting for Markdown files.")
2273 (defvar-local markdown-footnote-counter
0
2274 "Counter for footnote numbers.")
2276 (defconst markdown-footnote-chars
2278 "Regular expression matching any character for a footnote identifier.")
2280 (defconst markdown-regex-footnote-definition
2281 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars
"*?\\)\\]:\\(?:[ \t]+\\|$\\)")
2282 "Regular expression matching a footnote definition, capturing the label.")
2285 ;;; Compatibility =============================================================
2287 (defun markdown--pandoc-reference-p ()
2288 (let ((bounds (bounds-of-thing-at-point 'word
)))
2289 (when (and bounds
(char-before (car bounds
)))
2290 (= (char-before (car bounds
)) ?
@))))
2292 (defun markdown-flyspell-check-word-p ()
2293 "Return t if `flyspell' should check word just before point.
2294 Used for `flyspell-generic-check-word-predicate'."
2296 (goto-char (1- (point)))
2297 ;; https://github.com/jrblevin/markdown-mode/issues/560
2298 ;; enable spell check YAML meta data
2299 (if (or (and (markdown-code-block-at-point-p)
2300 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section
)))
2301 (markdown-inline-code-at-point-p)
2302 (markdown-in-comment-p)
2303 (markdown--face-p (point) '(markdown-reference-face
2304 markdown-markup-face
2305 markdown-plain-url-face
2306 markdown-inline-code-face
2308 (markdown--pandoc-reference-p))
2310 ;; If flyspell overlay is put, then remove it
2311 (let ((bounds (bounds-of-thing-at-point 'word
)))
2313 (cl-loop for ov in
(overlays-in (car bounds
) (cdr bounds
))
2314 when
(overlay-get ov
'flyspell-overlay
)
2316 (delete-overlay ov
)))))
2320 ;;; Markdown Parsing Functions ================================================
2322 (defun markdown-cur-line-blank-p ()
2323 "Return t if the current line is blank and nil otherwise."
2326 (looking-at-p markdown-regex-blank-line
)))
2328 (defun markdown-prev-line-blank ()
2329 "Return t if the previous line is blank and nil otherwise.
2330 If we are at the first line, then consider the previous line to be blank."
2331 (or (= (line-beginning-position) (point-min))
2334 (looking-at markdown-regex-blank-line
))))
2336 (defun markdown-prev-line-blank-p ()
2337 "Like `markdown-prev-line-blank', but preserve `match-data'."
2338 (save-match-data (markdown-prev-line-blank)))
2340 (defun markdown-next-line-blank-p ()
2341 "Return t if the next line is blank and nil otherwise.
2342 If we are at the last line, then consider the next line to be blank."
2343 (or (= (line-end-position) (point-max))
2346 (markdown-cur-line-blank-p))))
2348 (defun markdown-prev-line-indent ()
2349 "Return the number of leading whitespace characters in the previous line.
2350 Return 0 if the current line is the first line in the buffer."
2352 (if (= (line-beginning-position) (point-min))
2355 (current-indentation))))
2357 (defun markdown-next-line-indent ()
2358 "Return the number of leading whitespace characters in the next line.
2359 Return 0 if line is the last line in the buffer."
2361 (if (= (line-end-position) (point-max))
2364 (current-indentation))))
2366 (defun markdown-new-baseline ()
2367 "Determine if the current line begins a new baseline level.
2368 Assume point is positioned at beginning of line."
2369 (or (looking-at markdown-regex-header
)
2370 (looking-at markdown-regex-hr
)
2371 (and (= (current-indentation) 0)
2372 (not (looking-at markdown-regex-list
))
2373 (markdown-prev-line-blank))))
2375 (defun markdown-search-backward-baseline ()
2376 "Search backward baseline point with no indentation and not a list item."
2379 (while (not (or stop
(bobp)))
2380 (re-search-backward markdown-regex-block-separator-noindent nil t
)
2382 (goto-char (match-end 2))
2384 ((markdown-new-baseline)
2386 ((looking-at-p markdown-regex-list
)
2388 (t (setq stop t
)))))))
2390 (defun markdown-update-list-levels (marker indent levels
)
2391 "Update list levels given list MARKER, block INDENT, and current LEVELS.
2392 Here, MARKER is a string representing the type of list, INDENT is an integer
2393 giving the indentation, in spaces, of the current block, and LEVELS is a
2394 list of the indentation levels of parent list items. When LEVELS is nil,
2395 it means we are at baseline (not inside of a nested list)."
2397 ;; New list item at baseline.
2398 ((and marker
(null levels
))
2399 (setq levels
(list indent
)))
2400 ;; List item with greater indentation (four or more spaces).
2401 ;; Increase list level.
2402 ((and marker
(>= indent
(+ (car levels
) markdown-list-indent-width
)))
2403 (setq levels
(cons indent levels
)))
2404 ;; List item with greater or equal indentation (less than four spaces).
2405 ;; Do not increase list level.
2406 ((and marker
(>= indent
(car levels
)))
2408 ;; Lesser indentation level.
2409 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
2410 ;; indentation could move back more than one list level). Note
2411 ;; that this block need not be the beginning of list item.
2412 ((< indent
(car levels
))
2413 (while (and (> (length levels
) 1)
2414 (< indent
(+ (cadr levels
) markdown-list-indent-width
)))
2415 (setq levels
(cdr levels
)))
2417 ;; Otherwise, do nothing.
2420 (defun markdown-calculate-list-levels ()
2421 "Calculate list levels at point.
2422 Return a list of the form (n1 n2 n3 ...) where n1 is the
2423 indentation of the deepest nested list item in the branch of
2424 the list at the point, n2 is the indentation of the parent
2425 list item, and so on. The depth of the list item is therefore
2426 the length of the returned list. If the point is not at or
2427 immediately after a list item, return nil."
2429 (let ((first (point)) levels indent pre-regexp
)
2430 ;; Find a baseline point with zero list indentation
2431 (markdown-search-backward-baseline)
2432 ;; Search for all list items between baseline and LOC
2433 (while (and (< (point) first
)
2434 (re-search-forward markdown-regex-list first t
))
2435 (setq pre-regexp
(format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels
))))
2438 ;; Make sure this is not a header or hr
2439 ((markdown-new-baseline) (setq levels nil
))
2440 ;; Make sure this is not a line from a pre block
2441 ((looking-at-p pre-regexp
))
2442 ;; If not, then update levels
2444 (setq indent
(current-indentation))
2445 (setq levels
(markdown-update-list-levels (match-string 2)
2450 (defun markdown-prev-list-item (level)
2451 "Search backward from point for a list item with indentation LEVEL.
2452 Set point to the beginning of the item, and return point, or nil
2454 (let (bounds indent prev
)
2457 (setq indent
(current-indentation))
2461 ((and (looking-at-p markdown-regex-list
)
2462 (setq bounds
(markdown-cur-list-item-bounds)))
2464 ;; Stop and return point at item of equal indentation
2465 ((= (nth 3 bounds
) level
)
2468 ;; Stop and return nil at item with lesser indentation
2469 ((< (nth 3 bounds
) level
)
2472 ;; Stop at beginning of buffer
2473 ((bobp) (setq prev nil
))
2474 ;; Continue at item with greater indentation
2475 ((> (nth 3 bounds
) level
) t
)))
2476 ;; Stop at beginning of buffer
2477 ((bobp) (setq prev nil
))
2478 ;; Continue if current line is blank
2479 ((markdown-cur-line-blank-p) t
)
2480 ;; Continue while indentation is the same or greater
2481 ((>= indent level
) t
)
2482 ;; Stop if current indentation is less than list item
2483 ;; and the next is blank
2484 ((and (< indent level
)
2485 (markdown-next-line-blank-p))
2488 ((looking-at-p markdown-regex-header
) (setq prev nil
))
2489 ;; Stop at a horizontal rule
2490 ((looking-at-p markdown-regex-hr
) (setq prev nil
))
2491 ;; Otherwise, continue.
2494 (setq indent
(current-indentation)))
2497 (defun markdown-next-list-item (level)
2498 "Search forward from point for the next list item with indentation LEVEL.
2499 Set point to the beginning of the item, and return point, or nil
2501 (let (bounds indent next
)
2503 (if (looking-at markdown-regex-header-setext
)
2504 (goto-char (match-end 0)))
2506 (setq indent
(current-indentation))
2509 ;; Stop at end of the buffer.
2511 ;; Continue if the current line is blank
2512 ((markdown-cur-line-blank-p) t
)
2514 ((and (looking-at-p markdown-regex-list
)
2515 (setq bounds
(markdown-cur-list-item-bounds)))
2517 ;; Continue at item with greater indentation
2518 ((> (nth 3 bounds
) level
) t
)
2519 ;; Stop and return point at item of equal indentation
2520 ((= (nth 3 bounds
) level
)
2523 ;; Stop and return nil at item with lesser indentation
2524 ((< (nth 3 bounds
) level
)
2527 ;; Continue while indentation is the same or greater
2528 ((>= indent level
) t
)
2529 ;; Stop if current indentation is less than list item
2530 ;; and the previous line was blank.
2531 ((and (< indent level
)
2532 (markdown-prev-line-blank-p))
2535 ((looking-at-p markdown-regex-header
) (setq next nil
))
2536 ;; Stop at a horizontal rule
2537 ((looking-at-p markdown-regex-hr
) (setq next nil
))
2538 ;; Otherwise, continue.
2541 (setq indent
(current-indentation)))
2544 (defun markdown-cur-list-item-end (level)
2545 "Move to end of list item with pre-marker indentation LEVEL.
2546 Return the point at the end when a list item was found at the
2547 original point. If the point is not in a list item, do nothing."
2550 (setq indent
(current-indentation))
2553 ;; Stop at end of the buffer.
2555 ;; Continue while indentation is the same or greater
2556 ((>= indent level
) t
)
2557 ;; Continue if the current line is blank
2558 ((looking-at markdown-regex-blank-line
) t
)
2559 ;; Stop if current indentation is less than list item
2560 ;; and the previous line was blank.
2561 ((and (< indent level
)
2562 (markdown-prev-line-blank))
2564 ;; Stop at a new list items of the same or lesser
2565 ;; indentation, headings, and horizontal rules.
2566 ((looking-at (concat "\\(?:" markdown-regex-list
2567 "\\|" markdown-regex-header
2568 "\\|" markdown-regex-hr
"\\)"))
2570 ;; Otherwise, continue.
2573 (setq indent
(current-indentation)))
2574 ;; Don't skip over whitespace for empty list items (marker and
2575 ;; whitespace only), just move to end of whitespace.
2578 (looking-at (concat markdown-regex-list
"[ \t]*$")))
2579 (goto-char (match-end 3))
2580 (skip-chars-backward " \t\n"))
2584 (defun markdown-cur-list-item-bounds ()
2585 "Return bounds for list item at point.
2586 Return a list of the following form:
2588 (begin end indent nonlist-indent marker checkbox match)
2590 The named components are:
2592 - begin: Position of beginning of list item, including leading indentation.
2593 - end: Position of the end of the list item, including list item text.
2594 - indent: Number of characters of indentation before list marker (an integer).
2595 - nonlist-indent: Number characters of indentation, list
2596 marker, and whitespace following list marker (an integer).
2597 - marker: String containing the list marker and following whitespace
2598 (e.g., \"- \" or \"* \").
2599 - checkbox: String containing the GFM checkbox portion, if any,
2600 including any trailing whitespace before the text
2601 begins (e.g., \"[x] \").
2602 - match: match data for markdown-regex-list
2604 As an example, for the following unordered list item
2608 the returned list would be
2610 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
2612 If the point is not inside a list item, return nil."
2613 (car (get-text-property (line-beginning-position) 'markdown-list-item
)))
2615 (defun markdown-list-item-at-point-p ()
2616 "Return t if there is a list item at the point and nil otherwise."
2617 (save-match-data (markdown-cur-list-item-bounds)))
2619 (defun markdown-prev-list-item-bounds ()
2620 "Return bounds of previous item in the same list of any level.
2621 The return value has the same form as that of
2622 `markdown-cur-list-item-bounds'."
2624 (let ((cur-bounds (markdown-cur-list-item-bounds))
2625 (beginning-of-list (save-excursion (markdown-beginning-of-list)))
2628 (goto-char (nth 0 cur-bounds
))
2629 (while (and (not stop
) (not (bobp))
2630 (re-search-backward markdown-regex-list
2631 beginning-of-list t
))
2632 (unless (or (looking-at markdown-regex-hr
)
2633 (markdown-code-block-at-point-p))
2634 (setq stop
(point))))
2635 (markdown-cur-list-item-bounds)))))
2637 (defun markdown-next-list-item-bounds ()
2638 "Return bounds of next item in the same list of any level.
2639 The return value has the same form as that of
2640 `markdown-cur-list-item-bounds'."
2642 (let ((cur-bounds (markdown-cur-list-item-bounds))
2643 (end-of-list (save-excursion (markdown-end-of-list)))
2646 (goto-char (nth 0 cur-bounds
))
2648 (while (and (not stop
) (not (eobp))
2649 (re-search-forward markdown-regex-list
2651 (unless (or (looking-at markdown-regex-hr
)
2652 (markdown-code-block-at-point-p))
2653 (setq stop
(point))))
2655 (markdown-cur-list-item-bounds))))))
2657 (defun markdown-beginning-of-list ()
2658 "Move point to beginning of list at point, if any."
2660 (let ((orig-point (point))
2661 (list-begin (save-excursion
2662 (markdown-search-backward-baseline)
2663 ;; Stop at next list item, regardless of the indentation.
2664 (markdown-next-list-item (point-max))
2665 (when (looking-at markdown-regex-list
)
2667 (when (and list-begin
(<= list-begin orig-point
))
2668 (goto-char list-begin
))))
2670 (defun markdown-end-of-list ()
2671 "Move point to end of list at point, if any."
2673 (let ((start (point))
2674 (end (save-excursion
2675 (when (markdown-beginning-of-list)
2676 ;; Items can't have nonlist-indent <= 1, so this
2677 ;; moves past all list items.
2678 (markdown-next-list-item 1)
2679 (skip-syntax-backward "-")
2680 (unless (eobp) (forward-char 1))
2682 (when (and end
(>= end start
))
2685 (defun markdown-up-list ()
2686 "Move point to beginning of parent list item."
2688 (let ((cur-bounds (markdown-cur-list-item-bounds)))
2690 (markdown-prev-list-item (1- (nth 3 cur-bounds
)))
2691 (let ((up-bounds (markdown-cur-list-item-bounds)))
2692 (when (and up-bounds
(< (nth 3 up-bounds
) (nth 3 cur-bounds
)))
2695 (defun markdown-bounds-of-thing-at-point (thing)
2696 "Call `bounds-of-thing-at-point' for THING with slight modifications.
2697 Does not include trailing newlines when THING is \\='line. Handles the
2698 end of buffer case by setting both endpoints equal to the value of
2699 `point-max', since an empty region will trigger empty markup insertion.
2700 Return bounds of form (beg . end) if THING is found, or nil otherwise."
2701 (let* ((bounds (bounds-of-thing-at-point thing
))
2705 (when (eq thing
'line
)
2706 (cond ((and (eobp) (markdown-cur-line-blank-p))
2708 ((char-equal (char-before b
) ?\^J
)
2712 (defun markdown-reference-definition (reference)
2713 "Find out whether Markdown REFERENCE is defined.
2714 REFERENCE should not include the square brackets.
2715 When REFERENCE is defined, return a list of the form (text start end)
2716 containing the definition text itself followed by the start and end
2717 locations of the text. Otherwise, return nil.
2718 Leave match data for `markdown-regex-reference-definition'
2719 intact additional processing."
2720 (let ((reference (downcase reference
)))
2722 (goto-char (point-min))
2724 (while (re-search-forward markdown-regex-reference-definition nil t
)
2725 (when (string= reference
(downcase (match-string-no-properties 2)))
2727 (list (match-string-no-properties 5)
2728 (match-beginning 5) (match-end 5)))))))))
2730 (defun markdown-get-defined-references ()
2731 "Return all defined reference labels and their line numbers.
2732 They does not include square brackets)."
2734 (goto-char (point-min))
2736 (while (re-search-forward markdown-regex-reference-definition nil t
)
2737 (let ((target (match-string-no-properties 2)))
2739 (cons (downcase target
)
2740 (markdown-line-number-at-pos (match-beginning 2)))
2741 refs
:test
#'equal
:key
#'car
)))
2744 (defun markdown-get-used-uris ()
2745 "Return a list of all used URIs in the buffer."
2747 (goto-char (point-min))
2749 (while (re-search-forward
2750 (concat "\\(?:" markdown-regex-link-inline
2751 "\\|" markdown-regex-angle-uri
2752 "\\|" markdown-regex-uri
2753 "\\|" markdown-regex-email
2756 (unless (or (markdown-inline-code-at-point-p)
2757 (markdown-code-block-at-point-p))
2758 (cl-pushnew (or (match-string-no-properties 6)
2759 (match-string-no-properties 10)
2760 (match-string-no-properties 12)
2761 (match-string-no-properties 13))
2762 uris
:test
#'equal
)))
2765 (defun markdown-inline-code-at-pos (pos)
2766 "Return non-nil if there is an inline code fragment at POS.
2767 Return nil otherwise. Set match data according to
2768 `markdown-match-code' upon success.
2769 This function searches the block for a code fragment that
2770 contains the point using `markdown-match-code'. We do this
2771 because `thing-at-point-looking-at' does not work reliably with
2772 `markdown-regex-code'.
2774 The match data is set as follows:
2775 Group 1 matches the opening backquotes.
2776 Group 2 matches the code fragment itself, without backquotes.
2777 Group 3 matches the closing backquotes."
2780 (let ((old-point (point))
2781 (end-of-block (progn (markdown-end-of-text-block) (point)))
2783 (markdown-beginning-of-text-block)
2784 (while (and (markdown-match-code end-of-block
)
2786 (< (match-end 0) old-point
)))
2787 (let ((match-group (if (eq (char-after (match-beginning 0)) ?
`) 0 1)))
2788 (and found
; matched something
2789 (<= (match-beginning match-group
) old-point
) ; match contains old-point
2790 (> (match-end 0) old-point
))))))
2792 (defun markdown-inline-code-at-pos-p (pos)
2793 "Return non-nil if there is an inline code fragment at POS.
2794 Like `markdown-inline-code-at-pos`, but preserves match data."
2795 (save-match-data (markdown-inline-code-at-pos pos
)))
2797 (defun markdown-inline-code-at-point ()
2798 "Return non-nil if the point is at an inline code fragment.
2799 See `markdown-inline-code-at-pos' for details."
2800 (markdown-inline-code-at-pos (point)))
2802 (defun markdown-inline-code-at-point-p (&optional pos
)
2803 "Return non-nil if there is inline code at the POS.
2804 This is a predicate function counterpart to
2805 `markdown-inline-code-at-point' which does not modify the match
2806 data. See `markdown-code-block-at-point-p' for code blocks."
2807 (save-match-data (markdown-inline-code-at-pos (or pos
(point)))))
2809 (defun markdown-code-block-at-pos (pos)
2810 "Return match data list if there is a code block at POS.
2811 Uses text properties at the beginning of the line position.
2812 This includes pre blocks, tilde-fenced code blocks, and GFM
2813 quoted code blocks. Return nil otherwise."
2814 (let ((bol (save-excursion (goto-char pos
) (line-beginning-position))))
2815 (or (get-text-property bol
'markdown-pre
)
2816 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos
))
2817 (second (cl-second bounds
)))
2819 ;; chunks are right open
2820 (when (< pos second
)
2824 ;; Function was renamed to emphasize that it does not modify match-data.
2825 (defalias 'markdown-code-block-at-point
'markdown-code-block-at-point-p
)
2827 (defun markdown-code-block-at-point-p (&optional pos
)
2828 "Return non-nil if there is a code block at the POS.
2829 This includes pre blocks, tilde-fenced code blocks, and GFM
2830 quoted code blocks. This function does not modify the match
2831 data. See `markdown-inline-code-at-point-p' for inline code."
2832 (save-match-data (markdown-code-block-at-pos (or pos
(point)))))
2834 (defun markdown-heading-at-point (&optional pos
)
2835 "Return non-nil if there is a heading at the POS.
2836 Set match data for `markdown-regex-header'."
2837 (let ((match-data (get-text-property (or pos
(point)) 'markdown-heading
)))
2839 (set-match-data match-data
)
2842 (defun markdown-pipe-at-bol-p ()
2843 "Return non-nil if the line begins with a pipe symbol.
2844 This may be useful for tables and Pandoc's line_blocks extension."
2845 (char-equal (char-after (line-beginning-position)) ?|
))
2848 ;;; Markdown Font Lock Matching Functions =====================================
2850 (defun markdown-range-property-any (begin end prop prop-values
)
2851 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
2852 Also returns t if PROP is a list containing one of the PROP-VALUES.
2853 Return nil otherwise."
2856 (dolist (loc (number-sequence begin end
))
2857 (when (setq props
(get-text-property loc prop
))
2858 (cond ((listp props
)
2859 ;; props is a list, check for membership
2860 (dolist (val prop-values
)
2861 (when (memq val props
) (throw 'found loc
))))
2863 ;; props is a scalar, check for equality
2864 (dolist (val prop-values
)
2865 (when (eq val props
) (throw 'found loc
))))))))))
2867 (defun markdown-range-properties-exist (begin end props
)
2869 for loc in
(number-sequence begin end
)
2873 (cl-some (lambda (prop) (get-text-property loc prop
)) props
)))
2874 finally return result
))
2876 (defun markdown-match-inline-generic (regex last
&optional faceless
)
2877 "Match inline REGEX from the point to LAST.
2878 When FACELESS is non-nil, do not return matches where faces have been applied."
2879 (when (re-search-forward regex last t
)
2880 (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
2881 (face (and faceless
(text-property-not-all
2882 (match-beginning 0) (match-end 0) 'face nil
))))
2884 ;; In code block: move past it and recursively search again
2886 (when (< (goto-char (cl-second bounds
)) last
)
2887 (markdown-match-inline-generic regex last faceless
)))
2888 ;; When faces are found in the match range, skip over the match and
2889 ;; recursively search again.
2891 (when (< (goto-char (match-end 0)) last
)
2892 (markdown-match-inline-generic regex last faceless
)))
2893 ;; Keep match data and return t when in bounds.
2895 (<= (match-end 0) last
))))))
2897 (defun markdown-match-code (last)
2898 "Match inline code fragments from point to LAST."
2901 (when (markdown-search-until-condition
2904 ;; Advance point in case of failure, but without exceeding last.
2905 (goto-char (min (1+ (match-beginning 1)) last
))
2906 (not (markdown-in-comment-p (match-beginning 1)))
2907 (not (markdown-in-comment-p (match-end 1)))
2908 (not (markdown-code-block-at-pos (match-beginning 1)))))
2909 markdown-regex-code last t
)
2910 (set-match-data (list (match-beginning 1) (match-end 1)
2911 (match-beginning 2) (match-end 2)
2912 (match-beginning 3) (match-end 3)
2913 (match-beginning 4) (match-end 4)))
2914 (goto-char (min (1+ (match-end 0)) last
(point-max)))
2917 (defun markdown--gfm-markup-underscore-p (begin end
)
2918 (let ((is-underscore (eql (char-after begin
) ?_
)))
2919 (if (not is-underscore
)
2924 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin
))
2927 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)"))))))))
2929 (defun markdown-match-bold (last)
2930 "Match inline bold from the point to LAST."
2931 (when (markdown-match-inline-generic markdown-regex-bold last
)
2932 (let ((is-gfm (derived-mode-p 'gfm-mode
))
2933 (begin (match-beginning 2))
2934 (end (match-end 2)))
2935 (if (or (markdown-inline-code-at-pos-p begin
)
2936 (markdown-inline-code-at-pos-p end
)
2937 (markdown-in-comment-p)
2938 (markdown-range-property-any
2939 begin begin
'face
'(markdown-url-face
2940 markdown-plain-url-face
))
2941 (markdown-range-property-any
2942 begin end
'face
'(markdown-hr-face
2943 markdown-math-face
))
2944 (and is-gfm
(not (markdown--gfm-markup-underscore-p begin end
))))
2945 (progn (goto-char (min (1+ begin
) last
))
2946 (when (< (point) last
)
2947 (markdown-match-bold last
)))
2948 (set-match-data (list (match-beginning 2) (match-end 2)
2949 (match-beginning 3) (match-end 3)
2950 (match-beginning 4) (match-end 4)
2951 (match-beginning 5) (match-end 5)))
2954 (defun markdown-match-italic (last)
2955 "Match inline italics from the point to LAST."
2956 (let* ((is-gfm (derived-mode-p 'gfm-mode
))
2958 markdown-regex-gfm-italic
2959 markdown-regex-italic
)))
2960 (when (and (markdown-match-inline-generic regex last
)
2961 (not (markdown--face-p
2963 '(markdown-html-attr-name-face markdown-html-attr-value-face
))))
2964 (let ((begin (match-beginning 1))
2966 (close-end (match-end 4)))
2967 (if (or (eql (char-before begin
) (char-after begin
))
2968 (markdown-inline-code-at-pos-p begin
)
2969 (markdown-inline-code-at-pos-p (1- end
))
2970 (markdown-in-comment-p)
2971 (markdown-range-property-any
2972 begin begin
'face
'(markdown-url-face
2973 markdown-plain-url-face
2974 markdown-markup-face
))
2975 (markdown-range-property-any
2976 begin end
'face
'(markdown-bold-face
2979 markdown-math-face
))
2981 (or (char-equal (char-after begin
) (char-after (1+ begin
))) ;; check bold case
2982 (not (markdown--gfm-markup-underscore-p begin close-end
)))))
2983 (progn (goto-char (min (1+ begin
) last
))
2984 (when (< (point) last
)
2985 (markdown-match-italic last
)))
2986 (set-match-data (list (match-beginning 1) (match-end 1)
2987 (match-beginning 2) (match-end 2)
2988 (match-beginning 3) (match-end 3)
2989 (match-beginning 4) (match-end 4)))
2992 (defun markdown--match-highlighting (last)
2993 (when markdown-enable-highlighting-syntax
2994 (re-search-forward markdown-regex-highlighting last t
)))
2996 (defun markdown-match-escape (last)
2997 "Match escape characters (backslashes) from point to LAST.
2998 Backlashes only count as escape characters outside of literal
2999 regions (e.g. code blocks). See `markdown-literal-faces'."
3001 (while (search-forward-regexp markdown-regex-escape last t
)
3002 (let* ((face (get-text-property (match-beginning 1) 'face
))
3003 (face-list (if (listp face
) face
(list face
))))
3004 ;; Ignore any backslashes with a literal face.
3005 (unless (cl-intersection face-list markdown-literal-faces
)
3006 (throw 'found t
))))))
3008 (defun markdown-match-math-generic (regex last
)
3009 "Match REGEX from point to LAST.
3010 REGEX is either `markdown-regex-math-inline-single' for matching
3011 $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
3012 (when (markdown-match-inline-generic regex last
)
3013 (let ((begin (match-beginning 1)) (end (match-end 1)))
3015 (if (or (markdown-range-property-any
3017 '(markdown-inline-code-face markdown-bold-face
))
3018 (markdown-range-properties-exist
3020 (markdown-get-fenced-block-middle-properties)))
3021 (markdown-match-math-generic regex last
)
3023 (goto-char (1+ (match-end 0)))))))
3025 (defun markdown-match-list-items (last)
3026 "Match list items from point to LAST."
3027 (let* ((first (point))
3029 (prop 'markdown-list-item
)
3030 (bounds (car (get-text-property pos prop
))))
3032 (and (or (null (setq bounds
(car (get-text-property pos prop
))))
3033 (< (cl-first bounds
) pos
))
3035 (setq pos
(next-single-property-change pos prop nil last
))
3038 (set-match-data (cl-seventh bounds
))
3039 ;; Step at least one character beyond point. Otherwise
3040 ;; `font-lock-fontify-keywords-region' infloops.
3041 (goto-char (min (1+ (max (line-end-position) first
))
3045 (defun markdown-match-math-single (last)
3046 "Match single quoted $..$ math from point to LAST."
3047 (when markdown-enable-math
3048 (when (and (char-equal (char-after) ?$
)
3050 (not (char-equal (char-before) ?
\\))
3051 (not (char-equal (char-before) ?$
)))
3053 (markdown-match-math-generic markdown-regex-math-inline-single last
)))
3055 (defun markdown-match-math-double (last)
3056 "Match double quoted $$..$$ math from point to LAST."
3057 (when markdown-enable-math
3058 (when (and (< (1+ (point)) (point-max))
3059 (char-equal (char-after) ?$
)
3060 (char-equal (char-after (1+ (point))) ?$
)
3062 (not (char-equal (char-before) ?
\\))
3063 (not (char-equal (char-before) ?$
)))
3065 (markdown-match-math-generic markdown-regex-math-inline-double last
)))
3067 (defun markdown-match-math-display (last)
3068 "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
3069 (when markdown-enable-math
3070 (markdown-match-math-generic markdown-regex-math-display last
)))
3072 (defun markdown-match-propertized-text (property last
)
3073 "Match text with PROPERTY from point to LAST.
3074 Restore match data previously stored in PROPERTY."
3075 (let ((saved (get-text-property (point) property
))
3078 (setq pos
(next-single-property-change (point) property nil last
))
3079 (unless (= pos last
)
3080 (setq saved
(get-text-property pos property
))))
3082 (set-match-data saved
)
3083 ;; Step at least one character beyond point. Otherwise
3084 ;; `font-lock-fontify-keywords-region' infloops.
3085 (goto-char (min (1+ (max (match-end 0) (point)))
3089 (defun markdown-match-pre-blocks (last)
3090 "Match preformatted blocks from point to LAST.
3091 Use data stored in \\='markdown-pre text property during syntax
3093 (markdown-match-propertized-text 'markdown-pre last
))
3095 (defun markdown-match-gfm-code-blocks (last)
3096 "Match GFM quoted code blocks from point to LAST.
3097 Use data stored in \\='markdown-gfm-code text property during syntax
3099 (markdown-match-propertized-text 'markdown-gfm-code last
))
3101 (defun markdown-match-gfm-open-code-blocks (last)
3102 (markdown-match-propertized-text 'markdown-gfm-block-begin last
))
3104 (defun markdown-match-gfm-close-code-blocks (last)
3105 (markdown-match-propertized-text 'markdown-gfm-block-end last
))
3107 (defun markdown-match-fenced-code-blocks (last)
3108 "Match fenced code blocks from the point to LAST."
3109 (markdown-match-propertized-text 'markdown-fenced-code last
))
3111 (defun markdown-match-fenced-start-code-block (last)
3112 (markdown-match-propertized-text 'markdown-tilde-fence-begin last
))
3114 (defun markdown-match-fenced-end-code-block (last)
3115 (markdown-match-propertized-text 'markdown-tilde-fence-end last
))
3117 (defun markdown-match-blockquotes (last)
3118 "Match blockquotes from point to LAST.
3119 Use data stored in \\='markdown-blockquote text property during syntax
3121 (markdown-match-propertized-text 'markdown-blockquote last
))
3123 (defun markdown-match-hr (last)
3124 "Match horizontal rules comments from the point to LAST."
3125 (markdown-match-propertized-text 'markdown-hr last
))
3127 (defun markdown-match-comments (last)
3128 "Match HTML comments from the point to LAST."
3129 (when (and (skip-syntax-forward "^<" last
))
3130 (let ((beg (point)))
3131 (when (and (skip-syntax-forward "^>" last
) (< (point) last
))
3133 (set-match-data (list beg
(point)))
3136 (defun markdown-match-generic-links (last ref
)
3137 "Match inline links from point to LAST.
3138 When REF is non-nil, match reference links instead of standard
3140 This function should only be used during font-lock, as it
3141 determines syntax based on the presence of faces for previously
3142 processed elements."
3143 ;; Search for the next potential link (not in a code block).
3144 (let ((prohibited-faces '(markdown-pre-face
3146 markdown-inline-code-face
3147 markdown-comment-face
))
3150 (and (not found
) (< (point) last
)
3152 ;; Clear match data to test for a match after functions returns.
3153 (set-match-data nil
)
3154 ;; Preliminary regular expression search so we can return
3155 ;; quickly upon failure. This doesn't handle malformed links
3156 ;; or nested square brackets well, so if it passes we back up
3157 ;; continue with a more precise search.
3160 markdown-regex-link-reference
3161 markdown-regex-link-inline
)
3163 ;; Keep searching if this is in a code block, inline code, or a
3164 ;; comment, or if it is include syntax. The link text portion
3165 ;; (group 3) may contain inline code or comments, but the
3166 ;; markup, URL, and title should not be part of such elements.
3167 (if (or (markdown-range-property-any
3168 (match-beginning 0) (match-end 2) 'face prohibited-faces
)
3169 (markdown-range-property-any
3170 (match-beginning 4) (match-end 0) 'face prohibited-faces
)
3171 (and (char-equal (char-after (line-beginning-position)) ?
<)
3172 (char-equal (char-after (1+ (line-beginning-position))) ?
<)))
3173 (set-match-data nil
)
3175 ;; Match opening exclamation point (optional) and left bracket.
3176 (when (match-beginning 2)
3177 (let* ((bang (match-beginning 1))
3178 (first-begin (match-beginning 2))
3179 ;; Find end of block to prevent matching across blocks.
3180 (end-of-block (save-excursion
3182 (goto-char (match-beginning 2))
3183 (markdown-end-of-text-block)
3185 ;; Move over balanced expressions to closing right bracket.
3186 ;; Catch unbalanced expression errors and return nil.
3187 (first-end (condition-case nil
3188 (and (goto-char first-begin
)
3189 (scan-sexps (point) 1))
3191 ;; Continue with point at CONT-POINT upon failure.
3192 (cont-point (min (1+ first-begin
) last
))
3193 second-begin second-end url-begin url-end
3194 title-begin title-end
)
3195 ;; When bracket found, in range, and followed by a left paren/bracket...
3196 (when (and first-end
(< first-end end-of-block
) (goto-char first-end
)
3197 (char-equal (char-after (point)) (if ref ?\
[ ?\
()))
3198 ;; Scan across balanced expressions for closing parenthesis/bracket.
3199 (setq second-begin
(point)
3200 second-end
(condition-case nil
3201 (scan-sexps (point) 1)
3203 ;; Check that closing parenthesis/bracket is in range.
3204 (if (and second-end
(<= second-end end-of-block
) (<= second-end last
))
3206 ;; Search for (optional) title inside closing parenthesis
3207 (when (and (not ref
) (search-forward "\"" second-end t
))
3208 (setq title-begin
(1- (point))
3209 title-end
(and (goto-char second-end
)
3210 (search-backward "\"" (1+ title-begin
) t
))
3211 title-end
(and title-end
(1+ title-end
))))
3212 ;; Store URL/reference range
3213 (setq url-begin
(1+ second-begin
)
3214 url-end
(1- (or title-begin second-end
)))
3215 ;; Set match data, move point beyond link, and return
3217 (list (or bang first-begin
) second-end
; 0 - all
3218 bang
(and bang
(1+ bang
)) ; 1 - bang
3219 first-begin
(1+ first-begin
) ; 2 - markup
3220 (1+ first-begin
) (1- first-end
) ; 3 - link text
3221 (1- first-end
) first-end
; 4 - markup
3222 second-begin
(1+ second-begin
) ; 5 - markup
3223 url-begin url-end
; 6 - url/reference
3224 title-begin title-end
; 7 - title
3225 (1- second-end
) second-end
)) ; 8 - markup
3226 ;; Nullify cont-point and leave point at end and
3227 (setq cont-point nil
)
3228 (goto-char second-end
))
3229 ;; If no closing parenthesis in range, update continuation point
3230 (setq cont-point
(min end-of-block second-begin
))))
3232 ;; On failure, continue searching at cont-point
3233 ((and cont-point
(< cont-point last
))
3234 (goto-char cont-point
)
3235 (markdown-match-generic-links last ref
))
3236 ;; No more text, return nil
3237 ((and cont-point
(= cont-point last
))
3239 ;; Return t if a match occurred
3242 (defun markdown-match-angle-uris (last)
3243 "Match angle bracket URIs from point to LAST."
3244 (when (markdown-match-inline-generic markdown-regex-angle-uri last
)
3245 (goto-char (1+ (match-end 0)))))
3247 (defun markdown-match-plain-uris (last)
3248 "Match plain URIs from point to LAST."
3249 (when (markdown-match-inline-generic markdown-regex-uri last t
)
3250 (goto-char (1+ (match-end 0)))))
3252 (defvar markdown-conditional-search-function
#'re-search-forward
3253 "Conditional search function used in `markdown-search-until-condition'.
3254 Made into a variable to allow for dynamic let-binding.")
3256 (defun markdown-search-until-condition (condition &rest args
)
3258 (while (and (not ret
) (apply markdown-conditional-search-function args
))
3259 (setq ret
(funcall condition
)))
3262 (defun markdown-metadata-line-p (pos regexp
)
3264 (or (= (line-number-at-pos pos
) 1)
3267 ;; skip multi-line metadata
3268 (while (and (looking-at-p "^\\s-+[[:alpha:]]")
3269 (> (line-number-at-pos (point)) 1))
3271 (looking-at-p regexp
)))))
3273 (defun markdown-match-generic-metadata (regexp last
)
3274 "Match metadata declarations specified by REGEXP from point to LAST.
3275 These declarations must appear inside a metadata block that begins at
3276 the beginning of the buffer and ends with a blank line (or the end of
3278 (let* ((first (point))
3279 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
3280 (block-begin (goto-char 1))
3281 (block-end (re-search-forward end-re nil t
)))
3282 (if (and block-end
(> first block-end
))
3283 ;; Don't match declarations if there is no metadata block or if
3284 ;; the point is beyond the block. Move point to point-max to
3285 ;; prevent additional searches and return return nil since nothing
3287 (progn (goto-char (point-max)) nil
)
3288 ;; If a block was found that begins before LAST and ends after
3289 ;; point, search for declarations inside it. If the starting is
3290 ;; before the beginning of the block, start there. Otherwise,
3291 ;; move back to FIRST.
3292 (goto-char (if (< first block-begin
) block-begin first
))
3293 (if (and (re-search-forward regexp
(min last block-end
) t
)
3294 (markdown-metadata-line-p (point) regexp
))
3295 ;; If a metadata declaration is found, set match-data and return t.
3296 (let ((key-beginning (match-beginning 1))
3297 (key-end (match-end 1))
3298 (markup-begin (match-beginning 2))
3299 (markup-end (match-end 2))
3300 (value-beginning (match-beginning 3)))
3301 (set-match-data (list key-beginning
(point) ; complete metadata
3302 key-beginning key-end
; key
3303 markup-begin markup-end
; markup
3304 value-beginning
(point))) ; value
3306 ;; Otherwise, move the point to last and return nil
3310 (defun markdown-match-declarative-metadata (last)
3311 "Match declarative metadata from the point to LAST."
3312 (markdown-match-generic-metadata markdown-regex-declarative-metadata last
))
3314 (defun markdown-match-pandoc-metadata (last)
3315 "Match Pandoc metadata from the point to LAST."
3316 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last
))
3318 (defun markdown-match-yaml-metadata-begin (last)
3319 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last
))
3321 (defun markdown-match-yaml-metadata-end (last)
3322 (markdown-match-propertized-text 'markdown-yaml-metadata-end last
))
3324 (defun markdown-match-yaml-metadata-key (last)
3325 (markdown-match-propertized-text 'markdown-metadata-key last
))
3327 (defun markdown-match-wiki-link (last)
3328 "Match wiki links from point to LAST."
3329 (when (and markdown-enable-wiki-links
3330 (not markdown-wiki-link-fontify-missing
)
3331 (markdown-match-inline-generic markdown-regex-wiki-link last
))
3332 (let ((begin (match-beginning 1)) (end (match-end 1)))
3333 (if (or (markdown-in-comment-p begin
)
3334 (markdown-in-comment-p end
)
3335 (markdown-inline-code-at-pos-p begin
)
3336 (markdown-inline-code-at-pos-p end
)
3337 (markdown-code-block-at-pos begin
))
3338 (progn (goto-char (min (1+ begin
) last
))
3339 (when (< (point) last
)
3340 (markdown-match-wiki-link last
)))
3341 (set-match-data (list begin end
))
3344 (defun markdown-match-inline-attributes (last)
3345 "Match inline attributes from point to LAST."
3346 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow.
3347 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes
3348 ;; against matched string.
3349 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last
)
3350 (if (not (string-match-p markdown-regex-inline-attributes
(match-string 0)))
3351 (markdown-match-inline-attributes last
)
3352 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3353 (markdown-inline-code-at-pos-p (match-end 0))
3354 (markdown-in-comment-p))
3357 (defun markdown-match-leanpub-sections (last)
3358 "Match Leanpub section markers from point to LAST."
3359 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last
)
3360 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3361 (markdown-inline-code-at-pos-p (match-end 0))
3362 (markdown-in-comment-p))
3365 (defun markdown-match-includes (last)
3366 "Match include statements from point to LAST.
3367 Sets match data for the following seven groups:
3368 Group 1: opening two angle brackets
3369 Group 2: opening title delimiter (optional)
3370 Group 3: title text (optional)
3371 Group 4: closing title delimiter (optional)
3372 Group 5: opening filename delimiter
3374 Group 7: closing filename delimiter"
3375 (when (markdown-match-inline-generic markdown-regex-include last
)
3376 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
3377 (markdown-in-comment-p (match-end 0))
3378 (markdown-code-block-at-pos (match-beginning 0))))))
3380 ;; Parentheses and maybe square brackets, but no curly braces:
3381 ;; match optional title in square brackets and file in parentheses.
3382 ((and valid
(match-beginning 5)
3383 (not (match-beginning 8)))
3384 (set-match-data (list (match-beginning 1) (match-end 7)
3385 (match-beginning 1) (match-end 1)
3386 (match-beginning 2) (match-end 2)
3387 (match-beginning 3) (match-end 3)
3388 (match-beginning 4) (match-end 4)
3389 (match-beginning 5) (match-end 5)
3390 (match-beginning 6) (match-end 6)
3391 (match-beginning 7) (match-end 7))))
3392 ;; Only square brackets present: match file in square brackets.
3393 ((and valid
(match-beginning 2)
3394 (not (match-beginning 5))
3395 (not (match-beginning 7)))
3396 (set-match-data (list (match-beginning 1) (match-end 4)
3397 (match-beginning 1) (match-end 1)
3401 (match-beginning 2) (match-end 2)
3402 (match-beginning 3) (match-end 3)
3403 (match-beginning 4) (match-end 4))))
3404 ;; Only curly braces present: match file in curly braces.
3405 ((and valid
(match-beginning 8)
3406 (not (match-beginning 2))
3407 (not (match-beginning 5)))
3408 (set-match-data (list (match-beginning 1) (match-end 10)
3409 (match-beginning 1) (match-end 1)
3413 (match-beginning 8) (match-end 8)
3414 (match-beginning 9) (match-end 9)
3415 (match-beginning 10) (match-end 10))))
3417 ;; Not a valid match, move to next line and search again.
3419 (when (< (point) last
)
3420 (setq valid
(markdown-match-includes last
)))))
3423 (defun markdown-match-html-tag (last)
3424 "Match HTML tags from point to LAST."
3425 (when (and markdown-enable-html
3426 (markdown-match-inline-generic markdown-regex-html-tag last t
))
3427 (set-match-data (list (match-beginning 0) (match-end 0)
3428 (match-beginning 1) (match-end 1)
3429 (match-beginning 2) (match-end 2)
3430 (match-beginning 9) (match-end 9)))
3434 ;;; Markdown Font Fontification Functions =====================================
3436 (defvar markdown--first-displayable-cache
(make-hash-table :test
#'equal
))
3438 (defun markdown--first-displayable (seq)
3439 "Return the first displayable character or string in SEQ.
3440 SEQ may be an atom or a sequence."
3441 (let ((c (gethash seq markdown--first-displayable-cache t
)))
3445 (let ((seq (if (listp seq
) seq
(list seq
))))
3446 (cond ((stringp (car seq
))
3449 (and (mapcar #'char-displayable-p
(string-to-list str
))))
3451 ((characterp (car seq
))
3452 (cl-find-if #'char-displayable-p seq
))))
3453 markdown--first-displayable-cache
))))
3455 (defun markdown--marginalize-string (level)
3456 "Generate atx markup string of given LEVEL for left margin."
3457 (let ((margin-left-space-count
3458 (- markdown-marginalize-headers-margin-width level
)))
3459 (concat (make-string margin-left-space-count ?
)
3460 (make-string level ?
#))))
3462 (defun markdown-marginalize-update-current ()
3463 "Update the window configuration to create a left margin."
3465 (let* ((header-delimiter-font-width
3466 (window-font-width nil
'markdown-header-delimiter-face
))
3467 (margin-pixel-width (* markdown-marginalize-headers-margin-width
3468 header-delimiter-font-width
))
3469 (margin-char-width (/ margin-pixel-width
(default-font-width))))
3470 (set-window-margins nil margin-char-width
))
3471 ;; As a fallback, simply set margin based on character count.
3472 (set-window-margins nil
(1+ markdown-marginalize-headers-margin-width
))))
3474 (defun markdown-fontify-headings (last)
3475 "Add text properties to headings from point to LAST."
3476 (when (markdown-match-propertized-text 'markdown-heading last
)
3477 (let* ((level (markdown-outline-level))
3479 (intern (format "markdown-header-face-%d" level
)))
3480 (heading-props `(face ,heading-face
))
3482 `(face markdown-header-delimiter-face
3484 (markdown-hide-markup
3486 (markdown-marginalize-headers
3487 `(display ((margin left-margin
)
3488 ,(markdown--marginalize-string level
)))))))
3490 `(face markdown-header-delimiter-face
3491 ,@(when markdown-hide-markup
`(display ""))))
3492 (rule-props `(face markdown-header-rule-face
3493 ,@(when markdown-hide-markup
`(display "")))))
3496 (progn (add-text-properties
3497 (match-beginning 1) (match-end 1) heading-props
)
3499 (add-text-properties
3500 (match-beginning 2) (match-end 2) rule-props
)
3501 (add-text-properties
3502 (match-beginning 3) (match-end 3) rule-props
)))
3505 (if markdown-fontify-whole-heading-line
3506 (min (point-max) (1+ (match-end 0)))
3508 (add-text-properties
3509 (match-beginning 4) (match-end 4) left-markup-props
)
3511 ;; If closing tag is present
3514 (if markdown-hide-markup
3516 (add-text-properties
3517 (match-beginning 5) header-end heading-props
)
3518 (add-text-properties
3519 (match-beginning 6) (match-end 6) right-markup-props
))
3520 (add-text-properties
3521 (match-beginning 5) (match-end 5) heading-props
)
3522 (add-text-properties
3523 (match-beginning 6) header-end right-markup-props
)))
3524 ;; If closing tag is not present
3525 (add-text-properties
3526 (match-beginning 5) header-end heading-props
))
3530 (defun markdown-fontify-tables (last)
3531 (when (re-search-forward "|" last t
)
3532 (when (markdown-table-at-point-p)
3533 (font-lock-append-text-property
3534 (line-beginning-position) (min (1+ (line-end-position)) (point-max))
3535 'face
'markdown-table-face
))
3539 (defun markdown-fontify-blockquotes (last)
3540 "Apply font-lock properties to blockquotes from point to LAST."
3541 (when (markdown-match-blockquotes last
)
3542 (let ((display-string
3543 (markdown--first-displayable markdown-blockquote-display-char
)))
3544 (add-text-properties
3545 (match-beginning 1) (match-end 1)
3546 (if markdown-hide-markup
3547 `(face markdown-blockquote-face display
,display-string
)
3548 `(face markdown-markup-face
)))
3549 (font-lock-append-text-property
3550 (match-beginning 0) (match-end 0) 'face
'markdown-blockquote-face
)
3553 (defun markdown-fontify-list-items (last)
3554 "Apply font-lock properties to list markers from point to LAST."
3555 (when (markdown-match-list-items last
)
3556 (when (not (markdown-code-block-at-point-p (match-beginning 2)))
3557 (let* ((indent (length (match-string-no-properties 1)))
3558 (level (/ indent markdown-list-indent-width
)) ;; level = 0, 1, 2, ...
3559 (bullet (nth (mod level
(length markdown-list-item-bullets
))
3560 markdown-list-item-bullets
)))
3561 (add-text-properties
3562 (match-beginning 2) (match-end 2) '(face markdown-list-face
))
3563 (when markdown-hide-markup
3566 ((string-match-p "[\\*\\+-]" (match-string 2))
3567 (add-text-properties
3568 (match-beginning 2) (match-end 2) `(display ,bullet
)))
3570 ((string-equal ":" (match-string 2))
3571 (let ((display-string
3572 (char-to-string (markdown--first-displayable
3573 markdown-definition-display-char
))))
3574 (add-text-properties (match-beginning 2) (match-end 2)
3575 `(display ,display-string
))))))))
3578 (defun markdown--fontify-hrs-view-mode (hr-char)
3579 (if (and hr-char
(display-supports-face-attributes-p '(:extend t
)))
3580 (add-text-properties
3581 (match-beginning 0) (match-end 0)
3583 (:inherit markdown-hr-face
:underline t
:extend t
)
3584 font-lock-multiline t
3586 (let ((hr-len (and hr-char
(/ (1- (window-body-width)) (char-width hr-char
)))))
3587 (add-text-properties
3588 (match-beginning 0) (match-end 0)
3590 markdown-hr-face font-lock-multiline t
3591 display
,(make-string hr-len hr-char
))))))
3593 (defun markdown-fontify-hrs (last)
3594 "Add text properties to horizontal rules from point to LAST."
3595 (when (markdown-match-hr last
)
3596 (let ((hr-char (markdown--first-displayable markdown-hr-display-char
)))
3597 (if (and markdown-hide-markup hr-char
)
3598 (markdown--fontify-hrs-view-mode hr-char
)
3599 (add-text-properties
3600 (match-beginning 0) (match-end 0)
3601 `(face markdown-hr-face font-lock-multiline t
)))
3604 (defun markdown-fontify-sub-superscripts (last)
3605 "Apply text properties to sub- and superscripts from point to LAST."
3606 (when (markdown-search-until-condition
3607 (lambda () (and (not (markdown-code-block-at-point-p))
3608 (not (markdown-inline-code-at-point-p))
3609 (not (markdown-in-comment-p))
3610 (not (markdown--math-block-p))))
3611 markdown-regex-sub-superscript last t
)
3612 (let* ((subscript-p (string= (match-string 2) "~"))
3615 (car markdown-sub-superscript-display
)
3616 (cdr markdown-sub-superscript-display
)))
3617 (mp (list 'face
'markdown-markup-face
3618 'invisible
'markdown-markup
)))
3619 (when markdown-hide-markup
3620 (put-text-property (match-beginning 3) (match-end 3)
3622 (add-text-properties (match-beginning 2) (match-end 2) mp
)
3623 (add-text-properties (match-beginning 4) (match-end 4) mp
)
3627 ;;; Syntax Table ==============================================================
3629 (defvar markdown-mode-syntax-table
3630 (let ((tab (make-syntax-table text-mode-syntax-table
)))
3631 (modify-syntax-entry ?
\" "." tab
)
3633 "Syntax table for `markdown-mode'.")
3636 ;;; Element Insertion =========================================================
3638 (defun markdown-ensure-blank-line-before ()
3639 "If previous line is not already blank, insert a blank line before point."
3640 (unless (bolp) (insert "\n"))
3641 (unless (or (bobp) (looking-back "\n\\s-*\n" nil
)) (insert "\n")))
3643 (defun markdown-ensure-blank-line-after ()
3644 "If following line is not already blank, insert a blank line after point.
3645 Return the point where it was originally."
3647 (unless (eolp) (insert "\n"))
3648 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
3650 (defun markdown-wrap-or-insert (s1 s2
&optional thing beg end
)
3651 "Insert the strings S1 and S2, wrapping around region or THING.
3652 If a region is specified by the optional BEG and END arguments,
3653 wrap the strings S1 and S2 around that region.
3654 If there is an active region, wrap the strings S1 and S2 around
3655 the region. If there is not an active region but the point is at
3656 THING, wrap that thing (which defaults to word). Otherwise, just
3657 insert S1 and S2 and place the point in between. Return the
3658 bounds of the entire wrapped string, or nil if nothing was wrapped
3659 and S1 and S2 were only inserted."
3660 (let (a b bounds new-point
)
3666 new-point
(+ (point) (length s1
))))
3669 (setq a
(region-beginning)
3671 new-point
(+ (point) (length s1
))))
3672 ;; Thing (word) at point
3673 ((setq bounds
(markdown-bounds-of-thing-at-point (or thing
'word
)))
3674 (setq a
(car bounds
)
3676 new-point
(+ (point) (length s1
))))
3677 ;; No active region and no word
3685 (when new-point
(goto-char new-point
))
3688 (setq b
(+ b
(length s1
) (length s2
)))
3691 (defun markdown-point-after-unwrap (cur prefix suffix
)
3692 "Return desired position of point after an unwrapping operation.
3693 CUR gives the position of the point before the operation.
3694 Additionally, two cons cells must be provided. PREFIX gives the
3695 bounds of the prefix string and SUFFIX gives the bounds of the
3697 (cond ((< cur
(cdr prefix
)) (car prefix
))
3698 ((< cur
(car suffix
)) (- cur
(- (cdr prefix
) (car prefix
))))
3699 ((<= cur
(cdr suffix
))
3700 (- cur
(+ (- (cdr prefix
) (car prefix
))
3701 (- cur
(car suffix
)))))
3704 (defun markdown-unwrap-thing-at-point (regexp all text
)
3705 "Remove prefix and suffix of thing at point and reposition the point.
3706 When the thing at point matches REGEXP, replace the subexpression
3707 ALL with the string in subexpression TEXT. Reposition the point
3708 in an appropriate location accounting for the removal of prefix
3709 and suffix strings. Return new bounds of string from group TEXT.
3710 When REGEXP is nil, assumes match data is already set."
3711 (when (or (null regexp
)
3712 (thing-at-point-looking-at regexp
))
3714 (prefix (cons (match-beginning all
) (match-beginning text
)))
3715 (suffix (cons (match-end text
) (match-end all
)))
3716 (bounds (cons (match-beginning text
) (match-end text
))))
3717 ;; Replace the thing at point
3718 (replace-match (match-string text
) t t nil all
)
3719 ;; Reposition the point
3720 (goto-char (markdown-point-after-unwrap cur prefix suffix
))
3722 (setq bounds
(cons (car prefix
)
3723 (- (cdr bounds
) (- (cdr prefix
) (car prefix
))))))))
3725 (defun markdown-unwrap-things-in-region (beg end regexp all text
)
3726 "Remove prefix and suffix of all things in region from BEG to END.
3727 When a thing in the region matches REGEXP, replace the
3728 subexpression ALL with the string in subexpression TEXT.
3729 Return a cons cell containing updated bounds for the region."
3732 (let ((removed 0) len-all len-text
)
3733 (while (re-search-forward regexp
(- end removed
) t
)
3734 (setq len-all
(length (match-string-no-properties all
)))
3735 (setq len-text
(length (match-string-no-properties text
)))
3736 (setq removed
(+ removed
(- len-all len-text
)))
3737 (replace-match (match-string text
) t t nil all
))
3738 (cons beg
(- end removed
)))))
3740 (defun markdown-insert-hr (arg)
3741 "Insert or replace a horizontal rule.
3742 By default, use the first element of `markdown-hr-strings'. When
3743 ARG is non-nil, as when given a prefix, select a different
3744 element as follows. When prefixed with \\[universal-argument],
3745 use the last element of `markdown-hr-strings' instead. When
3746 prefixed with an integer from 1 to the length of
3747 `markdown-hr-strings', use the element in that position instead."
3749 (when (thing-at-point-looking-at markdown-regex-hr
)
3750 (delete-region (match-beginning 0) (match-end 0)))
3751 (markdown-ensure-blank-line-before)
3752 (cond ((equal arg
'(4))
3753 (insert (car (reverse markdown-hr-strings
))))
3754 ((and (integerp arg
) (> arg
0)
3755 (<= arg
(length markdown-hr-strings
)))
3756 (insert (nth (1- arg
) markdown-hr-strings
)))
3758 (insert (car markdown-hr-strings
))))
3759 (markdown-ensure-blank-line-after))
3761 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face
3762 &optional skip-space
)
3765 (let* ((bounds (markdown-unwrap-things-in-region
3766 (region-beginning) (region-end)
3767 regex start-group end-group
))
3770 (when (and beg skip-space
)
3773 (skip-chars-forward "[ \t]")
3774 (setq beg
(point))))
3775 (when (and end skip-space
)
3778 (skip-chars-backward "[ \t]")
3779 (setq end
(point))))
3780 (markdown-wrap-or-insert start-delim end-delim nil beg end
))
3781 (if (markdown--face-p (point) (list face
))
3783 (while (and (markdown--face-p (point) (list face
)) (not (bobp)))
3785 (forward-char (- (1- (length start-delim
)))) ;; for delimiter
3788 (when (looking-at regex
)
3789 (markdown-unwrap-thing-at-point nil start-group end-group
)))
3790 (if (thing-at-point-looking-at regex
)
3791 (markdown-unwrap-thing-at-point nil start-group end-group
)
3792 (markdown-wrap-or-insert start-delim end-delim
'word nil nil
)))))
3794 (defun markdown-insert-bold ()
3795 "Insert markup to make a region or word bold.
3796 If there is an active region, make the region bold. If the point
3797 is at a non-bold word, make the word bold. If the point is at a
3798 bold word or phrase, remove the bold markup. Otherwise, simply
3799 insert bold delimiters and place the point in between them."
3801 (let ((delim (if markdown-bold-underscore
"__" "**")))
3802 (markdown--insert-common delim delim markdown-regex-bold
2 4 'markdown-bold-face t
)))
3804 (defun markdown-insert-italic ()
3805 "Insert markup to make a region or word italic.
3806 If there is an active region, make the region italic. If the point
3807 is at a non-italic word, make the word italic. If the point is at an
3808 italic word or phrase, remove the italic markup. Otherwise, simply
3809 insert italic delimiters and place the point in between them."
3811 (let ((delim (if markdown-italic-underscore
"_" "*")))
3812 (markdown--insert-common delim delim markdown-regex-italic
1 3 'markdown-italic-face t
)))
3814 (defun markdown-insert-strike-through ()
3815 "Insert markup to make a region or word strikethrough.
3816 If there is an active region, make the region strikethrough. If the point
3817 is at a non-bold word, make the word strikethrough. If the point is at a
3818 strikethrough word or phrase, remove the strikethrough markup. Otherwise,
3819 simply insert bold delimiters and place the point in between them."
3821 (markdown--insert-common
3822 "~~" "~~" markdown-regex-strike-through
2 4 'markdown-strike-through-face t
))
3824 (defun markdown-insert-code ()
3825 "Insert markup to make a region or word an inline code fragment.
3826 If there is an active region, make the region an inline code
3827 fragment. If the point is at a word, make the word an inline
3828 code fragment. Otherwise, simply insert code delimiters and
3829 place the point in between them."
3833 (let ((bounds (markdown-unwrap-things-in-region
3834 (region-beginning) (region-end)
3835 markdown-regex-code
1 3)))
3836 (markdown-wrap-or-insert "`" "`" nil
(car bounds
) (cdr bounds
)))
3837 ;; Code markup removal, code markup for word, or empty markup insertion
3838 (if (markdown-inline-code-at-point)
3839 (markdown-unwrap-thing-at-point nil
0 2)
3840 (markdown-wrap-or-insert "`" "`" 'word nil nil
))))
3842 (defun markdown-insert-kbd ()
3843 "Insert markup to wrap region or word in <kbd> tags.
3844 If there is an active region, use the region. If the point is at
3845 a word, use the word. Otherwise, simply insert <kbd> tags and
3846 place the point in between them."
3850 (let ((bounds (markdown-unwrap-things-in-region
3851 (region-beginning) (region-end)
3852 markdown-regex-kbd
0 2)))
3853 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil
(car bounds
) (cdr bounds
)))
3854 ;; Markup removal, markup for word, or empty markup insertion
3855 (if (thing-at-point-looking-at markdown-regex-kbd
)
3856 (markdown-unwrap-thing-at-point nil
0 2)
3857 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil
))))
3859 (defun markdown-insert-inline-link (text url
&optional title
)
3860 "Insert an inline link with TEXT pointing to URL.
3861 Optionally, the user can provide a TITLE."
3862 (let ((cur (point)))
3863 (setq title
(and title
(concat " \"" title
"\"")))
3864 (insert (concat "[" text
"](" url title
")"))
3865 (cond ((not text
) (goto-char (+ 1 cur
)))
3866 ((not url
) (goto-char (+ 3 (length text
) cur
))))))
3868 (defun markdown-insert-inline-image (text url
&optional title
)
3869 "Insert an inline link with alt TEXT pointing to URL.
3870 Optionally, also provide a TITLE."
3871 (let ((cur (point)))
3872 (setq title
(and title
(concat " \"" title
"\"")))
3873 (insert (concat "![" text
"](" url title
")"))
3874 (cond ((not text
) (goto-char (+ 2 cur
)))
3875 ((not url
) (goto-char (+ 4 (length text
) cur
))))))
3877 (defun markdown-insert-reference-link (text label
&optional url title
)
3878 "Insert a reference link and, optionally, a reference definition.
3879 The link TEXT will be inserted followed by the optional LABEL.
3880 If a URL is given, also insert a definition for the reference
3881 LABEL according to `markdown-reference-location'. If a TITLE is
3882 given, it will be added to the end of the reference definition
3883 and will be used to populate the title attribute when converted
3884 to XHTML. If URL is nil, insert only the link portion (for
3885 example, when a reference label is already defined)."
3886 (insert (concat "[" text
"][" label
"]"))
3888 (markdown-insert-reference-definition
3889 (if (string-equal label
"") text label
)
3892 (defun markdown-insert-reference-image (text label
&optional url title
)
3893 "Insert a reference image and, optionally, a reference definition.
3894 The alt TEXT will be inserted followed by the optional LABEL.
3895 If a URL is given, also insert a definition for the reference
3896 LABEL according to `markdown-reference-location'. If a TITLE is
3897 given, it will be added to the end of the reference definition
3898 and will be used to populate the title attribute when converted
3899 to XHTML. If URL is nil, insert only the link portion (for
3900 example, when a reference label is already defined)."
3901 (insert (concat "![" text
"][" label
"]"))
3903 (markdown-insert-reference-definition
3904 (if (string-equal label
"") text label
)
3907 (defun markdown-insert-reference-definition (label &optional url title
)
3908 "Add definition for reference LABEL with URL and TITLE.
3909 LABEL is a Markdown reference label without square brackets.
3910 URL and TITLE are optional. When given, the TITLE will
3911 be used to populate the title attribute when converted to XHTML."
3912 ;; END specifies where to leave the point upon return
3913 (let ((end (point)))
3914 (cl-case markdown-reference-location
3915 (end (goto-char (point-max)))
3916 (immediately (markdown-end-of-text-block))
3917 (subtree (markdown-end-of-subtree))
3918 (header (markdown-end-of-defun)))
3919 ;; Skip backwards over local variables. This logic is similar to the one
3920 ;; used in ‘hack-local-variables’.
3921 (when (and enable-local-variables
(eobp))
3922 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move
)
3923 (when (let ((case-fold-search t
))
3924 (search-forward "Local Variables:" nil
:move
))
3925 (beginning-of-line 0)
3926 (when (eq (char-before) ?
\n) (backward-char))))
3927 (unless (or (markdown-cur-line-blank-p)
3928 (thing-at-point-looking-at markdown-regex-reference-definition
))
3930 (insert "\n[" label
"]: ")
3933 ;; When no URL is given, leave point at END following the colon
3935 (when (> (length title
) 0)
3936 (insert " \"" title
"\""))
3937 (unless (looking-at-p "\n")
3942 (markdown--substitute-command-keys
3943 "Reference [%s] was defined, press \\[markdown-do] to jump there")
3946 (defcustom markdown-link-make-text-function nil
3947 "Function that automatically generates a link text for a URL.
3949 If non-nil, this function will be called by
3950 `markdown--insert-link-or-image' and the result will be the
3951 default link text. The function should receive exactly one
3952 argument that corresponds to the link URL."
3955 :package-version
'(markdown-mode .
"2.5"))
3957 (defcustom markdown-disable-tooltip-prompt nil
3958 "Disable prompt for tooltip when inserting a link or image.
3960 If non-nil, `markdown-insert-link' and `markdown-insert-link'
3961 will not prompt the user to insert a tooltip text for the given
3966 :package-version
'(markdown-mode .
"2.5"))
3968 (defun markdown--insert-link-or-image (image)
3969 "Interactively insert new or update an existing link or image.
3970 When IMAGE is non-nil, insert an image. Otherwise, insert a link.
3971 This is an internal function called by
3972 `markdown-insert-link' and `markdown-insert-image'."
3973 (cl-multiple-value-bind (begin end text uri ref title
)
3975 ;; Use region as either link text or URL as appropriate.
3976 (let ((region (buffer-substring-no-properties
3977 (region-beginning) (region-end))))
3978 (if (string-match markdown-regex-uri region
)
3979 ;; Region contains a URL; use it as such.
3980 (list (region-beginning) (region-end)
3981 nil
(match-string 0 region
) nil nil
)
3982 ;; Region doesn't contain a URL, so use it as text.
3983 (list (region-beginning) (region-end)
3984 region nil nil nil
)))
3985 ;; Extract and use properties of existing link, if any.
3986 (markdown-link-at-pos (point)))
3987 (let* ((ref (when ref
(concat "[" ref
"]")))
3988 (defined-refs (mapcar #'car
(markdown-get-defined-references)))
3989 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref
"]")) defined-refs
))
3990 (used-uris (markdown-get-used-uris))
3991 (uri-or-ref (completing-read
3992 "URL or [reference]: "
3993 (append defined-ref-cands used-uris
)
3994 nil nil
(or uri ref
)))
3995 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref
)
3996 (match-string 1 uri-or-ref
))
3997 ((string-equal "" uri-or-ref
)
3999 (uri (unless ref uri-or-ref
))
4000 (text-prompt (if image
4004 "Link text (blank for plain URL): ")))
4005 (text (or text
(and markdown-link-make-text-function uri
4006 (funcall markdown-link-make-text-function uri
))))
4007 (text (completing-read text-prompt defined-refs nil nil text
))
4008 (text (if (= (length text
) 0) nil text
))
4009 (plainp (and uri
(not text
)))
4010 (implicitp (string-equal ref
""))
4011 (ref (if implicitp text ref
))
4012 (definedp (and ref
(markdown-reference-definition ref
)))
4013 (ref-url (unless (or uri definedp
)
4014 (completing-read "Reference URL: " used-uris
)))
4015 (title (unless (or plainp definedp markdown-disable-tooltip-prompt
)
4016 (read-string "Title (tooltip text, optional): " title
)))
4017 (title (if (= (length title
) 0) nil title
)))
4018 (when (and image implicitp
)
4019 (user-error "Reference required: implicit image references are invalid"))
4020 (when (and begin end
)
4021 (delete-region begin end
))
4023 ((and (not image
) uri text
)
4024 (markdown-insert-inline-link text uri title
))
4025 ((and image uri text
)
4026 (markdown-insert-inline-image text uri title
))
4029 (markdown-insert-reference-image text
(unless implicitp ref
) nil title
)
4030 (markdown-insert-reference-link text
(unless implicitp ref
) nil title
))
4032 (markdown-insert-reference-definition ref ref-url title
)))
4033 ((and (not image
) uri
)
4034 (markdown-insert-uri uri
))))))
4036 (defun markdown-insert-link ()
4037 "Insert new or update an existing link, with interactive prompt.
4038 If the point is at an existing link or URL, update the link text,
4039 URL, reference label, and/or title. Otherwise, insert a new link.
4040 The type of link inserted (inline, reference, or plain URL)
4041 depends on which values are provided:
4043 * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
4044 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
4045 * If only TEXT is given, insert an implicit reference link: [TEXT][].
4046 * If only a URL is given, insert a plain link: <URL>.
4048 In other words, to create an implicit reference link, leave the
4049 URL prompt empty and to create a plain URL link, leave the link
4052 If there is an active region, use the text as the default URL, if
4053 it seems to be a URL, or link text value otherwise.
4055 If a given reference is not defined, this function will
4056 additionally prompt for the URL and optional title. In this case,
4057 the reference definition is placed at the location determined by
4058 `markdown-reference-location'. In addition, it is possible to
4059 have the `markdown-link-make-text-function' function, if non-nil,
4060 define the default link text before prompting the user for it.
4062 If `markdown-disable-tooltip-prompt' is non-nil, the user will
4063 not be prompted to add or modify a tooltip text.
4065 Through updating the link, this function can be used to convert a
4066 link of one type (inline, reference, or plain) to another type by
4067 selectively adding or removing information via the prompts."
4069 (markdown--insert-link-or-image nil
))
4071 (defun markdown-insert-image ()
4072 "Insert new or update an existing image, with interactive prompt.
4073 If the point is at an existing image, update the alt text, URL,
4074 reference label, and/or title. Otherwise, insert a new image.
4075 The type of image inserted (inline or reference) depends on which
4076 values are provided:
4078 * If a URL and ALT-TEXT are given, insert an inline image:
4080 * If [REF] and ALT-TEXT are given, insert a reference image:
4083 If there is an active region, use the text as the default URL, if
4084 it seems to be a URL, or alt text value otherwise.
4086 If a given reference is not defined, this function will
4087 additionally prompt for the URL and optional title. In this case,
4088 the reference definition is placed at the location determined by
4089 `markdown-reference-location'.
4091 Through updating the image, this function can be used to convert an
4092 image of one type (inline or reference) to another type by
4093 selectively adding or removing information via the prompts."
4095 (markdown--insert-link-or-image t
))
4097 (defun markdown-insert-uri (&optional uri
)
4098 "Insert markup for an inline URI.
4099 If there is an active region, use it as the URI. If the point is
4100 at a URI, wrap it with angle brackets. If the point is at an
4101 inline URI, remove the angle brackets. Otherwise, simply insert
4102 angle brackets place the point between them."
4106 (let ((bounds (markdown-unwrap-things-in-region
4107 (region-beginning) (region-end)
4108 markdown-regex-angle-uri
0 2)))
4109 (markdown-wrap-or-insert "<" ">" nil
(car bounds
) (cdr bounds
)))
4110 ;; Markup removal, URI at point, new URI, or empty markup insertion
4111 (if (thing-at-point-looking-at markdown-regex-angle-uri
)
4112 (markdown-unwrap-thing-at-point nil
0 2)
4114 (insert "<" uri
">")
4115 (markdown-wrap-or-insert "<" ">" 'url nil nil
)))))
4117 (defun markdown-insert-wiki-link ()
4118 "Insert a wiki link of the form [[WikiLink]].
4119 If there is an active region, use the region as the link text.
4120 If the point is at a word, use the word as the link text. If
4121 there is no active region and the point is not at word, simply
4122 insert link markup."
4126 (markdown-wrap-or-insert "[[" "]]" nil
(region-beginning) (region-end))
4127 ;; Markup removal, wiki link at at point, or empty markup insertion
4128 (if (thing-at-point-looking-at markdown-regex-wiki-link
)
4129 (if (or markdown-wiki-link-alias-first
4130 (null (match-string 5)))
4131 (markdown-unwrap-thing-at-point nil
1 3)
4132 (markdown-unwrap-thing-at-point nil
1 5))
4133 (markdown-wrap-or-insert "[[" "]]"))))
4135 (defun markdown-remove-header ()
4136 "Remove header markup if point is at a header.
4137 Return bounds of remaining header text if a header was removed
4140 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx
0 2)
4141 (markdown-unwrap-thing-at-point markdown-regex-header-setext
0 1)))
4143 (defun markdown-insert-header (&optional level text setext
)
4144 "Insert or replace header markup.
4145 The level of the header is specified by LEVEL and header text is
4146 given by TEXT. LEVEL must be an integer from 1 and 6, and the
4148 When TEXT is nil, the header text is obtained as follows.
4149 If there is an active region, it is used as the header text.
4150 Otherwise, the current line will be used as the header text.
4151 If there is not an active region and the point is at a header,
4152 remove the header markup and replace with level N header.
4153 Otherwise, insert empty header markup and place the point in
4155 The style of the header will be atx (hash marks) unless
4156 SETEXT is non-nil, in which case a setext-style (underlined)
4157 header will be inserted."
4158 (interactive "p\nsHeader text: ")
4159 (setq level
(min (max (or level
1) 1) (if setext
2 6)))
4160 ;; Determine header text if not given
4164 (setq text
(delete-and-extract-region (region-beginning) (region-end)))
4166 (markdown-remove-header)
4167 (setq text
(delete-and-extract-region
4168 (line-beginning-position) (line-end-position)))
4169 (when (and setext
(string-match-p "^[ \t]*$" text
))
4170 (setq text
(read-string "Header text: "))))
4171 (setq text
(markdown-compress-whitespace-string text
)))
4172 ;; Insertion with given text
4173 (markdown-ensure-blank-line-before)
4176 (setq hdr
(make-string (string-width text
) (if (= level
2) ?- ?
=)))
4177 (insert text
"\n" hdr
))
4179 (setq hdr
(make-string level ?
#))
4180 (insert hdr
" " text
)
4181 (when (null markdown-asymmetric-header
) (insert " " hdr
)))))
4182 (markdown-ensure-blank-line-after)
4183 ;; Leave point at end of text
4185 (backward-char (1+ (string-width text
))))
4186 ((null markdown-asymmetric-header
)
4187 (backward-char (1+ level
)))))
4189 (defun markdown-insert-header-dwim (&optional arg setext
)
4190 "Insert or replace header markup.
4191 The level and type of the header are determined automatically by
4192 the type and level of the previous header, unless a prefix
4193 argument is given via ARG.
4194 With a numeric prefix valued 1 to 6, insert a header of the given
4195 level, with the type being determined automatically (note that
4196 only level 1 or 2 setext headers are possible).
4198 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
4199 promote the heading by one level.
4200 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
4201 demote the heading by one level.
4202 When SETEXT is non-nil, prefer setext-style headers when
4203 possible (levels one and two).
4205 When there is an active region, use it for the header text. When
4206 the point is at an existing header, change the type and level
4207 according to the rules above.
4208 Otherwise, if the line is not empty, create a header using the
4209 text on the current line as the header text.
4210 Finally, if the point is on a blank line, insert empty header
4211 markup (atx) or prompt for text (setext).
4212 See `markdown-insert-header' for more details about how the
4213 header text is determined."
4217 (when (or (thing-at-point-looking-at markdown-regex-header
)
4218 (re-search-backward markdown-regex-header nil t
))
4219 ;; level of current or previous header
4220 (setq level
(markdown-outline-level))
4221 ;; match group 1 indicates a setext header
4222 (setq setext
(match-end 1))))
4223 ;; check prefix argument
4225 ((and (equal arg
'(4)) level
(> level
1)) ;; C-u
4227 ((and (equal arg
'(16)) level
(< level
6)) ;; C-u C-u
4229 (arg ;; numeric prefix
4230 (setq level
(prefix-numeric-value arg
))))
4231 ;; setext headers must be level one or two
4232 (and level
(setq setext
(and setext
(<= level
2))))
4233 ;; insert the heading
4234 (markdown-insert-header level nil setext
)))
4236 (defun markdown-insert-header-setext-dwim (&optional arg
)
4237 "Insert or replace header markup, with preference for setext.
4238 See `markdown-insert-header-dwim' for details, including how ARG is handled."
4240 (markdown-insert-header-dwim arg t
))
4242 (defun markdown-insert-header-atx-1 ()
4243 "Insert a first level atx-style (hash mark) header.
4244 See `markdown-insert-header'."
4246 (markdown-insert-header 1 nil nil
))
4248 (defun markdown-insert-header-atx-2 ()
4249 "Insert a level two atx-style (hash mark) header.
4250 See `markdown-insert-header'."
4252 (markdown-insert-header 2 nil nil
))
4254 (defun markdown-insert-header-atx-3 ()
4255 "Insert a level three atx-style (hash mark) header.
4256 See `markdown-insert-header'."
4258 (markdown-insert-header 3 nil nil
))
4260 (defun markdown-insert-header-atx-4 ()
4261 "Insert a level four atx-style (hash mark) header.
4262 See `markdown-insert-header'."
4264 (markdown-insert-header 4 nil nil
))
4266 (defun markdown-insert-header-atx-5 ()
4267 "Insert a level five atx-style (hash mark) header.
4268 See `markdown-insert-header'."
4270 (markdown-insert-header 5 nil nil
))
4272 (defun markdown-insert-header-atx-6 ()
4273 "Insert a sixth level atx-style (hash mark) header.
4274 See `markdown-insert-header'."
4276 (markdown-insert-header 6 nil nil
))
4278 (defun markdown-insert-header-setext-1 ()
4279 "Insert a setext-style (underlined) first-level header.
4280 See `markdown-insert-header'."
4282 (markdown-insert-header 1 nil t
))
4284 (defun markdown-insert-header-setext-2 ()
4285 "Insert a setext-style (underlined) second-level header.
4286 See `markdown-insert-header'."
4288 (markdown-insert-header 2 nil t
))
4290 (defun markdown-blockquote-indentation (loc)
4291 "Return string containing necessary indentation for a blockquote at LOC.
4292 Also see `markdown-pre-indentation'."
4295 (let* ((list-level (length (markdown-calculate-list-levels)))
4297 (dotimes (_ list-level indent
)
4298 (setq indent
(concat indent
" "))))))
4300 (defun markdown-insert-blockquote ()
4301 "Start a blockquote section (or blockquote the region).
4302 If Transient Mark mode is on and a region is active, it is used as
4303 the blockquote text."
4306 (markdown-blockquote-region (region-beginning) (region-end))
4307 (markdown-ensure-blank-line-before)
4308 (insert (markdown-blockquote-indentation (point)) "> ")
4309 (markdown-ensure-blank-line-after)))
4311 (defun markdown-block-region (beg end prefix
)
4312 "Format the region using a block prefix.
4313 Arguments BEG and END specify the beginning and end of the
4314 region. The characters PREFIX will appear at the beginning
4317 (let* ((end-marker (make-marker))
4318 (beg-marker (make-marker))
4319 (prefix-without-trailing-whitespace
4320 (replace-regexp-in-string (rx (+ blank
) eos
) "" prefix
)))
4321 ;; Ensure blank line after and remove extra whitespace
4323 (skip-syntax-backward "-")
4324 (set-marker end-marker
(point))
4325 (delete-horizontal-space)
4326 (markdown-ensure-blank-line-after)
4327 ;; Ensure blank line before and remove extra whitespace
4329 (skip-syntax-forward "-")
4330 (delete-horizontal-space)
4331 (markdown-ensure-blank-line-before)
4332 (set-marker beg-marker
(point))
4333 ;; Insert PREFIX before each line
4334 (goto-char beg-marker
)
4335 (while (and (< (line-beginning-position) end-marker
)
4337 ;; Don’t insert trailing whitespace.
4338 (insert (if (eolp) prefix-without-trailing-whitespace prefix
))
4341 (defun markdown-blockquote-region (beg end
)
4342 "Blockquote the region.
4343 Arguments BEG and END specify the beginning and end of the region."
4345 (markdown-block-region
4346 beg end
(concat (markdown-blockquote-indentation
4347 (max (point-min) (1- beg
))) "> ")))
4349 (defun markdown-pre-indentation (loc)
4350 "Return string containing necessary whitespace for a pre block at LOC.
4351 Also see `markdown-blockquote-indentation'."
4354 (let* ((list-level (length (markdown-calculate-list-levels)))
4356 (dotimes (_ (1+ list-level
) indent
)
4357 (setq indent
(concat indent
" "))))))
4359 (defun markdown-insert-pre ()
4360 "Start a preformatted section (or apply to the region).
4361 If Transient Mark mode is on and a region is active, it is marked
4362 as preformatted text."
4365 (markdown-pre-region (region-beginning) (region-end))
4366 (markdown-ensure-blank-line-before)
4367 (insert (markdown-pre-indentation (point)))
4368 (markdown-ensure-blank-line-after)))
4370 (defun markdown-pre-region (beg end
)
4371 "Format the region as preformatted text.
4372 Arguments BEG and END specify the beginning and end of the region."
4374 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg
)))))
4375 (markdown-block-region beg end indent
)))
4377 (defun markdown-electric-backquote (arg)
4378 "Insert a backquote.
4379 The numeric prefix argument ARG says how many times to repeat the insertion.
4380 Call `markdown-insert-gfm-code-block' interactively
4381 if three backquotes inserted at the beginning of line."
4383 (self-insert-command (prefix-numeric-value arg
))
4384 (when (and markdown-gfm-use-electric-backquote
(looking-back "^```" nil
))
4386 (call-interactively #'markdown-insert-gfm-code-block
)))
4388 (defconst markdown-gfm-recognized-languages
4389 ;; To reproduce/update, evaluate the let-form in
4390 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
4391 ;; but with appropriate use of a keyboard macro, indenting and filling it
4392 ;; properly is pretty fast.
4393 '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
4394 "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada"
4395 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer"
4396 "AngelScript" "Ant-Build-System" "ApacheConf" "Apex"
4397 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly"
4398 "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile"
4399 "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax"
4400 "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump"
4401 "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb"
4402 "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
4403 "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
4404 "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript"
4405 "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language"
4406 "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound"
4407 "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump"
4408 "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch"
4409 "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript"
4410 "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild"
4411 "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm"
4412 "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor"
4413 "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth"
4414 "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS"
4415 "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN"
4416 "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass"
4417 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config"
4418 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu"
4419 "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL"
4420 "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML"
4421 "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP"
4422 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC"
4423 "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7"
4424 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON"
4425 "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java"
4426 "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison"
4427 "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout"
4428 "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE"
4429 "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
4430 "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
4431 "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript"
4432 "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB"
4433 "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako"
4434 "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki"
4435 "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah"
4436 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode"
4437 "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL"
4438 "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
4439 "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
4440 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C"
4441 "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal"
4442 "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript"
4443 "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox"
4444 "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus"
4445 "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn"
4446 "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod"
4447 "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell"
4448 "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer"
4449 "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
4450 "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc"
4451 "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket"
4452 "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol"
4453 "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript"
4454 "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage"
4455 "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
4456 "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass"
4457 "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
4458 "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity"
4459 "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark"
4460 "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift"
4461 "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh"
4462 "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle"
4463 "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
4464 "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL"
4465 "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue"
4466 "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly"
4467 "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok"
4468 "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap"
4469 "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS"
4470 "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL"
4471 "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors"
4472 "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc"
4473 "reStructuredText" "sed" "wdl" "wisp" "xBase")
4474 "Language specifiers recognized by GitHub's syntax highlighting features.")
4476 (defvar-local markdown-gfm-used-languages nil
4477 "Language names used in GFM code blocks.")
4479 (defun markdown-trim-whitespace (str)
4480 (replace-regexp-in-string
4481 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str
))
4483 (defun markdown-clean-language-string (str)
4484 (replace-regexp-in-string
4485 "{\\.?\\|}" "" (markdown-trim-whitespace str
)))
4487 (defun markdown-validate-language-string (widget)
4488 (let ((str (widget-value widget
)))
4489 (unless (string= str
(markdown-clean-language-string str
))
4490 (widget-put widget
:error
(format "Invalid language spec: '%s'" str
))
4493 (defun markdown-gfm-get-corpus ()
4494 "Create corpus of recognized GFM code block languages for the given buffer."
4495 (let ((given-corpus (append markdown-gfm-additional-languages
4496 markdown-gfm-recognized-languages
)))
4498 markdown-gfm-used-languages
4499 (if markdown-gfm-downcase-languages
(cl-mapcar #'downcase given-corpus
)
4502 (defun markdown-gfm-add-used-language (lang)
4503 "Clean LANG and add to list of used languages."
4504 (setq markdown-gfm-used-languages
4505 (cons lang
(remove lang markdown-gfm-used-languages
))))
4507 (defcustom markdown-spaces-after-code-fence
1
4508 "Number of space characters to insert after a code fence.
4509 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
4510 opening code fence and an info string."
4514 :package-version
'(markdown-mode .
"2.3"))
4516 (defcustom markdown-code-block-braces nil
4517 "When non-nil, automatically insert braces for GFM code blocks."
4521 (defun markdown-insert-gfm-code-block (&optional lang edit
)
4522 "Insert GFM code block for language LANG.
4523 If LANG is nil, the language will be queried from user. If a
4524 region is active, wrap this region with the markup instead. If
4525 the region boundaries are not on empty lines, these are added
4526 automatically in order to have the correct markup. When EDIT is
4527 non-nil (e.g., when \\[universal-argument] is given), edit the
4528 code block in an indirect buffer after insertion."
4530 (list (let ((completion-ignore-case nil
))
4532 (markdown-clean-language-string
4534 "Programming language: "
4535 (markdown-gfm-get-corpus)
4536 nil
'confirm
(car markdown-gfm-used-languages
)
4537 'markdown-gfm-language-history
))
4539 current-prefix-arg
))
4540 (unless (string= lang
"") (markdown-gfm-add-used-language lang
))
4541 (when (and (> (length lang
) 0)
4542 (not markdown-code-block-braces
))
4543 (setq lang
(concat (make-string markdown-spaces-after-code-fence ?\s
)
4545 (let ((gfm-open-brace (if markdown-code-block-braces
"{" ""))
4546 (gfm-close-brace (if markdown-code-block-braces
"}" "")))
4548 (let* ((b (region-beginning)) (e (region-end)) end
4549 (indent (progn (goto-char b
) (current-indentation))))
4551 ;; if we're on a blank line, don't newline, otherwise the ```
4552 ;; should go on its own line
4553 (unless (looking-back "\n" nil
)
4557 (markdown-ensure-blank-line-after)
4560 ;; if we're on a blank line, insert the quotes here, otherwise
4561 ;; add a new line first
4562 (unless (looking-at-p "\n")
4565 (markdown-ensure-blank-line-before)
4567 (insert "```" gfm-open-brace lang gfm-close-brace
)
4568 (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end
))
4569 (let ((indent (current-indentation))
4571 (delete-horizontal-space :backward-only
)
4572 (markdown-ensure-blank-line-before)
4574 (setq start-bol
(line-beginning-position))
4575 (insert "```" gfm-open-brace lang gfm-close-brace
"\n")
4577 (unless edit
(insert ?
\n))
4580 (markdown-ensure-blank-line-after)
4581 (markdown-syntax-propertize-fenced-block-constructs start-bol
(point)))
4583 (when edit
(markdown-edit-code-block)))))
4585 (defun markdown-code-block-lang (&optional pos-prop
)
4586 "Return the language name for a GFM or tilde fenced code block.
4587 The beginning of the block may be described by POS-PROP,
4588 a cons of (pos . prop) giving the position and property
4589 at the beginning of the block."
4592 (markdown-max-of-seq
4597 #'markdown-find-previous-prop
4598 (markdown-get-fenced-block-begin-properties))))))
4600 (goto-char (car pos-prop
))
4601 (set-match-data (get-text-property (point) (cdr pos-prop
)))
4602 ;; Note: Hard-coded group number assumes tilde
4603 ;; and GFM fenced code regexp groups agree.
4604 (let ((begin (match-beginning 3))
4605 (end (match-end 3)))
4606 (when (and begin end
)
4607 ;; Fix language strings beginning with periods, like ".ruby".
4608 (when (eq (char-after begin
) ?.
)
4609 (setq begin
(1+ begin
)))
4610 (buffer-substring-no-properties begin end
)))))
4612 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer
)
4613 (with-current-buffer (or buffer
(current-buffer))
4615 (goto-char (point-min))
4617 with prop
= 'markdown-gfm-block-begin
4618 for pos-prop
= (markdown-find-next-prop prop
)
4620 for lang
= (markdown-code-block-lang pos-prop
)
4621 do
(progn (when lang
(markdown-gfm-add-used-language lang
))
4622 (goto-char (next-single-property-change (point) prop
)))))))
4624 (defun markdown-insert-foldable-block ()
4625 "Insert details disclosure element to make content foldable.
4626 If a region is active, wrap this region with the disclosure
4627 element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details."
4629 (let ((details-open-tag "<details>")
4630 (details-close-tag "</details>")
4631 (summary-open-tag "<summary>")
4632 (summary-close-tag " </summary>"))
4634 (let* ((b (region-beginning))
4636 (indent (progn (goto-char b
) (current-indentation))))
4638 ;; if we're on a blank line, don't newline, otherwise the tags
4639 ;; should go on its own line
4640 (unless (looking-back "\n" nil
)
4643 (insert details-close-tag
)
4644 (markdown-ensure-blank-line-after)
4646 ;; if we're on a blank line, insert the quotes here, otherwise
4647 ;; add a new line first
4648 (unless (looking-at-p "\n")
4651 (markdown-ensure-blank-line-before)
4653 (insert details-open-tag
"\n")
4654 (insert summary-open-tag summary-close-tag
)
4655 (search-backward summary-close-tag
))
4656 (let ((indent (current-indentation)))
4657 (delete-horizontal-space :backward-only
)
4658 (markdown-ensure-blank-line-before)
4660 (insert details-open-tag
"\n")
4661 (insert summary-open-tag summary-close-tag
"\n")
4662 (insert details-close-tag
)
4664 (markdown-ensure-blank-line-after)
4665 (search-backward summary-close-tag
)))))
4668 ;;; Footnotes =================================================================
4670 (defun markdown-footnote-counter-inc ()
4671 "Increment `markdown-footnote-counter' and return the new value."
4672 (when (= markdown-footnote-counter
0) ; hasn't been updated in this buffer yet.
4674 (goto-char (point-min))
4675 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars
"*?\\)\\]:")
4677 (let ((fn (string-to-number (match-string 1))))
4678 (when (> fn markdown-footnote-counter
)
4679 (setq markdown-footnote-counter fn
))))))
4680 (cl-incf markdown-footnote-counter
))
4682 (defun markdown-insert-footnote ()
4683 "Insert footnote with a new number and move point to footnote definition."
4685 (let ((fn (markdown-footnote-counter-inc)))
4686 (insert (format "[^%d]" fn
))
4687 (push-mark (point) t
)
4688 (markdown-footnote-text-find-new-location)
4689 (markdown-ensure-blank-line-before)
4690 (unless (markdown-cur-line-blank-p)
4692 (insert (format "[^%d]: " fn
))
4693 (markdown-ensure-blank-line-after)))
4695 (defun markdown-footnote-text-find-new-location ()
4696 "Position the point at the proper location for a new footnote text."
4698 ((eq markdown-footnote-location
'end
) (goto-char (point-max)))
4699 ((eq markdown-footnote-location
'immediately
) (markdown-end-of-text-block))
4700 ((eq markdown-footnote-location
'subtree
) (markdown-end-of-subtree))
4701 ((eq markdown-footnote-location
'header
) (markdown-end-of-defun))))
4703 (defun markdown-footnote-kill ()
4704 "Kill the footnote at point.
4705 The footnote text is killed (and added to the kill ring), the
4706 footnote marker is deleted. Point has to be either at the
4707 footnote marker or in the footnote text."
4709 (let ((marker-pos nil
)
4710 (skip-deleting-marker nil
)
4711 (starting-footnote-text-positions
4712 (markdown-footnote-text-positions)))
4713 (when starting-footnote-text-positions
4714 ;; We're starting in footnote text, so mark our return position and jump
4715 ;; to the marker if possible.
4716 (let ((marker-pos (markdown-footnote-find-marker
4717 (cl-first starting-footnote-text-positions
))))
4719 (goto-char (1- marker-pos
))
4720 ;; If there isn't a marker, we still want to kill the text.
4721 (setq skip-deleting-marker t
))))
4722 ;; Either we didn't start in the text, or we started in the text and jumped
4723 ;; to the marker. We want to assume we're at the marker now and error if
4725 (unless skip-deleting-marker
4726 (let ((marker (markdown-footnote-delete-marker)))
4728 (error "Not at a footnote"))
4729 ;; Even if we knew the text position before, it changed when we deleted
4731 (setq marker-pos
(cl-second marker
))
4732 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker
))))
4733 (unless new-text-pos
4734 (error "No text for footnote `%s'" (cl-first marker
)))
4735 (goto-char new-text-pos
))))
4736 (let ((pos (markdown-footnote-kill-text)))
4737 (goto-char (if starting-footnote-text-positions
4741 (defun markdown-footnote-delete-marker ()
4742 "Delete a footnote marker at point.
4743 Returns a list (ID START) containing the footnote ID and the
4744 start position of the marker before deletion. If no footnote
4745 marker was deleted, this function returns NIL."
4746 (let ((marker (markdown-footnote-marker-positions)))
4748 (delete-region (cl-second marker
) (cl-third marker
))
4751 (defun markdown-footnote-kill-text ()
4752 "Kill footnote text at point.
4753 Returns the start position of the footnote text before deletion,
4754 or NIL if point was not inside a footnote text.
4756 The killed text is placed in the kill ring (without the footnote
4758 (let ((fn (markdown-footnote-text-positions)))
4760 (let ((text (delete-and-extract-region (cl-second fn
) (cl-third fn
))))
4761 (string-match (concat "\\[\\" (cl-first fn
) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text
)
4762 (kill-new (match-string 1 text
))
4763 (when (and (markdown-cur-line-blank-p)
4764 (markdown-prev-line-blank-p)
4766 (delete-region (1- (point)) (point)))
4769 (defun markdown-footnote-goto-text ()
4770 "Jump to the text of the footnote at point."
4772 (let ((fn (car (markdown-footnote-marker-positions))))
4774 (user-error "Not at a footnote marker"))
4775 (let ((new-pos (markdown-footnote-find-text fn
)))
4777 (error "No definition found for footnote `%s'" fn
))
4778 (goto-char new-pos
))))
4780 (defun markdown-footnote-return ()
4781 "Return from a footnote to its footnote number in the main text."
4783 (let ((fn (save-excursion
4784 (car (markdown-footnote-text-positions)))))
4786 (user-error "Not in a footnote"))
4787 (let ((new-pos (markdown-footnote-find-marker fn
)))
4789 (error "Footnote marker `%s' not found" fn
))
4790 (goto-char new-pos
))))
4792 (defun markdown-footnote-find-marker (id)
4793 "Find the location of the footnote marker with ID.
4794 The actual buffer position returned is the position directly
4795 following the marker's closing bracket. If no marker is found,
4798 (goto-char (point-min))
4799 (when (re-search-forward (concat "\\[" id
"\\]\\([^:]\\|\\'\\)") nil t
)
4800 (skip-chars-backward "^]")
4803 (defun markdown-footnote-find-text (id)
4804 "Find the location of the text of footnote ID.
4805 The actual buffer position returned is the position of the first
4806 character of the text, after the footnote's identifier. If no
4807 footnote text is found, NIL is returned."
4809 (goto-char (point-min))
4810 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id
"\\]:") nil t
)
4811 (skip-chars-forward "[ \t]")
4814 (defun markdown-footnote-marker-positions ()
4815 "Return the position and ID of the footnote marker point is on.
4816 The return value is a list (ID START END). If point is not on a
4817 footnote, NIL is returned."
4818 ;; first make sure we're at a footnote marker
4819 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars
"*\\]?") (line-beginning-position))
4820 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars
"*?\\]")))
4822 ;; move point between [ and ^:
4823 (if (looking-at-p "\\[")
4825 (skip-chars-backward "^["))
4826 (looking-at (concat "\\(\\^" markdown-footnote-chars
"*?\\)\\]"))
4827 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
4829 (defun markdown-footnote-text-positions ()
4830 "Return the start and end positions of the footnote text point is in.
4831 The exact return value is a list of three elements: (ID START END).
4832 The start position is the position of the opening bracket
4833 of the footnote id. The end position is directly after the
4834 newline that ends the footnote. If point is not in a footnote,
4835 NIL is returned instead."
4838 (move-beginning-of-line 1)
4839 ;; Try to find the label. If we haven't found the label and we're at a blank
4840 ;; or indented line, back up if possible.
4842 (not (and (looking-at markdown-regex-footnote-definition
)
4843 (setq result
(list (match-string 1) (point)))))
4845 (or (markdown-cur-line-blank-p)
4846 (>= (current-indentation) 4))))
4849 ;; Advance if there is a next line that is either blank or indented.
4850 ;; (Need to check if we're on the last line, because
4851 ;; markdown-next-line-blank-p returns true for last line in buffer.)
4852 (while (and (/= (line-end-position) (point-max))
4853 (or (markdown-next-line-blank-p)
4854 (>= (markdown-next-line-indent) 4)))
4856 ;; Move back while the current line is blank.
4857 (while (markdown-cur-line-blank-p)
4859 ;; Advance to capture this line and a single trailing newline (if there
4862 (append result
(list (point)))))))
4864 (defun markdown-get-defined-footnotes ()
4865 "Return a list of all defined footnotes.
4866 Result is an alist of pairs (MARKER . LINE), where MARKER is the
4867 footnote marker, a string, and LINE is the line number containing
4868 the footnote definition.
4870 For example, suppose the following footnotes are defined at positions
4873 \[^1]: First footnote here.
4874 \[^marker]: Second footnote.
4876 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
4878 (goto-char (point-min))
4880 (while (markdown-search-until-condition
4881 (lambda () (and (not (markdown-code-block-at-point-p))
4882 (not (markdown-inline-code-at-point-p))
4883 (not (markdown-in-comment-p))))
4884 markdown-regex-footnote-definition nil t
)
4885 (let ((marker (match-string-no-properties 1))
4886 (pos (match-beginning 0)))
4887 (unless (zerop (length marker
))
4888 (cl-pushnew (cons marker pos
) footnotes
:test
#'equal
))))
4889 (reverse footnotes
))))
4892 ;;; Element Removal ===========================================================
4894 (defun markdown-kill-thing-at-point ()
4895 "Kill thing at point and add important text, without markup, to kill ring.
4896 Possible things to kill include (roughly in order of precedence):
4897 inline code, headers, horizontal rules, links (add link text to
4898 kill ring), images (add alt text to kill ring), angle uri, email
4899 addresses, bold, italics, reference definition (add URI to kill
4900 ring), footnote markers and text (kill both marker and text, add
4901 text to kill ring), and list items."
4906 ((markdown-inline-code-at-point)
4907 (kill-new (match-string 2))
4908 (delete-region (match-beginning 0) (match-end 0)))
4910 ((thing-at-point-looking-at markdown-regex-header-atx
)
4911 (kill-new (match-string 2))
4912 (delete-region (match-beginning 0) (match-end 0)))
4914 ((thing-at-point-looking-at markdown-regex-header-setext
)
4915 (kill-new (match-string 1))
4916 (delete-region (match-beginning 0) (match-end 0)))
4918 ((thing-at-point-looking-at markdown-regex-hr
)
4919 (kill-new (match-string 0))
4920 (delete-region (match-beginning 0) (match-end 0)))
4921 ;; Inline link or image (add link or alt text to kill ring)
4922 ((thing-at-point-looking-at markdown-regex-link-inline
)
4923 (kill-new (match-string 3))
4924 (delete-region (match-beginning 0) (match-end 0)))
4925 ;; Reference link or image (add link or alt text to kill ring)
4926 ((thing-at-point-looking-at markdown-regex-link-reference
)
4927 (kill-new (match-string 3))
4928 (delete-region (match-beginning 0) (match-end 0)))
4929 ;; Angle URI (add URL to kill ring)
4930 ((thing-at-point-looking-at markdown-regex-angle-uri
)
4931 (kill-new (match-string 2))
4932 (delete-region (match-beginning 0) (match-end 0)))
4933 ;; Email address in angle brackets (add email address to kill ring)
4934 ((thing-at-point-looking-at markdown-regex-email
)
4935 (kill-new (match-string 1))
4936 (delete-region (match-beginning 0) (match-end 0)))
4937 ;; Wiki link (add alias text to kill ring)
4938 ((and markdown-enable-wiki-links
4939 (thing-at-point-looking-at markdown-regex-wiki-link
))
4940 (kill-new (markdown-wiki-link-alias))
4941 (delete-region (match-beginning 1) (match-end 1)))
4943 ((thing-at-point-looking-at markdown-regex-bold
)
4944 (kill-new (match-string 4))
4945 (delete-region (match-beginning 2) (match-end 2)))
4947 ((thing-at-point-looking-at markdown-regex-italic
)
4948 (kill-new (match-string 3))
4949 (delete-region (match-beginning 1) (match-end 1)))
4951 ((thing-at-point-looking-at markdown-regex-strike-through
)
4952 (kill-new (match-string 4))
4953 (delete-region (match-beginning 2) (match-end 2)))
4954 ;; Footnote marker (add footnote text to kill ring)
4955 ((thing-at-point-looking-at markdown-regex-footnote
)
4956 (markdown-footnote-kill))
4957 ;; Footnote text (add footnote text to kill ring)
4958 ((setq val
(markdown-footnote-text-positions))
4959 (markdown-footnote-kill))
4960 ;; Reference definition (add URL to kill ring)
4961 ((thing-at-point-looking-at markdown-regex-reference-definition
)
4962 (kill-new (match-string 5))
4963 (delete-region (match-beginning 0) (match-end 0)))
4965 ((setq val
(markdown-cur-list-item-bounds))
4966 (kill-new (delete-and-extract-region (cl-first val
) (cl-second val
))))
4968 (user-error "Nothing found at point to kill")))))
4970 (defun markdown-kill-outline ()
4971 "Kill visible heading and add it to `kill-ring'."
4974 (markdown-outline-previous)
4975 (kill-region (point) (progn (markdown-outline-next) (point)))))
4977 (defun markdown-kill-block ()
4978 "Kill visible code block, list item, or blockquote and add it to `kill-ring'."
4981 (markdown-backward-block)
4982 (kill-region (point) (progn (markdown-forward-block) (point)))))
4985 ;;; Indentation ===============================================================
4987 (defun markdown-indent-find-next-position (cur-pos positions
)
4988 "Return the position after the index of CUR-POS in POSITIONS.
4989 Positions are calculated by `markdown-calc-indents'."
4990 (while (and positions
4991 (not (equal cur-pos
(car positions
))))
4992 (setq positions
(cdr positions
)))
4993 (or (cadr positions
) 0))
4995 (defun markdown-outdent-find-next-position (cur-pos positions
)
4996 "Return the maximal element that precedes CUR-POS from POSITIONS.
4997 Positions are calculated by `markdown-calc-indents'."
4999 (dolist (i positions
)
5001 (setq result
(max result i
))))
5004 (defun markdown-indent-line ()
5005 "Indent the current line using some heuristics.
5006 If the _previous_ command was either `markdown-enter-key' or
5007 `markdown-cycle', then we should cycle to the next
5008 reasonable indentation position. Otherwise, we could have been
5009 called directly by `markdown-enter-key', by an initial call of
5010 `markdown-cycle', or indirectly by `auto-fill-mode'. In
5011 these cases, indent to the default position.
5012 Positions are calculated by `markdown-calc-indents'."
5014 (let ((positions (markdown-calc-indents))
5015 (point-pos (current-column))
5016 (_ (back-to-indentation))
5017 (cur-pos (current-column)))
5018 (if (not (equal this-command
'markdown-cycle
))
5019 (indent-line-to (car positions
))
5020 (setq positions
(sort (delete-dups positions
) '<))
5021 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions
))
5022 (new-point-pos (max (+ point-pos
(- next-pos cur-pos
)) 0)))
5023 (indent-line-to next-pos
)
5024 (move-to-column new-point-pos
)))))
5026 (defun markdown-calc-indents ()
5027 "Return a list of indentation columns to cycle through.
5028 The first element in the returned list should be considered the
5029 default indentation level. This function does not worry about
5030 duplicate positions, which are handled up by calling functions."
5031 (let (pos prev-line-pos positions
)
5033 ;; Indentation of previous line
5034 (setq prev-line-pos
(markdown-prev-line-indent))
5035 (setq positions
(cons prev-line-pos positions
))
5037 ;; Indentation of previous non-list-marker text
5038 (when (setq pos
(save-excursion
5040 (when (looking-at markdown-regex-list
)
5041 (- (match-end 3) (match-beginning 0)))))
5042 (setq positions
(cons pos positions
)))
5044 ;; Indentation required for a pre block in current context
5045 (setq pos
(length (markdown-pre-indentation (point))))
5046 (setq positions
(cons pos positions
))
5048 ;; Indentation of the previous line + tab-width
5050 (setq positions
(cons (+ prev-line-pos tab-width
) positions
))
5051 (setq positions
(cons tab-width positions
)))
5053 ;; Indentation of the previous line - tab-width
5054 (if (and prev-line-pos
(> prev-line-pos tab-width
))
5055 (setq positions
(cons (- prev-line-pos tab-width
) positions
)))
5057 ;; Indentation of all preceding list markers (when in a list)
5058 (when (setq pos
(markdown-calculate-list-levels))
5059 (setq positions
(append pos positions
)))
5062 (setq positions
(cons 0 positions
))
5064 ;; Return reversed list
5065 (reverse positions
)))
5067 (defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent
5068 "Handle RET depending on the context.
5069 If the point is at a table, move to the next row. Otherwise,
5070 indent according to value of `markdown-indent-on-enter'.
5071 When it is nil, simply call `newline'. Otherwise, indent the next line
5072 following RET using `markdown-indent-line'. Furthermore, when it
5073 is set to \\='indent-and-new-item and the point is in a list item,
5074 start a new item with the same indentation. If the point is in an
5075 empty list item, remove it (so that pressing RET twice when in a
5076 list simply adds a blank line)."
5080 ((markdown-table-at-point-p)
5081 (call-interactively #'markdown-table-next-row
))
5082 ;; Indent non-table text
5083 (markdown-indent-on-enter
5085 (if (and (memq markdown-indent-on-enter
'(indent-and-new-item))
5086 (setq bounds
(markdown-cur-list-item-bounds)))
5087 (let ((beg (cl-first bounds
))
5088 (end (cl-second bounds
))
5089 (nonlist-indent (cl-fourth bounds
))
5090 (checkbox (cl-sixth bounds
)))
5091 ;; Point is in a list item
5092 (if (= (- end beg
) (+ nonlist-indent
(length checkbox
)))
5093 ;; Delete blank list
5095 (delete-region beg end
)
5097 (markdown-indent-line))
5098 (call-interactively #'markdown-insert-list-item
)))
5099 ;; Point is not in a list
5101 (markdown-indent-line))))
5102 ;; Insert a raw newline
5105 (defun markdown-outdent-or-delete (arg)
5106 "Handle BACKSPACE by cycling through indentation points.
5107 When BACKSPACE is pressed, if there is only whitespace
5108 before the current point, then outdent the line one level.
5109 Otherwise, do normal delete by repeating
5110 `backward-delete-char-untabify' ARG times."
5113 (backward-delete-char-untabify arg
)
5114 (let ((cur-pos (current-column))
5115 (start-of-indention (save-excursion
5116 (back-to-indentation)
5118 (positions (markdown-calc-indents)))
5119 (if (and (> cur-pos
0) (= cur-pos start-of-indention
))
5120 (indent-line-to (markdown-outdent-find-next-position cur-pos positions
))
5121 (backward-delete-char-untabify arg
)))))
5123 (defun markdown-find-leftmost-column (beg end
)
5124 "Find the leftmost column in the region from BEG to END."
5125 (let ((mincol 1000))
5128 (while (< (point) end
)
5129 (back-to-indentation)
5130 (unless (looking-at-p "[ \t]*$")
5131 (setq mincol
(min mincol
(current-column))))
5136 (defun markdown-indent-region (beg end arg
)
5137 "Indent the region from BEG to END using some heuristics.
5138 When ARG is non-nil, outdent the region instead.
5139 See `markdown-indent-line' and `markdown-indent-line'."
5140 (interactive "*r\nP")
5141 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
5142 (leftmostcol (markdown-find-leftmost-column beg end
))
5144 (markdown-outdent-find-next-position leftmostcol positions
)
5145 (markdown-indent-find-next-position leftmostcol positions
))))
5146 (indent-rigidly beg end
(- next-pos leftmostcol
))
5147 (setq deactivate-mark nil
)))
5149 (defun markdown-outdent-region (beg end
)
5150 "Call `markdown-indent-region' on region from BEG to END with prefix."
5152 (markdown-indent-region beg end t
))
5154 (defun markdown--indent-region (start end
)
5155 (let ((deactivate-mark nil
))
5158 (setq end
(point-marker))
5162 (while (< (point) end
)
5163 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp)))
5164 (indent-according-to-mode))
5166 (move-marker end nil
))))
5169 ;;; Markup Completion =========================================================
5171 (defconst markdown-complete-alist
5172 '((markdown-regex-header-atx . markdown-complete-atx
)
5173 (markdown-regex-header-setext . markdown-complete-setext
)
5174 (markdown-regex-hr . markdown-complete-hr
))
5175 "Association list of form (regexp . function) for markup completion.")
5177 (defun markdown-incomplete-atx-p ()
5178 "Return t if ATX header markup is incomplete and nil otherwise.
5179 Assumes match data is available for `markdown-regex-header-atx'.
5180 Checks that the number of trailing hash marks equals the number of leading
5181 hash marks, that there is only a single space before and after the text,
5182 and that there is no extraneous whitespace in the text."
5184 ;; Number of starting and ending hash marks differs
5185 (not (= (length (match-string 1)) (length (match-string 3))))
5186 ;; When the header text is not empty...
5187 (and (> (length (match-string 2)) 0)
5188 ;; ...if there are extra leading, trailing, or interior spaces
5189 (or (not (= (match-beginning 2) (1+ (match-end 1))))
5190 (not (= (match-beginning 3) (1+ (match-end 2))))
5191 (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
5192 ;; When the header text is empty...
5193 (and (= (length (match-string 2)) 0)
5194 ;; ...if there are too many or too few spaces
5195 (not (= (match-beginning 3) (+ (match-end 1) 2))))))
5197 (defun markdown-complete-atx ()
5198 "Complete and normalize ATX headers.
5199 Add or remove hash marks to the end of the header to match the
5200 beginning. Ensure that there is only a single space between hash
5201 marks and header text. Removes extraneous whitespace from header text.
5202 Assumes match data is available for `markdown-regex-header-atx'.
5203 Return nil if markup was complete and non-nil if markup was completed."
5204 (when (markdown-incomplete-atx-p)
5205 (let* ((new-marker (make-marker))
5206 (new-marker (set-marker new-marker
(match-end 2))))
5207 ;; Hash marks and spacing at end
5208 (goto-char (match-end 2))
5209 (delete-region (match-end 2) (match-end 3))
5210 (insert " " (match-string 1))
5211 ;; Remove extraneous whitespace from title
5212 (replace-match (markdown-compress-whitespace-string (match-string 2))
5214 ;; Spacing at beginning
5215 (goto-char (match-end 1))
5216 (delete-region (match-end 1) (match-beginning 2))
5218 ;; Leave point at end of text
5219 (goto-char new-marker
))))
5221 (defun markdown-incomplete-setext-p ()
5222 "Return t if setext header markup is incomplete and nil otherwise.
5223 Assumes match data is available for `markdown-regex-header-setext'.
5224 Checks that length of underline matches text and that there is no
5225 extraneous whitespace in the text."
5226 (or (not (= (length (match-string 1)) (length (match-string 2))))
5227 (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
5229 (defun markdown-complete-setext ()
5230 "Complete and normalize setext headers.
5231 Add or remove underline characters to match length of header
5232 text. Removes extraneous whitespace from header text. Assumes
5233 match data is available for `markdown-regex-header-setext'.
5234 Return nil if markup was complete and non-nil if markup was completed."
5235 (when (markdown-incomplete-setext-p)
5236 (let* ((text (markdown-compress-whitespace-string (match-string 1)))
5237 (char (char-after (match-beginning 2)))
5238 (level (if (char-equal char ?-
) 2 1)))
5239 (goto-char (match-beginning 0))
5240 (delete-region (match-beginning 0) (match-end 0))
5241 (markdown-insert-header level text t
)
5244 (defun markdown-incomplete-hr-p ()
5245 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
5246 Assumes match data is available for `markdown-regex-hr'."
5247 (not (member (match-string 0) markdown-hr-strings
)))
5249 (defun markdown-complete-hr ()
5250 "Complete horizontal rules.
5251 If horizontal rule string is a member of `markdown-hr-strings',
5252 do nothing. Otherwise, replace with the car of
5253 `markdown-hr-strings'.
5254 Assumes match data is available for `markdown-regex-hr'.
5255 Return nil if markup was complete and non-nil if markup was completed."
5256 (when (markdown-incomplete-hr-p)
5257 (replace-match (car markdown-hr-strings
))
5260 (defun markdown-complete ()
5261 "Complete markup of object near point or in region when active.
5262 Handle all objects in `markdown-complete-alist', in order.
5263 See `markdown-complete-at-point' and `markdown-complete-region'."
5266 (markdown-complete-region (region-beginning) (region-end))
5267 (markdown-complete-at-point)))
5269 (defun markdown-complete-at-point ()
5270 "Complete markup of object near point.
5271 Handle all elements of `markdown-complete-alist' in order."
5273 (let ((list markdown-complete-alist
) found changed
)
5275 (let ((regexp (eval (caar list
) t
)) ;FIXME: Why `eval'?
5276 (function (cdar list
)))
5277 (setq list
(cdr list
))
5278 (when (thing-at-point-looking-at regexp
)
5280 (setq changed
(funcall function
))
5283 (or changed
(user-error "Markup at point is complete"))
5284 (user-error "Nothing to complete at point"))))
5286 (defun markdown-complete-region (beg end
)
5287 "Complete markup of objects in region from BEG to END.
5288 Handle all objects in `markdown-complete-alist', in order. Each
5289 match is checked to ensure that a previous regexp does not also
5292 (let ((end-marker (set-marker (make-marker) end
))
5294 (dolist (element markdown-complete-alist
)
5295 (let ((regexp (eval (car element
) t
)) ;FIXME: Why `eval'?
5296 (function (cdr element
)))
5298 (while (re-search-forward regexp end-marker
'limit
)
5299 (when (match-string 0)
5300 ;; Make sure this is not a match for any of the preceding regexps.
5301 ;; This prevents mistaking an HR for a Setext subheading.
5304 (dolist (prev-regexp previous
)
5305 (or match
(setq match
(looking-back prev-regexp nil
)))))
5307 (save-excursion (funcall function
))))))
5308 (cl-pushnew regexp previous
:test
#'equal
)))
5311 (defun markdown-complete-buffer ()
5312 "Complete markup for all objects in the current buffer."
5314 (markdown-complete-region (point-min) (point-max)))
5317 ;;; Markup Cycling ============================================================
5319 (defun markdown-cycle-atx (arg &optional remove
)
5320 "Cycle ATX header markup.
5321 Promote header (decrease level) when ARG is 1 and demote
5322 header (increase level) if arg is -1. When REMOVE is non-nil,
5323 remove the header when the level reaches zero and stop cycling
5324 when it reaches six. Otherwise, perform a proper cycling through
5325 levels one through six. Assumes match data is available for
5326 `markdown-regex-header-atx'."
5327 (let* ((old-level (length (match-string 1)))
5328 (new-level (+ old-level arg
))
5329 (text (match-string 2)))
5331 (setq new-level
(% new-level
6))
5332 (setq new-level
(cond ((= new-level
0) 6)
5333 ((< new-level
0) (+ new-level
6))
5337 (markdown-unwrap-thing-at-point nil
0 2))
5339 (goto-char (match-beginning 0))
5340 (delete-region (match-beginning 0) (match-end 0))
5341 (markdown-insert-header new-level text nil
)))))
5343 (defun markdown-cycle-setext (arg &optional remove
)
5344 "Cycle setext header markup.
5345 Promote header (increase level) when ARG is 1 and demote
5346 header (decrease level or remove) if arg is -1. When demoting a
5347 level-two setext header, replace with a level-three atx header.
5348 When REMOVE is non-nil, remove the header when the level reaches
5349 zero. Otherwise, cycle back to a level six atx header. Assumes
5350 match data is available for `markdown-regex-header-setext'."
5351 (let* ((char (char-after (match-beginning 2)))
5352 (old-level (if (char-equal char ?
=) 1 2))
5353 (new-level (+ old-level arg
)))
5354 (when (and (not remove
) (= new-level
0))
5358 (markdown-unwrap-thing-at-point nil
0 1))
5360 (markdown-insert-header new-level nil t
))
5362 (markdown-insert-header new-level nil nil
)))))
5364 (defun markdown-cycle-hr (arg &optional remove
)
5365 "Cycle string used for horizontal rule from `markdown-hr-strings'.
5366 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
5367 backwards (promote). When REMOVE is non-nil, remove the hr instead
5368 of cycling when the end of the list is reached.
5369 Assumes match data is available for `markdown-regex-hr'."
5370 (let* ((strings (if (= arg -
1)
5371 (reverse markdown-hr-strings
)
5372 markdown-hr-strings
))
5373 (tail (member (match-string 0) strings
))
5374 (new (or (cadr tail
)
5380 (replace-match new
)))
5382 (defun markdown-cycle-bold ()
5383 "Cycle bold markup between underscores and asterisks.
5384 Assumes match data is available for `markdown-regex-bold'."
5386 (let* ((old-delim (match-string 3))
5387 (new-delim (if (string-equal old-delim
"**") "__" "**")))
5388 (replace-match new-delim t t nil
3)
5389 (replace-match new-delim t t nil
5))))
5391 (defun markdown-cycle-italic ()
5392 "Cycle italic markup between underscores and asterisks.
5393 Assumes match data is available for `markdown-regex-italic'."
5395 (let* ((old-delim (match-string 2))
5396 (new-delim (if (string-equal old-delim
"*") "_" "*")))
5397 (replace-match new-delim t t nil
2)
5398 (replace-match new-delim t t nil
4))))
5401 ;;; Keymap ====================================================================
5403 (defun markdown--style-map-prompt ()
5404 "Return a formatted prompt for Markdown markup insertion."
5405 (when markdown-enable-prefix-prompts
5408 (propertize "bold" 'face
'markdown-bold-face
) ", "
5409 (propertize "italic" 'face
'markdown-italic-face
) ", "
5410 (propertize "code" 'face
'markdown-inline-code-face
) ", "
5411 (propertize "C = GFM code" 'face
'markdown-code-face
) ", "
5412 (propertize "pre" 'face
'markdown-pre-face
) ", "
5413 (propertize "footnote" 'face
'markdown-footnote-text-face
) ", "
5414 (propertize "F = foldable" 'face
'markdown-bold-face
) ", "
5415 (propertize "q = blockquote" 'face
'markdown-blockquote-face
) ", "
5416 (propertize "h & 1-6 = heading" 'face
'markdown-header-face
) ", "
5417 (propertize "- = hr" 'face
'markdown-hr-face
) ", "
5420 (defun markdown--command-map-prompt ()
5421 "Return prompt for Markdown buffer-wide commands."
5422 (when markdown-enable-prefix-prompts
5425 (propertize "m" 'face
'markdown-bold-face
) "arkdown, "
5426 (propertize "p" 'face
'markdown-bold-face
) "review, "
5427 (propertize "o" 'face
'markdown-bold-face
) "pen, "
5428 (propertize "e" 'face
'markdown-bold-face
) "xport, "
5429 "export & pre" (propertize "v" 'face
'markdown-bold-face
) "iew, "
5430 (propertize "c" 'face
'markdown-bold-face
) "heck refs, "
5431 (propertize "u" 'face
'markdown-bold-face
) "nused refs, "
5434 (defvar markdown-mode-style-map
5435 (let ((map (make-keymap (markdown--style-map-prompt))))
5436 (define-key map
(kbd "1") 'markdown-insert-header-atx-1
)
5437 (define-key map
(kbd "2") 'markdown-insert-header-atx-2
)
5438 (define-key map
(kbd "3") 'markdown-insert-header-atx-3
)
5439 (define-key map
(kbd "4") 'markdown-insert-header-atx-4
)
5440 (define-key map
(kbd "5") 'markdown-insert-header-atx-5
)
5441 (define-key map
(kbd "6") 'markdown-insert-header-atx-6
)
5442 (define-key map
(kbd "!") 'markdown-insert-header-setext-1
)
5443 (define-key map
(kbd "@") 'markdown-insert-header-setext-2
)
5444 (define-key map
(kbd "b") 'markdown-insert-bold
)
5445 (define-key map
(kbd "c") 'markdown-insert-code
)
5446 (define-key map
(kbd "C") 'markdown-insert-gfm-code-block
)
5447 (define-key map
(kbd "f") 'markdown-insert-footnote
)
5448 (define-key map
(kbd "F") 'markdown-insert-foldable-block
)
5449 (define-key map
(kbd "h") 'markdown-insert-header-dwim
)
5450 (define-key map
(kbd "H") 'markdown-insert-header-setext-dwim
)
5451 (define-key map
(kbd "i") 'markdown-insert-italic
)
5452 (define-key map
(kbd "k") 'markdown-insert-kbd
)
5453 (define-key map
(kbd "l") 'markdown-insert-link
)
5454 (define-key map
(kbd "p") 'markdown-insert-pre
)
5455 (define-key map
(kbd "P") 'markdown-pre-region
)
5456 (define-key map
(kbd "q") 'markdown-insert-blockquote
)
5457 (define-key map
(kbd "s") 'markdown-insert-strike-through
)
5458 (define-key map
(kbd "t") 'markdown-insert-table
)
5459 (define-key map
(kbd "Q") 'markdown-blockquote-region
)
5460 (define-key map
(kbd "w") 'markdown-insert-wiki-link
)
5461 (define-key map
(kbd "-") 'markdown-insert-hr
)
5462 (define-key map
(kbd "[") 'markdown-insert-gfm-checkbox
)
5463 ;; Deprecated keys that may be removed in a future version
5464 (define-key map
(kbd "e") 'markdown-insert-italic
)
5466 "Keymap for Markdown text styling commands.")
5468 (defvar markdown-mode-command-map
5469 (let ((map (make-keymap (markdown--command-map-prompt))))
5470 (define-key map
(kbd "m") 'markdown-other-window
)
5471 (define-key map
(kbd "p") 'markdown-preview
)
5472 (define-key map
(kbd "e") 'markdown-export
)
5473 (define-key map
(kbd "v") 'markdown-export-and-preview
)
5474 (define-key map
(kbd "o") 'markdown-open
)
5475 (define-key map
(kbd "l") 'markdown-live-preview-mode
)
5476 (define-key map
(kbd "w") 'markdown-kill-ring-save
)
5477 (define-key map
(kbd "c") 'markdown-check-refs
)
5478 (define-key map
(kbd "u") 'markdown-unused-refs
)
5479 (define-key map
(kbd "n") 'markdown-cleanup-list-numbers
)
5480 (define-key map
(kbd "]") 'markdown-complete-buffer
)
5481 (define-key map
(kbd "^") 'markdown-table-sort-lines
)
5482 (define-key map
(kbd "|") 'markdown-table-convert-region
)
5483 (define-key map
(kbd "t") 'markdown-table-transpose
)
5485 "Keymap for Markdown buffer-wide commands.")
5487 (defvar markdown-mode-map
5488 (let ((map (make-keymap)))
5489 ;; Markup insertion & removal
5490 (define-key map
(kbd "C-c C-s") markdown-mode-style-map
)
5491 (define-key map
(kbd "C-c C-l") 'markdown-insert-link
)
5492 (define-key map
(kbd "C-c C-k") 'markdown-kill-thing-at-point
)
5493 ;; Promotion, demotion, and cycling
5494 (define-key map
(kbd "C-c C--") 'markdown-promote
)
5495 (define-key map
(kbd "C-c C-=") 'markdown-demote
)
5496 (define-key map
(kbd "C-c C-]") 'markdown-complete
)
5497 ;; Following and doing things
5498 (define-key map
(kbd "C-c C-o") 'markdown-follow-thing-at-point
)
5499 (define-key map
(kbd "C-c C-d") 'markdown-do
)
5500 (define-key map
(kbd "C-c '") 'markdown-edit-code-block
)
5502 (define-key map
(kbd "RET") 'markdown-enter-key
)
5503 (define-key map
(kbd "DEL") 'markdown-outdent-or-delete
)
5504 (define-key map
(kbd "C-c >") 'markdown-indent-region
)
5505 (define-key map
(kbd "C-c <") 'markdown-outdent-region
)
5506 ;; Visibility cycling
5507 (define-key map
(kbd "TAB") 'markdown-cycle
)
5508 ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by
5509 ;; (local-)function-key-map.
5510 ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
5511 ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab)
5512 (define-key map
(kbd "<backtab>") 'markdown-shifttab
)
5513 ;; Heading and list navigation
5514 (define-key map
(kbd "C-c C-n") 'markdown-outline-next
)
5515 (define-key map
(kbd "C-c C-p") 'markdown-outline-previous
)
5516 (define-key map
(kbd "C-c C-f") 'markdown-outline-next-same-level
)
5517 (define-key map
(kbd "C-c C-b") 'markdown-outline-previous-same-level
)
5518 (define-key map
(kbd "C-c C-u") 'markdown-outline-up
)
5519 ;; Buffer-wide commands
5520 (define-key map
(kbd "C-c C-c") markdown-mode-command-map
)
5521 ;; Subtree, list, and table editing
5522 (define-key map
(kbd "C-c <up>") 'markdown-move-up
)
5523 (define-key map
(kbd "C-c <down>") 'markdown-move-down
)
5524 (define-key map
(kbd "C-c <left>") 'markdown-promote
)
5525 (define-key map
(kbd "C-c <right>") 'markdown-demote
)
5526 (define-key map
(kbd "C-c S-<up>") 'markdown-table-delete-row
)
5527 (define-key map
(kbd "C-c S-<down>") 'markdown-table-insert-row
)
5528 (define-key map
(kbd "C-c S-<left>") 'markdown-table-delete-column
)
5529 (define-key map
(kbd "C-c S-<right>") 'markdown-table-insert-column
)
5530 (define-key map
(kbd "C-c C-M-h") 'markdown-mark-subtree
)
5531 (define-key map
(kbd "C-x n s") 'markdown-narrow-to-subtree
)
5532 (define-key map
(kbd "M-RET") 'markdown-insert-list-item
)
5533 (define-key map
(kbd "C-c C-j") 'markdown-insert-list-item
)
5534 ;; Paragraphs (Markdown context aware)
5535 (define-key map
[remap backward-paragraph
] 'markdown-backward-paragraph
)
5536 (define-key map
[remap forward-paragraph
] 'markdown-forward-paragraph
)
5537 (define-key map
[remap mark-paragraph
] 'markdown-mark-paragraph
)
5538 ;; Blocks (one or more paragraphs)
5539 (define-key map
(kbd "C-M-{") 'markdown-backward-block
)
5540 (define-key map
(kbd "C-M-}") 'markdown-forward-block
)
5541 (define-key map
(kbd "C-c M-h") 'markdown-mark-block
)
5542 (define-key map
(kbd "C-x n b") 'markdown-narrow-to-block
)
5543 ;; Pages (top-level sections)
5544 (define-key map
[remap backward-page
] 'markdown-backward-page
)
5545 (define-key map
[remap forward-page
] 'markdown-forward-page
)
5546 (define-key map
[remap mark-page
] 'markdown-mark-page
)
5547 (define-key map
[remap narrow-to-page
] 'markdown-narrow-to-page
)
5549 (define-key map
(kbd "M-n") 'markdown-next-link
)
5550 (define-key map
(kbd "M-p") 'markdown-previous-link
)
5551 ;; Toggling functionality
5552 (define-key map
(kbd "C-c C-x C-e") 'markdown-toggle-math
)
5553 (define-key map
(kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively
)
5554 (define-key map
(kbd "C-c C-x C-i") 'markdown-toggle-inline-images
)
5555 (define-key map
(kbd "C-c C-x C-l") 'markdown-toggle-url-hiding
)
5556 (define-key map
(kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding
)
5557 ;; Alternative keys (in case of problems with the arrow keys)
5558 (define-key map
(kbd "C-c C-x u") 'markdown-move-up
)
5559 (define-key map
(kbd "C-c C-x d") 'markdown-move-down
)
5560 (define-key map
(kbd "C-c C-x l") 'markdown-promote
)
5561 (define-key map
(kbd "C-c C-x r") 'markdown-demote
)
5562 ;; Deprecated keys that may be removed in a future version
5563 (define-key map
(kbd "C-c C-a L") 'markdown-insert-link
) ;; C-c C-l
5564 (define-key map
(kbd "C-c C-a l") 'markdown-insert-link
) ;; C-c C-l
5565 (define-key map
(kbd "C-c C-a r") 'markdown-insert-link
) ;; C-c C-l
5566 (define-key map
(kbd "C-c C-a u") 'markdown-insert-uri
) ;; C-c C-l
5567 (define-key map
(kbd "C-c C-a f") 'markdown-insert-footnote
)
5568 (define-key map
(kbd "C-c C-a w") 'markdown-insert-wiki-link
)
5569 (define-key map
(kbd "C-c C-t 1") 'markdown-insert-header-atx-1
)
5570 (define-key map
(kbd "C-c C-t 2") 'markdown-insert-header-atx-2
)
5571 (define-key map
(kbd "C-c C-t 3") 'markdown-insert-header-atx-3
)
5572 (define-key map
(kbd "C-c C-t 4") 'markdown-insert-header-atx-4
)
5573 (define-key map
(kbd "C-c C-t 5") 'markdown-insert-header-atx-5
)
5574 (define-key map
(kbd "C-c C-t 6") 'markdown-insert-header-atx-6
)
5575 (define-key map
(kbd "C-c C-t !") 'markdown-insert-header-setext-1
)
5576 (define-key map
(kbd "C-c C-t @") 'markdown-insert-header-setext-2
)
5577 (define-key map
(kbd "C-c C-t h") 'markdown-insert-header-dwim
)
5578 (define-key map
(kbd "C-c C-t H") 'markdown-insert-header-setext-dwim
)
5579 (define-key map
(kbd "C-c C-t s") 'markdown-insert-header-setext-2
)
5580 (define-key map
(kbd "C-c C-t t") 'markdown-insert-header-setext-1
)
5581 (define-key map
(kbd "C-c C-i") 'markdown-insert-image
)
5582 (define-key map
(kbd "C-c C-x m") 'markdown-insert-list-item
) ;; C-c C-j
5583 (define-key map
(kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox
) ;; C-c C-d
5584 (define-key map
(kbd "C-c -") 'markdown-insert-hr
)
5586 "Keymap for Markdown major mode.")
5588 (defvar markdown-mode-mouse-map
5589 (when markdown-mouse-follow-link
5590 (let ((map (make-sparse-keymap)))
5591 (define-key map
[follow-link
] 'mouse-face
)
5592 (define-key map
[mouse-2
] #'markdown-follow-thing-at-point
)
5594 "Keymap for following links with mouse.")
5596 (defvar gfm-mode-map
5597 (let ((map (make-sparse-keymap)))
5598 (set-keymap-parent map markdown-mode-map
)
5599 (define-key map
(kbd "C-c C-s d") 'markdown-insert-strike-through
)
5600 (define-key map
"`" 'markdown-electric-backquote
)
5602 "Keymap for `gfm-mode'.
5603 See also `markdown-mode-map'.")
5606 ;;; Menu ======================================================================
5608 (easy-menu-define markdown-mode-menu markdown-mode-map
5609 "Menu for Markdown mode."
5613 ["Jump" markdown-do
]
5614 ["Follow Link" markdown-follow-thing-at-point
]
5615 ["Next Link" markdown-next-link
]
5616 ["Previous Link" markdown-previous-link
]
5618 ["Next Heading or List Item" markdown-outline-next
]
5619 ["Previous Heading or List Item" markdown-outline-previous
]
5620 ["Next at Same Level" markdown-outline-next-same-level
]
5621 ["Previous at Same Level" markdown-outline-previous-same-level
]
5622 ["Up to Parent" markdown-outline-up
]
5624 ["Forward Paragraph" markdown-forward-paragraph
]
5625 ["Backward Paragraph" markdown-backward-paragraph
]
5626 ["Forward Block" markdown-forward-block
]
5627 ["Backward Block" markdown-backward-block
])
5629 ["Cycle Heading Visibility" markdown-cycle
5630 :enable
(markdown-on-heading-p)]
5631 ["Cycle Heading Visibility (Global)" markdown-shifttab
]
5633 ["Narrow to Region" narrow-to-region
]
5634 ["Narrow to Block" markdown-narrow-to-block
]
5635 ["Narrow to Section" narrow-to-defun
]
5636 ["Narrow to Subtree" markdown-narrow-to-subtree
]
5637 ["Widen" widen
(buffer-narrowed-p)]
5639 ["Toggle Markup Hiding" markdown-toggle-markup-hiding
5642 :selected markdown-hide-markup
])
5644 ("Headings & Structure"
5645 ["Automatic Heading" markdown-insert-header-dwim
5647 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
5649 ("Specific Heading (atx)"
5650 ["First Level atx" markdown-insert-header-atx-1
5652 ["Second Level atx" markdown-insert-header-atx-2
5654 ["Third Level atx" markdown-insert-header-atx-3
5656 ["Fourth Level atx" markdown-insert-header-atx-4
5658 ["Fifth Level atx" markdown-insert-header-atx-5
5660 ["Sixth Level atx" markdown-insert-header-atx-6
5662 ("Specific Heading (Setext)"
5663 ["First Level Setext" markdown-insert-header-setext-1
5665 ["Second Level Setext" markdown-insert-header-setext-2
5667 ["Horizontal Rule" markdown-insert-hr
5670 ["Move Subtree Up" markdown-move-up
5672 ["Move Subtree Down" markdown-move-down
5674 ["Promote Subtree" markdown-promote
5676 ["Demote Subtree" markdown-demote
5677 :keys
"C-c <right>"])
5679 ["Indent Region" markdown-indent-region
]
5680 ["Outdent Region" markdown-outdent-region
]
5682 ["Mark Paragraph" mark-paragraph
]
5683 ["Mark Block" markdown-mark-block
]
5684 ["Mark Section" mark-defun
]
5685 ["Mark Subtree" markdown-mark-subtree
])
5687 ["Move Row Up" markdown-move-up
5688 :enable
(markdown-table-at-point-p)
5690 ["Move Row Down" markdown-move-down
5691 :enable
(markdown-table-at-point-p)
5693 ["Move Column Left" markdown-promote
5694 :enable
(markdown-table-at-point-p)
5696 ["Move Column Right" markdown-demote
5697 :enable
(markdown-table-at-point-p)
5698 :keys
"C-c <right>"]
5699 ["Delete Row" markdown-table-delete-row
5700 :enable
(markdown-table-at-point-p)]
5701 ["Insert Row" markdown-table-insert-row
5702 :enable
(markdown-table-at-point-p)]
5703 ["Delete Column" markdown-table-delete-column
5704 :enable
(markdown-table-at-point-p)]
5705 ["Insert Column" markdown-table-insert-column
5706 :enable
(markdown-table-at-point-p)]
5707 ["Insert Table" markdown-insert-table
]
5709 ["Convert Region to Table" markdown-table-convert-region
]
5710 ["Sort Table Lines" markdown-table-sort-lines
5711 :enable
(markdown-table-at-point-p)]
5712 ["Transpose Table" markdown-table-transpose
5713 :enable
(markdown-table-at-point-p)])
5715 ["Insert List Item" markdown-insert-list-item
]
5716 ["Move Subtree Up" markdown-move-up
5718 ["Move Subtree Down" markdown-move-down
5720 ["Indent Subtree" markdown-demote
5721 :keys
"C-c <right>"]
5722 ["Outdent Subtree" markdown-promote
5724 ["Renumber List" markdown-cleanup-list-numbers
]
5725 ["Insert Task List Item" markdown-insert-gfm-checkbox
5727 ["Toggle Task List Item" markdown-toggle-gfm-checkbox
5728 :enable
(markdown-gfm-task-list-item-at-point)
5731 ["Insert Link" markdown-insert-link
]
5732 ["Insert Image" markdown-insert-image
]
5733 ["Insert Footnote" markdown-insert-footnote
5735 ["Insert Wiki Link" markdown-insert-wiki-link
5738 ["Check References" markdown-check-refs
]
5739 ["Find Unused References" markdown-unused-refs
]
5740 ["Toggle URL Hiding" markdown-toggle-url-hiding
5742 :selected markdown-hide-urls
]
5743 ["Toggle Inline Images" markdown-toggle-inline-images
5746 :selected markdown-inline-image-overlays
]
5747 ["Toggle Wiki Links" markdown-toggle-wiki-links
5749 :selected markdown-enable-wiki-links
])
5751 ["Bold" markdown-insert-bold
]
5752 ["Italic" markdown-insert-italic
]
5753 ["Code" markdown-insert-code
]
5754 ["Strikethrough" markdown-insert-strike-through
]
5755 ["Keyboard" markdown-insert-kbd
]
5757 ["Blockquote" markdown-insert-blockquote
]
5758 ["Preformatted" markdown-insert-pre
]
5759 ["GFM Code Block" markdown-insert-gfm-code-block
]
5760 ["Edit Code Block" markdown-edit-code-block
5761 :enable
(markdown-code-block-at-point-p)]
5762 ["Foldable Block" markdown-insert-foldable-block
]
5764 ["Blockquote Region" markdown-blockquote-region
]
5765 ["Preformatted Region" markdown-pre-region
]
5767 ["Fontify Code Blocks Natively"
5768 markdown-toggle-fontify-code-blocks-natively
5770 :selected markdown-fontify-code-blocks-natively
]
5771 ["LaTeX Math Support" markdown-toggle-math
5773 :selected markdown-enable-math
])
5776 ["Compile" markdown-other-window
]
5777 ["Preview" markdown-preview
]
5778 ["Export" markdown-export
]
5779 ["Export & View" markdown-export-and-preview
]
5780 ["Open" markdown-open
]
5781 ["Live Export" markdown-live-preview-mode
5783 :selected markdown-live-preview-mode
]
5784 ["Kill ring save" markdown-kill-ring-save
])
5785 ("Markup Completion and Cycling"
5786 ["Complete Markup" markdown-complete
]
5787 ["Promote Element" markdown-promote
5789 ["Demote Element" markdown-demote
5792 ["Kill Element" markdown-kill-thing-at-point
]
5795 ["Version" markdown-show-version
]
5796 ["Homepage" markdown-mode-info
]
5797 ["Describe Mode" (describe-function 'markdown-mode
)]
5798 ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
5801 ;;; imenu =====================================================================
5803 (defun markdown-imenu-create-nested-index ()
5804 "Create and return a nested imenu index alist for the current buffer.
5805 See `imenu-create-index-function' and `imenu--index-alist' for details."
5806 (let* ((root (list nil
))
5811 (goto-char (point-min))
5812 (while (re-search-forward markdown-regex-header
(point-max) t
)
5813 (unless (or (markdown-code-block-at-point-p)
5814 (and (match-beginning 3)
5815 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end
)))
5817 ((match-string-no-properties 2) ;; level 1 setext
5819 (push (list :heading
(match-string-no-properties 1)
5820 :point
(match-beginning 1)
5822 ((match-string-no-properties 3) ;; level 2 setext
5823 (setq min-level
(min min-level
2))
5824 (push (list :heading
(match-string-no-properties 1)
5825 :point
(match-beginning 1)
5826 :level
(- 2 (1- min-level
))) headers
))
5827 ((setq hashes
(markdown-trim-whitespace
5828 (match-string-no-properties 4)))
5829 (setq min-level
(min min-level
(length hashes
)))
5830 (push (list :heading
(match-string-no-properties 5)
5831 :point
(match-beginning 4)
5832 :level
(- (length hashes
) (1- min-level
))) headers
)))))
5833 (cl-loop with cur-level
= 0
5834 with cur-alist
= nil
5835 with empty-heading
= "-"
5836 with self-heading
= "."
5837 for header in
(reverse headers
)
5838 for level
= (plist-get header
:level
)
5840 (let ((alist (list (cons (plist-get header
:heading
) (plist-get header
:point
)))))
5842 ((= cur-level level
) ; new sibling
5843 (setcdr cur-alist alist
)
5844 (setq cur-alist alist
))
5845 ((< cur-level level
) ; first child
5846 (dotimes (_ (- level cur-level
1))
5847 (setq alist
(list (cons empty-heading alist
))))
5849 (let* ((parent (car cur-alist
))
5850 (self-pos (cdr parent
)))
5851 (setcdr parent
(cons (cons self-heading self-pos
) alist
)))
5852 (setcdr root alist
)) ; primogenitor
5853 (setq cur-alist alist
)
5854 (setq cur-level level
))
5855 (t ; new sibling of an ancestor
5856 (let ((sibling-alist (last (cdr root
))))
5857 (dotimes (_ (1- level
))
5858 (setq sibling-alist
(last (cdar sibling-alist
))))
5859 (setcdr sibling-alist alist
)
5860 (setq cur-alist alist
))
5861 (setq cur-level level
)))))
5862 (setq root
(copy-tree root
))
5864 (let ((fn (markdown-get-defined-footnotes)))
5865 (if (or (zerop (length fn
))
5866 (null markdown-add-footnotes-to-imenu
))
5868 (nconc (cdr root
) (list (cons "Footnotes" fn
))))))))
5870 (defun markdown-imenu-create-flat-index ()
5871 "Create and return a flat imenu index alist for the current buffer.
5872 See `imenu-create-index-function' and `imenu--index-alist' for details."
5873 (let* ((empty-heading "-") index heading pos
)
5876 (goto-char (point-min))
5877 (while (re-search-forward markdown-regex-header
(point-max) t
)
5878 (when (and (not (markdown-code-block-at-point-p (line-beginning-position)))
5879 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin
)))
5881 ((setq heading
(match-string-no-properties 1))
5882 (setq pos
(match-beginning 1)))
5883 ((setq heading
(match-string-no-properties 5))
5884 (setq pos
(match-beginning 4))))
5885 (or (> (length heading
) 0)
5886 (setq heading empty-heading
))
5887 (setq index
(append index
(list (cons heading pos
))))))
5889 (when markdown-add-footnotes-to-imenu
5890 (nconc index
(markdown-get-defined-footnotes)))
5894 ;;; References ================================================================
5896 (defun markdown-reference-goto-definition ()
5897 "Jump to the definition of the reference at point or create it."
5899 (when (thing-at-point-looking-at markdown-regex-link-reference
)
5900 (let* ((text (match-string-no-properties 3))
5901 (reference (match-string-no-properties 6))
5902 (target (downcase (if (string= reference
"") text reference
)))
5903 (loc (cadr (save-match-data (markdown-reference-definition target
)))))
5906 (goto-char (match-beginning 0))
5907 (markdown-insert-reference-definition target
)))))
5909 (defun markdown-reference-find-links (reference)
5910 "Return a list of all links for REFERENCE.
5911 REFERENCE should not include the surrounding square brackets.
5912 Elements of the list have the form (text start line), where
5913 text is the link text, start is the location at the beginning of
5914 the link, and line is the line number on which the link appears."
5915 (let* ((ref-quote (regexp-quote reference
))
5916 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
5917 ref-quote ref-quote
))
5920 (goto-char (point-min))
5921 (while (re-search-forward regexp nil t
)
5922 (let* ((text (or (match-string-no-properties 1)
5923 (match-string-no-properties 2)))
5924 (start (match-beginning 0))
5925 (line (markdown-line-number-at-pos)))
5926 (cl-pushnew (list text start line
) links
:test
#'equal
))))
5929 (defmacro markdown-for-all-refs
(f)
5932 (goto-char (point-min))
5934 (re-search-forward markdown-regex-link-reference nil t
)
5935 (let* ((text (match-string-no-properties 3))
5936 (reference (match-string-no-properties 6))
5937 (target (downcase (if (string= reference
"") text reference
))))
5938 (,f text target result
))))
5941 (defmacro markdown-collect-always
(_ target result
)
5942 `(cl-pushnew ,target
,result
:test
#'equal
))
5944 (defmacro markdown-collect-undefined
(text target result
)
5945 `(unless (markdown-reference-definition target
)
5946 (let ((entry (assoc ,target
,result
)))
5949 (cons ,target
(list (cons ,text
(markdown-line-number-at-pos))))
5950 ,result
:test
#'equal
)
5952 (append (cdr entry
) (list (cons ,text
(markdown-line-number-at-pos)))))))))
5954 (defun markdown-get-all-refs ()
5955 "Return a list of all Markdown references."
5956 (markdown-for-all-refs markdown-collect-always
))
5958 (defun markdown-get-undefined-refs ()
5959 "Return a list of undefined Markdown references.
5960 Result is an alist of pairs (reference . occurrences), where
5961 occurrences is itself another alist of pairs (label . line-number).
5962 For example, an alist corresponding to [Nice editor][Emacs] at line 12,
5963 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
5964 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
5965 (markdown-for-all-refs markdown-collect-undefined
))
5967 (defun markdown-get-unused-refs ()
5970 (markdown-get-defined-references) (markdown-get-all-refs)
5971 :test
(lambda (e1 e2
) (equal (car e1
) e2
)))
5974 (defmacro defun-markdown-buffer
(name docstring
)
5975 "Define a function to name and return a buffer.
5977 By convention, NAME must be a name of a string constant with
5978 %buffer% placeholder used to name the buffer, and will also be
5979 used as a name of the function defined.
5981 DOCSTRING will be used as the first part of the docstring."
5982 `(defun ,name
(&optional buffer-name
)
5983 ,(concat docstring
"\n\nBUFFER-NAME is the name of the main buffer being visited.")
5984 (or buffer-name
(setq buffer-name
(buffer-name)))
5985 (let ((refbuf (get-buffer-create (replace-regexp-in-string
5986 "%buffer%" buffer-name
5988 (with-current-buffer refbuf
5990 (View-exit-and-edit))
5991 (use-local-map button-buffer-map
)
5995 (defconst markdown-reference-check-buffer
5996 "*Undefined references for %buffer%*"
5997 "Pattern for name of buffer for listing undefined references.
5998 The string %buffer% will be replaced by the corresponding
5999 `markdown-mode' buffer name.")
6001 (defun-markdown-buffer
6002 markdown-reference-check-buffer
6003 "Name and return buffer for reference checking.")
6005 (defconst markdown-unused-references-buffer
6006 "*Unused references for %buffer%*"
6007 "Pattern for name of buffer for listing unused references.
6008 The string %buffer% will be replaced by the corresponding
6009 `markdown-mode' buffer name.")
6011 (defun-markdown-buffer
6012 markdown-unused-references-buffer
6013 "Name and return buffer for unused reference checking.")
6015 (defconst markdown-reference-links-buffer
6016 "*Reference links for %buffer%*"
6017 "Pattern for name of buffer for listing references.
6018 The string %buffer% will be replaced by the corresponding buffer name.")
6020 (defun-markdown-buffer
6021 markdown-reference-links-buffer
6022 "Name, setup, and return a buffer for listing links.")
6024 ;; Add an empty Markdown reference definition to buffer
6025 ;; specified in the 'target-buffer property. The reference name is
6026 ;; the button's label.
6027 (define-button-type 'markdown-undefined-reference-button
6028 'help-echo
"mouse-1, RET: create definition for undefined reference"
6032 (let ((buffer (button-get b
'target-buffer
))
6033 (line (button-get b
'target-line
))
6034 (label (button-label b
)))
6035 (switch-to-buffer-other-window buffer
)
6036 (goto-char (point-min))
6038 (markdown-insert-reference-definition label
)
6039 (markdown-check-refs t
))))
6041 ;; Jump to line in buffer specified by 'target-buffer property.
6042 ;; Line number is button's 'target-line property.
6043 (define-button-type 'markdown-goto-line-button
6044 'help-echo
"mouse-1, RET: go to line"
6048 (switch-to-buffer-other-window (button-get b
'target-buffer
))
6049 ;; use call-interactively to silence compiler
6050 (let ((current-prefix-arg (button-get b
'target-line
)))
6051 (call-interactively 'goto-line
))))
6053 ;; Kill a line in buffer specified by 'target-buffer property.
6054 ;; Line number is button's 'target-line property.
6055 (define-button-type 'markdown-kill-line-button
6056 'help-echo
"mouse-1, RET: kill line"
6060 (switch-to-buffer-other-window (button-get b
'target-buffer
))
6061 ;; use call-interactively to silence compiler
6062 (let ((current-prefix-arg (button-get b
'target-line
)))
6063 (call-interactively 'goto-line
))
6065 (markdown-unused-refs t
)))
6067 ;; Jumps to a particular link at location given by 'target-char
6068 ;; property in buffer given by 'target-buffer property.
6069 (define-button-type 'markdown-location-button
6070 'help-echo
"mouse-1, RET: jump to location of link"
6074 (let ((target (button-get b
'target-buffer
))
6075 (loc (button-get b
'target-char
)))
6076 (kill-buffer-and-window)
6077 (switch-to-buffer target
)
6080 (defun markdown-insert-undefined-reference-button (reference oldbuf
)
6081 "Insert a button for creating REFERENCE in buffer OLDBUF.
6082 REFERENCE should be a list of the form (reference . occurrences),
6083 as returned by `markdown-get-undefined-refs'."
6084 (let ((label (car reference
)))
6085 ;; Create a reference button
6086 (insert-button label
6087 :type
'markdown-undefined-reference-button
6088 'target-buffer oldbuf
6089 'target-line
(cdr (car (cdr reference
))))
6091 (dolist (occurrence (cdr reference
))
6092 (let ((line (cdr occurrence
)))
6093 ;; Create a line number button
6094 (insert-button (number-to-string line
)
6095 :type
'markdown-goto-line-button
6096 'target-buffer oldbuf
6103 (defun markdown-insert-unused-reference-button (reference oldbuf
)
6104 "Insert a button for creating REFERENCE in buffer OLDBUF.
6105 REFERENCE must be a pair of (ref . line-number)."
6106 (let ((label (car reference
))
6107 (line (cdr reference
)))
6108 ;; Create a reference button
6109 (insert-button label
6110 :type
'markdown-goto-line-button
6112 'target-buffer oldbuf
6114 (insert (format " (%d) [" line
))
6116 :type
'markdown-kill-line-button
6118 'target-buffer oldbuf
6123 (defun markdown-insert-link-button (link oldbuf
)
6124 "Insert a button for jumping to LINK in buffer OLDBUF.
6125 LINK should be a list of the form (text char line) containing
6126 the link text, location, and line number."
6127 (let ((label (cl-first link
))
6128 (char (cl-second link
))
6129 (line (cl-third link
)))
6130 ;; Create a reference button
6131 (insert-button label
6132 :type
'markdown-location-button
6133 'target-buffer oldbuf
6135 (insert (format " (line %d)\n" line
))))
6137 (defun markdown-reference-goto-link (&optional reference
)
6138 "Jump to the location of the first use of REFERENCE."
6141 (if (thing-at-point-looking-at markdown-regex-reference-definition
)
6142 (setq reference
(match-string-no-properties 2))
6143 (user-error "No reference definition at point")))
6144 (let ((links (markdown-reference-find-links reference
)))
6145 (cond ((= (length links
) 1)
6146 (goto-char (cadr (car links
))))
6147 ((> (length links
) 1)
6148 (let ((oldbuf (current-buffer))
6149 (linkbuf (markdown-reference-links-buffer)))
6150 (with-current-buffer linkbuf
6151 (insert "Links using reference " reference
":\n\n")
6152 (dolist (link (reverse links
))
6153 (markdown-insert-link-button link oldbuf
)))
6154 (view-buffer-other-window linkbuf
)
6155 (goto-char (point-min))
6158 (error "No links for reference %s" reference
)))))
6160 (defmacro defun-markdown-ref-checker
6161 (name docstring checker-function buffer-function none-message buffer-header insert-reference
)
6162 "Define a function NAME acting on result of CHECKER-FUNCTION.
6164 DOCSTRING is used as a docstring for the defined function.
6166 BUFFER-FUNCTION should name and return an auxiliary buffer to put
6169 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results.
6171 BUFFER-HEADER is put into the auxiliary buffer first, followed by
6172 calling INSERT-REFERENCE for each element in the list returned by
6174 `(defun ,name
(&optional silent
)
6177 "\n\nIf SILENT is non-nil, do not message anything when no
6178 such references found.")
6180 (unless (derived-mode-p 'markdown-mode
)
6181 (user-error "Not available in current mode"))
6182 (let ((oldbuf (current-buffer))
6183 (refs (,checker-function
))
6184 (refbuf (,buffer-function
)))
6188 (message ,none-message
))
6189 (kill-buffer refbuf
))
6190 (with-current-buffer refbuf
6191 (insert ,buffer-header
)
6193 (,insert-reference ref oldbuf
))
6194 (view-buffer-other-window refbuf
)
6195 (goto-char (point-min))
6196 (forward-line 2))))))
6198 (defun-markdown-ref-checker
6200 "Show all undefined Markdown references in current `markdown-mode' buffer.
6202 Links which have empty reference definitions are considered to be
6204 markdown-get-undefined-refs
6205 markdown-reference-check-buffer
6206 "No undefined references found"
6207 "The following references are undefined:\n\n"
6208 markdown-insert-undefined-reference-button
)
6211 (defun-markdown-ref-checker
6212 markdown-unused-refs
6213 "Show all unused Markdown references in current `markdown-mode' buffer."
6214 markdown-get-unused-refs
6215 markdown-unused-references-buffer
6216 "No unused references found"
6217 "The following references are unused:\n\n"
6218 markdown-insert-unused-reference-button
)
6222 ;;; Lists =====================================================================
6224 (defun markdown-insert-list-item (&optional arg
)
6225 "Insert a new list item.
6226 If the point is inside unordered list, insert a bullet mark. If
6227 the point is inside ordered list, insert the next number followed
6228 by a period. Use the previous list item to determine the amount
6229 of whitespace to place before and after list markers.
6231 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
6232 decrease the indentation by one level.
6234 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
6235 increase the indentation by one level."
6237 (let (bounds cur-indent marker indent new-indent new-loc
)
6239 ;; Look for a list item on current or previous non-blank line
6241 (while (and (not (setq bounds
(markdown-cur-list-item-bounds)))
6243 (markdown-cur-line-blank-p))
6246 (cond ((save-excursion
6247 (skip-chars-backward " \t")
6248 (looking-at-p markdown-regex-list
))
6252 ((not (markdown-cur-line-blank-p))
6254 (setq new-loc
(point)))
6255 ;; Look ahead for a list item on next non-blank line
6258 (while (and (null bounds
)
6260 (markdown-cur-line-blank-p))
6262 (setq bounds
(markdown-cur-list-item-bounds))))
6264 (setq new-loc
(point))
6265 (unless (markdown-cur-line-blank-p)
6268 ;; When not in a list, start a new unordered one
6270 (unless (markdown-cur-line-blank-p)
6272 (insert markdown-unordered-list-item-prefix
))
6273 ;; Compute indentation and marker for new list item
6274 (setq cur-indent
(nth 2 bounds
))
6275 (setq marker
(nth 4 bounds
))
6276 ;; If current item is a GFM checkbox, insert new unchecked checkbox.
6277 (when (nth 5 bounds
)
6280 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds
)))))
6282 ;; Dedent: decrement indentation, find previous marker.
6284 (setq indent
(max (- cur-indent markdown-list-indent-width
) 0))
6287 (goto-char (nth 0 bounds
))
6288 (when (markdown-up-list)
6289 (markdown-cur-list-item-bounds)))))
6291 (setq marker
(nth 4 prev-bounds
)))))
6292 ;; Indent: increment indentation by 4, use same marker.
6293 ((= arg
16) (setq indent
(+ cur-indent markdown-list-indent-width
)))
6294 ;; Same level: keep current indentation and marker.
6295 (t (setq indent cur-indent
)))
6296 (setq new-indent
(make-string indent
32))
6300 ((string-match-p "[0-9]" marker
)
6301 (if (= arg
16) ;; starting a new column indented one more level
6302 (insert (concat new-indent
"1. "))
6303 ;; Don't use previous match-data
6304 (set-match-data nil
)
6305 ;; travel up to the last item and pick the correct number. If
6306 ;; the argument was nil, "new-indent = cur-indent" is the same,
6307 ;; so we don't need special treatment. Neat.
6309 (while (and (not (looking-at (concat new-indent
"\\([0-9]+\\)\\(\\.[ \t]*\\)")))
6310 (>= (forward-line -
1) 0))))
6311 (let* ((old-prefix (match-string 1))
6312 (old-spacing (match-string 2))
6313 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration
)
6314 (int-to-string (1+ (string-to-number old-prefix
)))
6316 (space-adjust (- (length old-prefix
) (length new-prefix
)))
6317 (new-spacing (if (and (match-string 2)
6318 (not (string-match-p "\t" old-spacing
))
6320 (> space-adjust
(- 1 (length (match-string 2)))))
6321 (substring (match-string 2) 0 space-adjust
)
6322 (or old-spacing
". "))))
6323 (insert (concat new-indent new-prefix new-spacing
)))))
6324 ;; Unordered list, GFM task list, or ordered list with hash mark
6325 ((string-match-p "[\\*\\+-]\\|#\\." marker
)
6326 (insert new-indent marker
))))
6327 ;; Propertize the newly inserted list item now
6328 (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position)))))
6330 (defun markdown-move-list-item-up ()
6331 "Move the current list item up in the list when possible.
6332 In nested lists, move child items with the parent item."
6335 (when (setq cur
(markdown-cur-list-item-bounds))
6337 (goto-char (nth 0 cur
))
6338 (if (markdown-prev-list-item (nth 3 cur
))
6340 (setq prev
(markdown-cur-list-item-bounds))
6343 (transpose-regions (nth 0 prev
) (nth 1 prev
)
6344 (nth 0 cur
) (nth 1 cur
) t
)
6345 (goto-char (+ (nth 0 prev
) (- old
(nth 0 cur
)))))
6346 ;; Catch error in case regions overlap.
6347 (error (goto-char old
))))
6350 (defun markdown-move-list-item-down ()
6351 "Move the current list item down in the list when possible.
6352 In nested lists, move child items with the parent item."
6355 (when (setq cur
(markdown-cur-list-item-bounds))
6357 (if (markdown-next-list-item (nth 3 cur
))
6359 (setq next
(markdown-cur-list-item-bounds))
6362 (transpose-regions (nth 0 cur
) (nth 1 cur
)
6363 (nth 0 next
) (nth 1 next
) nil
)
6364 (goto-char (+ old
(- (nth 1 next
) (nth 1 cur
)))))
6365 ;; Catch error in case regions overlap.
6366 (error (goto-char old
))))
6369 (defun markdown-demote-list-item (&optional bounds
)
6370 "Indent (or demote) the current list item.
6371 Optionally, BOUNDS of the current list item may be provided if available.
6372 In nested lists, demote child items as well."
6374 (when (or bounds
(setq bounds
(markdown-cur-list-item-bounds)))
6376 (let* ((item-start (set-marker (make-marker) (nth 0 bounds
)))
6377 (item-end (set-marker (make-marker) (nth 1 bounds
)))
6378 (list-start (progn (markdown-beginning-of-list)
6379 (set-marker (make-marker) (point))))
6380 (list-end (progn (markdown-end-of-list)
6381 (set-marker (make-marker) (point)))))
6382 (goto-char item-start
)
6383 (while (< (point) item-end
)
6384 (unless (markdown-cur-line-blank-p)
6385 (insert (make-string markdown-list-indent-width ?
)))
6387 (markdown-syntax-propertize-list-items list-start list-end
)))))
6389 (defun markdown-promote-list-item (&optional bounds
)
6390 "Unindent (or promote) the current list item.
6391 Optionally, BOUNDS of the current list item may be provided if available.
6392 In nested lists, demote child items as well."
6394 (when (or bounds
(setq bounds
(markdown-cur-list-item-bounds)))
6397 (let ((item-start (set-marker (make-marker) (nth 0 bounds
)))
6398 (item-end (set-marker (make-marker) (nth 1 bounds
)))
6399 (list-start (progn (markdown-beginning-of-list)
6400 (set-marker (make-marker) (point))))
6401 (list-end (progn (markdown-end-of-list)
6402 (set-marker (make-marker) (point))))
6404 (goto-char item-start
)
6405 (when (looking-at (format "^[ ]\\{1,%d\\}"
6406 markdown-list-indent-width
))
6407 (setq num
(- (match-end 0) (match-beginning 0)))
6408 (setq regexp
(format "^[ ]\\{1,%d\\}" num
))
6409 (while (and (< (point) item-end
)
6410 (re-search-forward regexp item-end t
))
6411 (replace-match "" nil nil
)
6413 (markdown-syntax-propertize-list-items list-start list-end
)))))))
6415 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item
)
6416 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM.
6417 PREV-ITEM is width of previous-indentation and list number
6419 Assume that the previously found match was for a numbered item in
6427 (while (and continue
(not (eobp)))
6430 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ")
6431 (setq cpfx
(match-string-no-properties 2))
6432 (setq cur-item
(match-string-no-properties 1)) ;; indentation and list marker
6434 ((or (= (length cpfx
) (length pfx
))
6435 (= (length cur-item
) (length prev-item
)))
6438 (if (not markdown-ordered-list-enumeration
)
6441 (concat pfx
(number-to-string idx
) ". "))))
6444 ((< (length pfx
) (length cpfx
))
6445 (setq sep
(markdown-cleanup-list-numbers-level cpfx cur-item
))
6450 (setq continue nil
))))
6452 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
6453 (setq cpfx
(match-string-no-properties 1))
6455 ;; reset if separated before
6456 ((string= cpfx pfx
) (when sep
(setq idx
0)))
6459 (setq continue nil
))))
6464 (setq continue
(= (forward-line) 0))))
6467 (defun markdown-cleanup-list-numbers ()
6468 "Update the numbering of ordered lists."
6471 (goto-char (point-min))
6472 (markdown-cleanup-list-numbers-level "")))
6475 ;;; Movement ==================================================================
6477 (defun markdown-beginning-of-defun (&optional arg
)
6478 "`beginning-of-defun-function' for Markdown.
6479 This is used to find the beginning of the defun and should behave
6480 like ‘beginning-of-defun’, returning non-nil if it found the
6481 beginning of a defun. It moves the point backward, right before a
6482 heading which defines a defun. When ARG is non-nil, repeat that
6483 many times. When ARG is negative, move forward to the ARG-th
6485 (or arg
(setq arg
1))
6486 (when (< arg
0) (end-of-line))
6487 ;; Adjust position for setext headings.
6488 (when (and (thing-at-point-looking-at markdown-regex-header-setext
)
6489 (not (= (point) (match-beginning 0)))
6490 (not (markdown-code-block-at-point-p)))
6491 (goto-char (match-end 0)))
6493 ;; Move backward with positive argument.
6494 (while (and (not (bobp)) (> arg
0))
6496 (while (and (not found
)
6498 (re-search-backward markdown-regex-header nil
'move
))
6499 (markdown-code-block-at-pos (match-beginning 0))
6500 (setq found
(match-beginning 0)))
6501 (setq arg
(1- arg
)))
6502 ;; Move forward with negative argument.
6503 (while (and (not (eobp)) (< arg
0))
6505 (while (and (not found
)
6507 (re-search-forward markdown-regex-header nil
'move
))
6508 (markdown-code-block-at-pos (match-beginning 0))
6509 (setq found
(match-beginning 0)))
6510 (setq arg
(1+ arg
)))
6515 (defun markdown-end-of-defun ()
6516 "`end-of-defun-function’ for Markdown.
6517 This is used to find the end of the defun at point.
6518 It is called with no argument, right after calling ‘beginning-of-defun-raw’,
6519 so it can assume that point is at the beginning of the defun body.
6520 It should move point to the first position after the defun."
6521 (or (eobp) (forward-char 1))
6523 (while (and (not found
)
6525 (re-search-forward markdown-regex-header nil
'move
))
6526 (when (not (markdown-code-block-at-pos (match-beginning 0)))
6527 (setq found
(match-beginning 0))))
6530 (skip-syntax-backward "-"))))
6532 (defun markdown-beginning-of-text-block ()
6533 "Move backward to previous beginning of a plain text block.
6534 This function simply looks for blank lines without considering
6535 the surrounding context in light of Markdown syntax. For that, see
6536 `markdown-backward-block'."
6538 (let ((start (point)))
6539 (if (re-search-backward markdown-regex-block-separator nil t
)
6540 (goto-char (match-end 0))
6541 (goto-char (point-min)))
6542 (when (and (= start
(point)) (not (bobp)))
6544 (if (re-search-backward markdown-regex-block-separator nil t
)
6545 (goto-char (match-end 0))
6546 (goto-char (point-min))))))
6548 (defun markdown-end-of-text-block ()
6549 "Move forward to next beginning of a plain text block.
6550 This function simply looks for blank lines without considering
6551 the surrounding context in light of Markdown syntax. For that, see
6552 `markdown-forward-block'."
6555 (skip-chars-forward " \t\n")
6556 (when (= (point) (point-min))
6558 (if (re-search-forward markdown-regex-block-separator nil t
)
6559 (goto-char (match-end 0))
6560 (goto-char (point-max)))
6561 (skip-chars-backward " \t\n")
6564 (defun markdown-backward-paragraph (&optional arg
)
6565 "Move the point to the start of the current paragraph.
6566 With argument ARG, do it ARG times; a negative argument ARG = -N
6567 means move forward N blocks."
6569 (or arg
(setq arg
1))
6571 (markdown-forward-paragraph (- arg
))
6573 ;; Skip over whitespace in between paragraphs when moving backward.
6574 (skip-chars-backward " \t\n")
6576 ;; Skip over code block endings.
6577 (when (markdown-range-properties-exist
6578 (line-beginning-position) (line-end-position)
6579 '(markdown-gfm-block-end
6580 markdown-tilde-fence-end
))
6582 ;; Skip over blank lines inside blockquotes.
6583 (while (and (not (eobp))
6584 (looking-at markdown-regex-blockquote
)
6585 (= (length (match-string 3)) 0))
6587 ;; Proceed forward based on the type of block of paragraph.
6591 ((looking-at markdown-regex-blockquote
)
6592 (while (and (not (bobp))
6593 (looking-at markdown-regex-blockquote
)
6594 (> (length (match-string 3)) 0)) ;; not blank
6598 ((setq bounds
(markdown-cur-list-item-bounds))
6599 (goto-char (nth 0 bounds
)))
6602 (while (and (not (bobp))
6604 (not (markdown-cur-line-blank-p))
6605 (not (looking-at markdown-regex-blockquote
))
6606 (not (markdown-range-properties-exist
6607 (line-beginning-position) (line-end-position)
6608 '(markdown-gfm-block-end
6609 markdown-tilde-fence-end
))))
6610 (setq skip
(markdown-range-properties-exist
6611 (line-beginning-position) (line-end-position)
6612 '(markdown-gfm-block-begin
6613 markdown-tilde-fence-begin
)))
6616 (forward-line 1))))))))
6618 (defun markdown-forward-paragraph (&optional arg
)
6619 "Move forward to the next end of a paragraph.
6620 With argument ARG, do it ARG times; a negative argument ARG = -N
6621 means move backward N blocks."
6623 (or arg
(setq arg
1))
6625 (markdown-backward-paragraph (- arg
))
6627 ;; Skip whitespace in between paragraphs.
6628 (when (markdown-cur-line-blank-p)
6629 (skip-syntax-forward "-")
6630 (beginning-of-line))
6631 ;; Proceed forward based on the type of block.
6635 ((looking-at markdown-regex-blockquote
)
6636 ;; Skip over blank lines inside blockquotes.
6637 (while (and (not (eobp))
6638 (looking-at markdown-regex-blockquote
)
6639 (= (length (match-string 3)) 0))
6641 ;; Move to end of quoted text block
6642 (while (and (not (eobp))
6643 (looking-at markdown-regex-blockquote
)
6644 (> (length (match-string 3)) 0)) ;; not blank
6647 ((and (markdown-cur-list-item-bounds)
6648 (setq bounds
(markdown-next-list-item-bounds)))
6649 (goto-char (nth 0 bounds
)))
6653 (while (and (not (eobp))
6655 (not (markdown-cur-line-blank-p))
6656 (not (looking-at markdown-regex-blockquote
))
6657 (not (markdown-range-properties-exist
6658 (line-beginning-position) (line-end-position)
6659 '(markdown-gfm-block-begin
6660 markdown-tilde-fence-begin
))))
6661 (setq skip
(markdown-range-properties-exist
6662 (line-beginning-position) (line-end-position)
6663 '(markdown-gfm-block-end
6664 markdown-tilde-fence-end
)))
6665 (forward-line))))))))
6667 (defun markdown-backward-block (&optional arg
)
6668 "Move the point to the start of the current Markdown block.
6669 Moves across complete code blocks, list items, and blockquotes,
6670 but otherwise stops at blank lines, headers, and horizontal
6671 rules. With argument ARG, do it ARG times; a negative argument
6672 ARG = -N means move forward N blocks."
6674 (or arg
(setq arg
1))
6676 (markdown-forward-block (- arg
))
6678 ;; Skip over whitespace in between blocks when moving backward,
6679 ;; unless at a block boundary with no whitespace.
6680 (skip-syntax-backward "-")
6682 ;; Proceed forward based on the type of block.
6685 ((and (markdown-code-block-at-pos (point)) ;; this line
6686 (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line
6688 (while (and (markdown-code-block-at-point-p) (not (bobp)))
6692 ((markdown-heading-at-point)
6693 (goto-char (match-beginning 0)))
6695 ((looking-at markdown-regex-hr
))
6697 ((looking-at markdown-regex-blockquote
)
6699 (while (and (looking-at markdown-regex-blockquote
)
6704 ((markdown-cur-list-item-bounds)
6705 (markdown-beginning-of-list))
6708 ;; Move forward in case it is a one line regular paragraph.
6709 (unless (markdown-next-line-blank-p)
6711 (unless (markdown-prev-line-blank-p)
6712 (markdown-backward-paragraph)))))))
6714 (defun markdown-forward-block (&optional arg
)
6715 "Move forward to the next end of a Markdown block.
6716 Moves across complete code blocks, list items, and blockquotes,
6717 but otherwise stops at blank lines, headers, and horizontal
6718 rules. With argument ARG, do it ARG times; a negative argument
6719 ARG = -N means move backward N blocks."
6721 (or arg
(setq arg
1))
6723 (markdown-backward-block (- arg
))
6725 ;; Skip over whitespace in between blocks when moving forward.
6726 (if (markdown-cur-line-blank-p)
6727 (skip-syntax-forward "-")
6728 (beginning-of-line))
6729 ;; Proceed forward based on the type of block.
6732 ((markdown-code-block-at-point-p)
6734 (while (and (markdown-code-block-at-point-p) (not (eobp)))
6737 ((looking-at markdown-regex-header
)
6738 (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
6741 ((looking-at markdown-regex-hr
)
6744 ((looking-at markdown-regex-blockquote
)
6746 (while (and (looking-at markdown-regex-blockquote
) (not (eobp)))
6749 ((markdown-cur-list-item-bounds)
6750 (markdown-end-of-list)
6753 (t (markdown-forward-paragraph))))
6754 (skip-syntax-backward "-")
6758 (defun markdown-backward-page (&optional count
)
6759 "Move backward to boundary of the current toplevel section.
6760 With COUNT, repeat, or go forward if negative."
6762 (or count
(setq count
1))
6764 (markdown-forward-page (- count
))
6765 (skip-syntax-backward "-")
6766 (or (markdown-back-to-heading-over-code-block t t
)
6767 (goto-char (point-min)))
6768 (when (looking-at markdown-regex-header
)
6769 (let ((level (markdown-outline-level)))
6770 (when (> level
1) (markdown-up-heading level
))
6773 (markdown-backward-same-level (1- count
))
6774 (error (goto-char (point-min)))))))))
6776 (defun markdown-forward-page (&optional count
)
6777 "Move forward to boundary of the current toplevel section.
6778 With COUNT, repeat, or go backward if negative."
6780 (or count
(setq count
1))
6782 (markdown-backward-page (- count
))
6783 (if (markdown-back-to-heading-over-code-block t t
)
6784 (let ((level (markdown-outline-level)))
6785 (when (> level
1) (markdown-up-heading level
))
6787 (markdown-forward-same-level count
)
6788 (error (goto-char (point-max)))))
6789 (markdown-next-visible-heading 1))))
6791 (defun markdown-next-link ()
6792 "Jump to next inline, reference, or wiki link.
6793 If successful, return point. Otherwise, return nil.
6794 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
6796 (let ((opoint (point)))
6797 (when (or (markdown-link-p) (markdown-wiki-link-p))
6798 ;; At a link already, move past it.
6799 (goto-char (+ (match-end 0) 1)))
6800 ;; Search for the next wiki link and move to the beginning.
6801 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t
)
6802 (markdown-code-block-at-point-p)
6803 (< (point) (point-max))))
6804 (if (and (not (eq (point) opoint
))
6805 (or (markdown-link-p) (markdown-wiki-link-p)))
6806 ;; Group 1 will move past non-escape character in wiki link regexp.
6807 ;; Go to beginning of group zero for all other link types.
6808 (goto-char (or (match-beginning 1) (match-beginning 0)))
6812 (defun markdown-previous-link ()
6813 "Jump to previous wiki link.
6814 If successful, return point. Otherwise, return nil.
6815 See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
6817 (let ((opoint (point)))
6818 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t
)
6819 (markdown-code-block-at-point-p)
6820 (> (point) (point-min))))
6821 (if (and (not (eq (point) opoint
))
6822 (or (markdown-link-p) (markdown-wiki-link-p)))
6823 (goto-char (or (match-beginning 1) (match-beginning 0)))
6828 ;;; Outline ===================================================================
6830 (defun markdown-move-heading-common (move-fn &optional arg adjust
)
6831 "Wrapper for `outline-mode' functions to skip false positives.
6832 MOVE-FN is a function and ARG is its argument. For example,
6833 headings inside preformatted code blocks may match
6834 `outline-regexp' but should not be considered as headings.
6835 When ADJUST is non-nil, adjust the point for interactive calls
6836 to avoid leaving the point at invisible markup. This adjustment
6837 generally should only be done for interactive calls, since other
6838 functions may expect the point to be at the beginning of the
6839 regular expression."
6840 (let ((prev -
1) (start (point)))
6841 (if arg
(funcall move-fn arg
) (funcall move-fn
))
6842 (while (and (/= prev
(point)) (markdown-code-block-at-point-p))
6844 (if arg
(funcall move-fn arg
) (funcall move-fn
)))
6845 ;; Adjust point for setext headings and invisible text.
6847 (when (and adjust
(thing-at-point-looking-at markdown-regex-header
))
6848 (if markdown-hide-markup
6849 ;; Move to beginning of heading text if markup is hidden.
6850 (goto-char (or (match-beginning 1) (match-beginning 5)))
6851 ;; Move to beginning of markup otherwise.
6852 (goto-char (or (match-beginning 1) (match-beginning 4))))))
6853 (if (= (point) start
) nil
(point))))
6855 (defun markdown-next-visible-heading (arg)
6856 "Move to the next visible heading line of any level.
6857 With argument, repeats or can move backward if negative. ARG is
6858 passed to `outline-next-visible-heading'."
6860 (markdown-move-heading-common #'outline-next-visible-heading arg
'adjust
))
6862 (defun markdown-previous-visible-heading (arg)
6863 "Move to the previous visible heading line of any level.
6864 With argument, repeats or can move backward if negative. ARG is
6865 passed to `outline-previous-visible-heading'."
6867 (markdown-move-heading-common #'outline-previous-visible-heading arg
'adjust
))
6869 (defun markdown-next-heading ()
6870 "Move to the next heading line of any level."
6871 (markdown-move-heading-common #'outline-next-heading
))
6873 (defun markdown-previous-heading ()
6874 "Move to the previous heading line of any level."
6875 (markdown-move-heading-common #'outline-previous-heading
))
6877 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error
)
6878 "Move back to the beginning of the previous heading.
6879 Returns t if the point is at a heading, the location if a heading
6880 was found, and nil otherwise.
6881 Only visible heading lines are considered, unless INVISIBLE-OK is
6882 non-nil. Throw an error if there is no previous heading unless
6883 NO-ERROR is non-nil.
6884 Leaves match data intact for `markdown-regex-header'."
6886 (or (and (markdown-heading-at-point)
6887 (not (markdown-code-block-at-point-p)))
6890 (while (and (not found
)
6891 (re-search-backward markdown-regex-header nil t
))
6892 (when (and (or invisible-ok
(not (outline-invisible-p)))
6893 (not (markdown-code-block-at-point-p)))
6894 (setq found
(point))))
6896 (unless no-error
(user-error "Before first heading"))
6897 (setq found
(point))))
6898 (when found
(goto-char found
)))))
6900 (defun markdown-forward-same-level (arg)
6901 "Move forward to the ARG'th heading at same level as this one.
6902 Stop at the first and last headings of a superior heading."
6904 (markdown-back-to-heading-over-code-block)
6905 (markdown-move-heading-common #'outline-forward-same-level arg
'adjust
))
6907 (defun markdown-backward-same-level (arg)
6908 "Move backward to the ARG'th heading at same level as this one.
6909 Stop at the first and last headings of a superior heading."
6911 (markdown-back-to-heading-over-code-block)
6913 (let ((point-to-move-to
6915 (markdown-move-heading-common #'outline-get-last-sibling nil
'adjust
))))
6916 (if point-to-move-to
6918 (goto-char point-to-move-to
)
6919 (setq arg
(1- arg
)))
6920 (user-error "No previous same-level heading")))))
6922 (defun markdown-up-heading (arg &optional interactive
)
6923 "Move to the visible heading line of which the present line is a subheading.
6924 With argument, move up ARG levels. When called interactively (or
6925 INTERACTIVE is non-nil), also push the mark."
6926 (interactive "p\np")
6927 (and interactive
(not (eq last-command
'markdown-up-heading
))
6929 (markdown-move-heading-common #'outline-up-heading arg
'adjust
))
6931 (defun markdown-back-to-heading (&optional invisible-ok
)
6932 "Move to previous heading line, or beg of this line if it's a heading.
6933 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
6935 (markdown-move-heading-common #'outline-back-to-heading invisible-ok
))
6937 (defalias 'markdown-end-of-heading
'outline-end-of-heading
)
6939 (defun markdown-on-heading-p ()
6940 "Return non-nil if point is on a heading line."
6941 (get-text-property (line-beginning-position) 'markdown-heading
))
6943 (defun markdown-end-of-subtree (&optional invisible-OK
)
6944 "Move to the end of the current subtree.
6945 Only visible heading lines are considered, unless INVISIBLE-OK is
6947 Derived from `org-end-of-subtree'."
6948 (markdown-back-to-heading invisible-OK
)
6950 (level (markdown-outline-level)))
6951 (while (and (not (eobp))
6952 (or first
(> (markdown-outline-level) level
)))
6954 (markdown-next-heading))
6955 (if (memq (preceding-char) '(?
\n ?\^M
))
6957 ;; Go to end of line before heading
6959 (if (memq (preceding-char) '(?
\n ?\^M
))
6960 ;; leave blank line before heading
6961 (forward-char -
1)))))
6964 (defun markdown-outline-fix-visibility ()
6965 "Hide any false positive headings that should not be shown.
6966 For example, headings inside preformatted code blocks may match
6967 `outline-regexp' but should not be shown as headings when cycling.
6968 Also, the ending --- line in metadata blocks appears to be a
6969 setext header, but should not be folded."
6971 (goto-char (point-min))
6972 ;; Unhide any false positives in metadata blocks
6973 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin
)
6974 (let ((body (progn (forward-line)
6975 (markdown-text-property-at-point
6976 'markdown-yaml-metadata-section
))))
6978 (let ((end (progn (goto-char (cl-second body
))
6979 (markdown-text-property-at-point
6980 'markdown-yaml-metadata-end
))))
6981 (outline-flag-region (point-min) (1+ (cl-second end
)) nil
)))))
6982 ;; Hide any false positives in code blocks
6983 (unless (outline-on-heading-p)
6984 (outline-next-visible-heading 1))
6985 (while (< (point) (point-max))
6986 (when (markdown-code-block-at-point-p)
6987 (outline-flag-region (1- (line-beginning-position)) (line-end-position) t
))
6988 (outline-next-visible-heading 1))))
6990 (defvar markdown-cycle-global-status
1)
6991 (defvar markdown-cycle-subtree-status nil
)
6993 (defun markdown-next-preface ()
6995 (while (and (not finish
) (re-search-forward (concat "\n\\(?:" outline-regexp
"\\)")
6997 (unless (markdown-code-block-at-point-p)
6998 (goto-char (match-beginning 0))
7000 (when (and (bolp) (or outline-blank-line
(eobp)) (not (bobp)))
7003 (defun markdown-show-entry ()
7005 (outline-back-to-heading t
)
7006 (outline-flag-region (1- (point))
7008 (markdown-next-preface)
7009 (if (= 1 (- (point-max) (point)))
7014 ;; This function was originally derived from `org-cycle' from org.el.
7015 (defun markdown-cycle (&optional arg
)
7016 "Visibility cycling for Markdown mode.
7017 This function is called with a `\\[universal-argument]' or if ARG is t, perform
7018 global visibility cycling. If the point is at an atx-style header, cycle
7019 visibility of the corresponding subtree. Otherwise, indent the current line
7020 or insert a tab, as appropriate, by calling `indent-for-tab-command'."
7027 ;; Move from overview to contents
7028 ((and (eq last-command this-command
)
7029 (eq markdown-cycle-global-status
2))
7030 (outline-hide-sublevels 1)
7031 (message "CONTENTS")
7032 (setq markdown-cycle-global-status
3)
7033 (markdown-outline-fix-visibility))
7034 ;; Move from contents to all
7035 ((and (eq last-command this-command
)
7036 (eq markdown-cycle-global-status
3))
7038 (message "SHOW ALL")
7039 (setq markdown-cycle-global-status
1))
7040 ;; Defaults to overview
7043 (message "OVERVIEW")
7044 (setq markdown-cycle-global-status
2)
7045 (markdown-outline-fix-visibility))))
7047 ;; At a heading: rotate between three different views
7048 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
7049 (markdown-back-to-heading)
7050 (let ((goal-column 0) eoh eol eos
)
7051 ;; Determine boundaries
7053 (markdown-back-to-heading)
7055 (beginning-of-line 2)
7056 (while (and (not (eobp)) ;; this is like `next-line'
7057 (get-char-property (1- (point)) 'invisible
))
7058 (beginning-of-line 2)) (setq eol
(point)))
7059 (markdown-end-of-heading) (setq eoh
(point))
7060 (markdown-end-of-subtree t
)
7061 (skip-chars-forward " \t\n")
7062 (beginning-of-line 1) ; in case this is an item
7063 (setq eos
(1- (point))))
7064 ;; Find out what to do next and set `this-command'
7066 ;; Nothing is hidden behind this heading
7068 (message "EMPTY ENTRY")
7069 (setq markdown-cycle-subtree-status nil
))
7070 ;; Entire subtree is hidden in one line: open it
7072 (markdown-show-entry)
7073 (outline-show-children)
7074 (message "CHILDREN")
7075 (setq markdown-cycle-subtree-status
'children
))
7076 ;; We just showed the children, now show everything.
7077 ((and (eq last-command this-command
)
7078 (eq markdown-cycle-subtree-status
'children
))
7079 (outline-show-subtree)
7081 (setq markdown-cycle-subtree-status
'subtree
))
7082 ;; Default action: hide the subtree.
7084 (outline-hide-subtree)
7086 (setq markdown-cycle-subtree-status
'folded
)))))
7088 ;; In a table, move forward by one cell
7089 ((markdown-table-at-point-p)
7090 (call-interactively #'markdown-table-forward-cell
))
7092 ;; Otherwise, indent as appropriate
7094 (indent-for-tab-command))))
7096 (defun markdown-shifttab ()
7097 "Handle S-TAB keybinding based on context.
7098 When in a table, move backward one cell.
7099 Otherwise, cycle global heading visibility by calling
7100 `markdown-cycle' with argument t."
7102 (cond ((markdown-table-at-point-p)
7103 (call-interactively #'markdown-table-backward-cell
))
7104 (t (markdown-cycle t
))))
7106 (defun markdown-outline-level ()
7107 "Return the depth to which a statement is nested in the outline."
7109 ((and (match-beginning 0)
7110 (markdown-code-block-at-pos (match-beginning 0)))
7111 7) ;; Only 6 header levels are defined.
7115 (length (markdown-trim-whitespace (match-string-no-properties 4))))))
7117 (defun markdown-promote-subtree (&optional arg
)
7118 "Promote the current subtree of ATX headings.
7119 Note that Markdown does not support heading levels higher than
7120 six and therefore level-six headings will not be promoted
7121 further. If ARG is non-nil promote the heading, otherwise
7125 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx
)
7126 (re-search-backward markdown-regex-header-atx nil t
))
7127 (not (markdown-code-block-at-point-p)))
7128 (let ((level (length (match-string 1)))
7129 (promote-or-demote (if arg
1 -
1))
7131 (markdown-cycle-atx promote-or-demote remove
)
7132 (catch 'end-of-subtree
7133 (while (and (markdown-next-heading)
7134 (looking-at markdown-regex-header-atx
))
7135 ;; Exit if this not a higher level heading; promote otherwise.
7136 (if (and (looking-at markdown-regex-header-atx
)
7137 (<= (length (match-string-no-properties 1)) level
))
7138 (throw 'end-of-subtree nil
)
7139 (markdown-cycle-atx promote-or-demote remove
))))))))
7141 (defun markdown-demote-subtree ()
7142 "Demote the current subtree of ATX headings."
7144 (markdown-promote-subtree t
))
7146 (defun markdown-move-subtree-up ()
7147 "Move the current subtree of ATX headings up."
7149 (outline-move-subtree-up 1))
7151 (defun markdown-move-subtree-down ()
7152 "Move the current subtree of ATX headings down."
7154 (outline-move-subtree-down 1))
7156 (defun markdown-outline-next ()
7157 "Move to next list item, when in a list, or next visible heading."
7159 (let ((bounds (markdown-next-list-item-bounds)))
7161 (goto-char (nth 0 bounds
))
7162 (markdown-next-visible-heading 1))))
7164 (defun markdown-outline-previous ()
7165 "Move to previous list item, when in a list, or previous visible heading."
7167 (let ((bounds (markdown-prev-list-item-bounds)))
7169 (goto-char (nth 0 bounds
))
7170 (markdown-previous-visible-heading 1))))
7172 (defun markdown-outline-next-same-level ()
7173 "Move to next list item or heading of same level."
7175 (let ((bounds (markdown-cur-list-item-bounds)))
7177 (markdown-next-list-item (nth 3 bounds
))
7178 (markdown-forward-same-level 1))))
7180 (defun markdown-outline-previous-same-level ()
7181 "Move to previous list item or heading of same level."
7183 (let ((bounds (markdown-cur-list-item-bounds)))
7185 (markdown-prev-list-item (nth 3 bounds
))
7186 (markdown-backward-same-level 1))))
7188 (defun markdown-outline-up ()
7189 "Move to previous list item, when in a list, or previous heading."
7191 (unless (markdown-up-list)
7192 (markdown-up-heading 1)))
7195 ;;; Marking and Narrowing =====================================================
7197 (defun markdown-mark-paragraph ()
7198 "Put mark at end of this block, point at beginning.
7199 The block marked is the one that contains point or follows point.
7201 Interactively, if this command is repeated or (in Transient Mark
7202 mode) if the mark is active, it marks the next block after the
7203 ones already marked."
7205 (if (or (and (eq last-command this-command
) (mark t
))
7206 (and transient-mark-mode mark-active
))
7210 (markdown-forward-paragraph)
7212 (let ((beginning-of-defun-function #'markdown-backward-paragraph
)
7213 (end-of-defun-function #'markdown-forward-paragraph
))
7216 (defun markdown-mark-block ()
7217 "Put mark at end of this block, point at beginning.
7218 The block marked is the one that contains point or follows point.
7220 Interactively, if this command is repeated or (in Transient Mark
7221 mode) if the mark is active, it marks the next block after the
7222 ones already marked."
7224 (if (or (and (eq last-command this-command
) (mark t
))
7225 (and transient-mark-mode mark-active
))
7229 (markdown-forward-block)
7231 (let ((beginning-of-defun-function #'markdown-backward-block
)
7232 (end-of-defun-function #'markdown-forward-block
))
7235 (defun markdown-narrow-to-block ()
7236 "Make text outside current block invisible.
7237 The current block is the one that contains point or follows point."
7239 (let ((beginning-of-defun-function #'markdown-backward-block
)
7240 (end-of-defun-function #'markdown-forward-block
))
7243 (defun markdown-mark-text-block ()
7244 "Put mark at end of this plain text block, point at beginning.
7245 The block marked is the one that contains point or follows point.
7247 Interactively, if this command is repeated or (in Transient Mark
7248 mode) if the mark is active, it marks the next block after the
7249 ones already marked."
7251 (if (or (and (eq last-command this-command
) (mark t
))
7252 (and transient-mark-mode mark-active
))
7256 (markdown-end-of-text-block)
7258 (let ((beginning-of-defun-function #'markdown-beginning-of-text-block
)
7259 (end-of-defun-function #'markdown-end-of-text-block
))
7262 (defun markdown-mark-page ()
7263 "Put mark at end of this top level section, point at beginning.
7264 The top level section marked is the one that contains point or
7267 Interactively, if this command is repeated or (in Transient Mark
7268 mode) if the mark is active, it marks the next page after the
7269 ones already marked."
7271 (if (or (and (eq last-command this-command
) (mark t
))
7272 (and transient-mark-mode mark-active
))
7276 (markdown-forward-page)
7278 (let ((beginning-of-defun-function #'markdown-backward-page
)
7279 (end-of-defun-function #'markdown-forward-page
))
7282 (defun markdown-narrow-to-page ()
7283 "Make text outside current top level section invisible.
7284 The current section is the one that contains point or follows point."
7286 (let ((beginning-of-defun-function #'markdown-backward-page
)
7287 (end-of-defun-function #'markdown-forward-page
))
7290 (defun markdown-mark-subtree ()
7291 "Mark the current subtree.
7292 This puts point at the start of the current subtree, and mark at the end."
7295 (if (markdown-heading-at-point)
7297 (markdown-previous-visible-heading 1))
7299 (markdown-end-of-subtree)
7300 (push-mark (point) nil t
)
7303 (defun markdown-narrow-to-subtree ()
7304 "Narrow buffer to the current subtree."
7309 (progn (markdown-back-to-heading-over-code-block t
) (point))
7310 (progn (markdown-end-of-subtree)
7311 (if (and (markdown-heading-at-point) (not (eobp)))
7316 ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
7318 (defun markdown-move-up ()
7319 "Move thing at point up.
7320 When in a list item, call `markdown-move-list-item-up'.
7321 When in a table, call `markdown-table-move-row-up'.
7322 Otherwise, move the current heading subtree up with
7323 `markdown-move-subtree-up'."
7326 ((markdown-list-item-at-point-p)
7327 (call-interactively #'markdown-move-list-item-up
))
7328 ((markdown-table-at-point-p)
7329 (call-interactively #'markdown-table-move-row-up
))
7331 (call-interactively #'markdown-move-subtree-up
))))
7333 (defun markdown-move-down ()
7334 "Move thing at point down.
7335 When in a list item, call `markdown-move-list-item-down'.
7336 Otherwise, move the current heading subtree up with
7337 `markdown-move-subtree-down'."
7340 ((markdown-list-item-at-point-p)
7341 (call-interactively #'markdown-move-list-item-down
))
7342 ((markdown-table-at-point-p)
7343 (call-interactively #'markdown-table-move-row-down
))
7345 (call-interactively #'markdown-move-subtree-down
))))
7347 (defun markdown-promote ()
7348 "Promote or move element at point to the left.
7349 Depending on the context, this function will promote a heading or
7350 list item at the point, move a table column to the left, or cycle
7355 ;; Promote atx heading subtree
7356 ((thing-at-point-looking-at markdown-regex-header-atx
)
7357 (markdown-promote-subtree))
7358 ;; Promote setext heading
7359 ((thing-at-point-looking-at markdown-regex-header-setext
)
7360 (markdown-cycle-setext -
1))
7361 ;; Promote horizontal rule
7362 ((thing-at-point-looking-at markdown-regex-hr
)
7363 (markdown-cycle-hr -
1))
7364 ;; Promote list item
7365 ((setq bounds
(markdown-cur-list-item-bounds))
7366 (markdown-promote-list-item bounds
))
7367 ;; Move table column to the left
7368 ((markdown-table-at-point-p)
7369 (call-interactively #'markdown-table-move-column-left
))
7371 ((thing-at-point-looking-at markdown-regex-bold
)
7372 (markdown-cycle-bold))
7374 ((thing-at-point-looking-at markdown-regex-italic
)
7375 (markdown-cycle-italic))
7377 (user-error "Nothing to promote at point")))))
7379 (defun markdown-demote ()
7380 "Demote or move element at point to the right.
7381 Depending on the context, this function will demote a heading or
7382 list item at the point, move a table column to the right, or cycle
7387 ;; Demote atx heading subtree
7388 ((thing-at-point-looking-at markdown-regex-header-atx
)
7389 (markdown-demote-subtree))
7390 ;; Demote setext heading
7391 ((thing-at-point-looking-at markdown-regex-header-setext
)
7392 (markdown-cycle-setext 1))
7393 ;; Demote horizontal rule
7394 ((thing-at-point-looking-at markdown-regex-hr
)
7395 (markdown-cycle-hr 1))
7397 ((setq bounds
(markdown-cur-list-item-bounds))
7398 (markdown-demote-list-item bounds
))
7399 ;; Move table column to the right
7400 ((markdown-table-at-point-p)
7401 (call-interactively #'markdown-table-move-column-right
))
7403 ((thing-at-point-looking-at markdown-regex-bold
)
7404 (markdown-cycle-bold))
7406 ((thing-at-point-looking-at markdown-regex-italic
)
7407 (markdown-cycle-italic))
7409 (user-error "Nothing to demote at point")))))
7412 ;;; Commands ==================================================================
7414 (defun markdown (&optional output-buffer-name
)
7415 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
7416 The output buffer name defaults to `markdown-output-buffer-name'.
7417 Return the name of the output buffer used."
7419 (save-window-excursion
7420 (let* ((commands (cond ((stringp markdown-command
) (split-string markdown-command
))
7421 ((listp markdown-command
) markdown-command
)))
7422 (command (car-safe commands
))
7423 (command-args (cdr-safe commands
))
7424 begin-region end-region
)
7426 (setq begin-region
(region-beginning)
7427 end-region
(region-end))
7428 (setq begin-region
(point-min)
7429 end-region
(point-max)))
7431 (unless output-buffer-name
7432 (setq output-buffer-name markdown-output-buffer-name
))
7433 (when (and (stringp command
) (not (executable-find command
)))
7434 (user-error "Markdown command %s is not found" command
))
7437 ;; Handle case when `markdown-command' does not read from stdin
7438 ((and (stringp command
) markdown-command-needs-filename
)
7439 (if (not buffer-file-name
)
7440 (user-error "Must be visiting a file")
7441 ;; Don’t use ‘shell-command’ because it’s not guaranteed to
7442 ;; return the exit code of the process.
7443 (let ((command (if (listp markdown-command
)
7444 (string-join markdown-command
" ")
7446 (shell-command-on-region
7447 ;; Pass an empty region so that stdin is empty.
7450 (shell-quote-argument buffer-file-name
))
7451 output-buffer-name
))))
7452 ;; Pass region to `markdown-command' via stdin
7454 (let ((buf (get-buffer-create output-buffer-name
)))
7455 (with-current-buffer buf
7456 (setq buffer-read-only nil
)
7458 (if (stringp command
)
7459 (if (not (null command-args
))
7460 (apply #'call-process-region begin-region end-region command nil buf nil command-args
)
7461 (call-process-region begin-region end-region command nil buf
))
7462 (if markdown-command-needs-filename
7463 (if (not buffer-file-name
)
7464 (user-error "Must be visiting a file")
7465 (funcall markdown-command begin-region end-region buf buffer-file-name
))
7466 (funcall markdown-command begin-region end-region buf
))
7467 ;; If the ‘markdown-command’ function didn’t signal an
7468 ;; error, assume it succeeded by binding ‘exit-code’ to 0.
7470 ;; The exit code can be a signal description string, so don’t use ‘=’
7472 (unless (eq exit-code
0)
7473 (user-error "%s failed with exit code %s"
7474 markdown-command exit-code
))))
7475 output-buffer-name
))
7477 (defun markdown-standalone (&optional output-buffer-name
)
7478 "Special function to provide standalone HTML output.
7479 Insert the output in the buffer named OUTPUT-BUFFER-NAME."
7481 (setq output-buffer-name
(markdown output-buffer-name
))
7482 (with-current-buffer output-buffer-name
7483 (set-buffer output-buffer-name
)
7484 (unless (markdown-output-standalone-p)
7485 (markdown-add-xhtml-header-and-footer output-buffer-name
))
7486 (goto-char (point-min))
7490 (defun markdown-other-window (&optional output-buffer-name
)
7491 "Run `markdown-command' on current buffer and display in other window.
7492 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7495 (markdown-display-buffer-other-window
7496 (markdown-standalone output-buffer-name
)))
7498 (defun markdown-output-standalone-p ()
7499 "Determine whether `markdown-command' output is standalone XHTML.
7500 Standalone XHTML output is identified by an occurrence of
7501 `markdown-xhtml-standalone-regexp' in the first five lines of output."
7503 (goto-char (point-min))
7506 markdown-xhtml-standalone-regexp
7507 (save-excursion (goto-char (point-min)) (forward-line 4) (point))
7510 (defun markdown-stylesheet-link-string (stylesheet-path)
7511 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
7512 (or (and (string-prefix-p "~" stylesheet-path
)
7513 (expand-file-name stylesheet-path
))
7517 (defun markdown-escape-title (title)
7518 "Escape a minimum set of characters in TITLE so they don't clash with html."
7519 (replace-regexp-in-string ">" ">"
7520 (replace-regexp-in-string "<" "<"
7521 (replace-regexp-in-string "&" "&" title
))))
7523 (defun markdown-add-xhtml-header-and-footer (title)
7524 "Wrap XHTML header and footer with given TITLE around current buffer."
7525 (goto-char (point-min))
7526 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
7527 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
7528 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
7529 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
7531 (insert (markdown-escape-title title
))
7532 (insert "</title>\n")
7533 (unless (= (length markdown-content-type
) 0)
7536 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
7537 markdown-content-type
7538 (or (and markdown-coding-system
7539 (coding-system-get markdown-coding-system
7541 (coding-system-get buffer-file-coding-system
7544 (if (> (length markdown-css-paths
) 0)
7545 (insert (mapconcat #'markdown-stylesheet-link-string
7546 markdown-css-paths
"\n")))
7547 (when (> (length markdown-xhtml-header-content
) 0)
7548 (insert markdown-xhtml-header-content
))
7549 (insert "\n</head>\n\n"
7551 (when (> (length markdown-xhtml-body-preamble
) 0)
7552 (insert markdown-xhtml-body-preamble
"\n"))
7553 (goto-char (point-max))
7554 (when (> (length markdown-xhtml-body-epilogue
) 0)
7555 (insert "\n" markdown-xhtml-body-epilogue
))
7560 (defun markdown-preview (&optional output-buffer-name
)
7561 "Run `markdown-command' on the current buffer and view output in browser.
7562 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7565 (browse-url-of-buffer
7566 (markdown-standalone (or output-buffer-name markdown-output-buffer-name
))))
7568 (defun markdown-export-file-name (&optional extension
)
7569 "Attempt to generate a filename for Markdown output.
7570 The file extension will be EXTENSION if given, or .html by default.
7571 If the current buffer is visiting a file, we construct a new
7572 output filename based on that filename. Otherwise, return nil."
7573 (when (buffer-file-name)
7575 (setq extension
".html"))
7580 (file-name-sans-extension (buffer-file-name)))
7584 ((equal candidate
(buffer-file-name))
7585 (concat candidate extension
))
7589 (defun markdown-export (&optional output-file
)
7590 "Run Markdown on the current buffer, save to file, and return the filename.
7591 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
7592 generated by `markdown-export-file-name', which will be constructed using the
7593 current filename, but with the extension removed and replaced with .html."
7596 (setq output-file
(markdown-export-file-name ".html")))
7598 (let* ((init-buf (current-buffer))
7599 (init-point (point))
7600 (init-buf-string (buffer-string))
7601 (output-buffer (find-file-noselect output-file
))
7602 (output-buffer-name (buffer-name output-buffer
)))
7603 (run-hooks 'markdown-before-export-hook
)
7604 (markdown-standalone output-buffer-name
)
7605 (with-current-buffer output-buffer
7606 (run-hooks 'markdown-after-export-hook
)
7608 (when markdown-export-kill-buffer
(kill-buffer)))
7609 ;; if modified, restore initial buffer
7610 (when (buffer-modified-p init-buf
)
7612 (insert init-buf-string
)
7614 (goto-char init-point
))
7617 (defun markdown-export-and-preview ()
7618 "Export to XHTML using `markdown-export' and browse the resulting file."
7620 (browse-url-of-file (markdown-export)))
7622 (defvar-local markdown-live-preview-buffer nil
7623 "Buffer used to preview markdown output in `markdown-live-preview-export'.")
7625 (defvar-local markdown-live-preview-source-buffer nil
7626 "Source buffer from which current buffer was generated.
7627 This is the inverse of `markdown-live-preview-buffer'.")
7629 (defvar markdown-live-preview-currently-exporting nil
)
7631 (defun markdown-live-preview-get-filename ()
7632 "Standardize the filename exported by `markdown-live-preview-export'."
7633 (markdown-export-file-name ".html"))
7635 (defun markdown-live-preview-window-eww (file)
7636 "Preview FILE with eww.
7637 To be used with `markdown-live-preview-window-function'."
7638 (when (and (bound-and-true-p eww-auto-rename-buffer
)
7639 markdown-live-preview-buffer
)
7640 (kill-buffer markdown-live-preview-buffer
))
7641 (eww-open-file file
)
7642 ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*"
7643 ;; Try to find the buffer whose name ends with "eww*"
7644 (if (bound-and-true-p eww-auto-rename-buffer
)
7645 (cl-loop for buf in
(buffer-list)
7646 when
(string-match-p "eww\\*\\'" (buffer-name buf
))
7648 (get-buffer "*eww*")))
7650 (defun markdown-visual-lines-between-points (beg end
)
7653 (cl-loop with count
= 0
7654 while
(progn (end-of-visual-line)
7655 (and (< (point) end
) (line-move-visual 1 t
)))
7657 finally return count
)))
7659 (defun markdown-live-preview-window-serialize (buf)
7660 "Get window point and scroll data for all windows displaying BUF."
7661 (when (buffer-live-p buf
)
7662 (with-current-buffer buf
7665 (with-selected-window win
7666 (let* ((start (window-start))
7668 (pt-or-sym (cond ((= pt
(point-min)) 'min
)
7669 ((= pt
(point-max)) 'max
)
7671 (diff (markdown-visual-lines-between-points
7673 (list win pt-or-sym diff
))))
7674 (get-buffer-window-list buf
)))))
7676 (defun markdown-get-point-back-lines (pt num-lines
)
7679 (line-move-visual (- num-lines
) t
)
7680 ;; in testing, can occasionally overshoot the number of lines to traverse
7681 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt
)))
7682 (when (> actual-num-lines num-lines
)
7683 (line-move-visual (- actual-num-lines num-lines
) t
)))
7686 (defun markdown-live-preview-window-deserialize (window-posns)
7687 "Apply window point and scroll data from WINDOW-POSNS.
7688 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
7689 (cl-destructuring-bind (win pt-or-sym diff
) window-posns
7690 (when (window-live-p win
)
7691 (with-current-buffer markdown-live-preview-buffer
7692 (set-window-buffer win
(current-buffer))
7693 (cl-destructuring-bind (actual-pt actual-diff
)
7695 (min (list (point-min) 0))
7696 (max (list (point-max) diff
))
7697 (t (list pt-or-sym diff
)))
7699 win
(markdown-get-point-back-lines actual-pt actual-diff
))
7700 (set-window-point win actual-pt
))))))
7702 (defun markdown-live-preview-export ()
7703 "Export to XHTML using `markdown-export'.
7704 Browse the resulting file within Emacs using
7705 `markdown-live-preview-window-function' Return the buffer
7706 displaying the rendered output."
7708 (let ((filename (markdown-live-preview-get-filename)))
7710 (let* ((markdown-live-preview-currently-exporting t
)
7711 (cur-buf (current-buffer))
7712 (export-file (markdown-export filename
))
7713 ;; get positions in all windows currently displaying output buffer
7715 (markdown-live-preview-window-serialize
7716 markdown-live-preview-buffer
)))
7717 (save-window-excursion
7718 (let ((output-buffer
7719 (funcall markdown-live-preview-window-function export-file
)))
7720 (with-current-buffer output-buffer
7721 (setq markdown-live-preview-source-buffer cur-buf
)
7722 (add-hook 'kill-buffer-hook
7723 #'markdown-live-preview-remove-on-kill t t
))
7724 (with-current-buffer cur-buf
7725 (setq markdown-live-preview-buffer output-buffer
))))
7726 (with-current-buffer cur-buf
7727 ;; reset all windows displaying output buffer to where they were,
7728 ;; now with the new output
7729 (mapc #'markdown-live-preview-window-deserialize window-data
)
7730 ;; delete html editing buffer
7731 (let ((buf (get-file-buffer export-file
))) (when buf
(kill-buffer buf
)))
7732 (when (and export-file
(file-exists-p export-file
)
7733 (eq markdown-live-preview-delete-export
7735 (delete-file export-file
))
7736 markdown-live-preview-buffer
)))))
7738 (defun markdown-live-preview-remove ()
7739 (when (buffer-live-p markdown-live-preview-buffer
)
7740 (kill-buffer markdown-live-preview-buffer
))
7741 (setq markdown-live-preview-buffer nil
)
7742 ;; if set to 'delete-on-export, the output has already been deleted
7743 (when (eq markdown-live-preview-delete-export
'delete-on-destroy
)
7744 (let ((outfile-name (markdown-live-preview-get-filename)))
7745 (when (and outfile-name
(file-exists-p outfile-name
))
7746 (delete-file outfile-name
)))))
7748 (defun markdown-get-other-window ()
7749 "Find another window to display preview or output content."
7751 ((memq markdown-split-window-direction
'(vertical below
))
7752 (or (window-in-direction 'below
) (split-window-vertically)))
7753 ((memq markdown-split-window-direction
'(horizontal right
))
7754 (or (window-in-direction 'right
) (split-window-horizontally)))
7755 (t (split-window-sensibly (get-buffer-window)))))
7757 (defun markdown-display-buffer-other-window (buf)
7758 "Display preview or output buffer BUF in another window."
7759 (if (and display-buffer-alist
(eq markdown-split-window-direction
'any
))
7760 (display-buffer buf
)
7761 (let ((cur-buf (current-buffer))
7762 (window (markdown-get-other-window)))
7763 (set-window-buffer window buf
)
7764 (set-buffer cur-buf
))))
7766 (defun markdown-live-preview-if-markdown ()
7767 (when (and (derived-mode-p 'markdown-mode
)
7768 markdown-live-preview-mode
)
7769 (unless markdown-live-preview-currently-exporting
7770 (if (buffer-live-p markdown-live-preview-buffer
)
7771 (markdown-live-preview-export)
7772 (markdown-display-buffer-other-window
7773 (markdown-live-preview-export))))))
7775 (defun markdown-live-preview-remove-on-kill ()
7776 (cond ((and (derived-mode-p 'markdown-mode
)
7777 markdown-live-preview-mode
)
7778 (markdown-live-preview-remove))
7779 (markdown-live-preview-source-buffer
7780 (with-current-buffer markdown-live-preview-source-buffer
7781 (setq markdown-live-preview-buffer nil
))
7782 (setq markdown-live-preview-source-buffer nil
))))
7784 (defun markdown-live-preview-switch-to-output ()
7785 "Turn on `markdown-live-preview-mode' and switch to output buffer.
7786 The output buffer is opened in another window."
7788 (if markdown-live-preview-mode
7789 (markdown-display-buffer-other-window (markdown-live-preview-export)))
7790 (markdown-live-preview-mode))
7792 (defun markdown-live-preview-re-export ()
7793 "Re-export the current live previewed content.
7794 If the current buffer is a buffer displaying the exported version of a
7795 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
7796 update this buffer's contents."
7798 (when markdown-live-preview-source-buffer
7799 (with-current-buffer markdown-live-preview-source-buffer
7800 (markdown-live-preview-export))))
7802 (defun markdown-open ()
7803 "Open file for the current buffer with `markdown-open-command'."
7805 (unless markdown-open-command
7806 (user-error "Variable `markdown-open-command' must be set"))
7807 (if (stringp markdown-open-command
)
7808 (if (not buffer-file-name
)
7809 (user-error "Must be visiting a file")
7811 (let ((exit-code (call-process markdown-open-command nil nil nil
7813 ;; The exit code can be a signal description string, so don’t use ‘=’
7815 (unless (eq exit-code
0)
7816 (user-error "%s failed with exit code %s"
7817 markdown-open-command exit-code
))))
7818 (funcall markdown-open-command
))
7821 (defun markdown-kill-ring-save ()
7822 "Run Markdown on file and store output in the kill ring."
7824 (save-window-excursion
7826 (with-current-buffer markdown-output-buffer-name
7827 (kill-ring-save (point-min) (point-max)))))
7830 ;;; Links =====================================================================
7832 (defun markdown-backward-to-link-start ()
7833 "Backward link start position if current position is in link title."
7835 (when (eq (get-text-property (point) 'face
) 'markdown-link-face
)
7836 (skip-chars-backward "^[")
7839 (defun markdown-link-p ()
7840 "Return non-nil when `point' is at a non-wiki link.
7841 See `markdown-wiki-link-p' for more information."
7843 (let ((case-fold-search nil
))
7844 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p)))
7845 (markdown-backward-to-link-start)
7846 (or (thing-at-point-looking-at markdown-regex-link-inline
)
7847 (thing-at-point-looking-at markdown-regex-link-reference
)
7848 (thing-at-point-looking-at markdown-regex-uri
)
7849 (thing-at-point-looking-at markdown-regex-angle-uri
))))))
7851 (defun markdown-link-at-pos (pos)
7852 "Return properties of link or image at position POS.
7853 Value is a list of elements describing the link:
7854 0. beginning position
7860 6. bang (nil or \"!\")"
7863 (markdown-backward-to-link-start)
7864 (let (begin end text url reference title bang
)
7866 ;; Inline image or link at point.
7867 ((thing-at-point-looking-at markdown-regex-link-inline
)
7868 (setq bang
(match-string-no-properties 1)
7869 begin
(match-beginning 0)
7870 text
(match-string-no-properties 3)
7871 url
(match-string-no-properties 6))
7872 ;; consider nested parentheses
7873 ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link
7874 (let* ((close-pos (scan-sexps (match-beginning 5) 1))
7875 (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos
)))))
7876 (setq end close-pos
)
7877 ;; A link can contain spaces if it is wrapped with angle brackets
7878 (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part
)
7879 (setq url
(match-string-no-properties 1 destination-part
)))
7880 ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part
)
7881 (setq url
(match-string-no-properties 1 destination-part
)
7882 title
(substring (match-string-no-properties 2 destination-part
) 1 -
1)))
7883 (t (setq url destination-part
)))
7884 (setq url
(url-unhex-string url
))))
7885 ;; Reference link at point.
7886 ((thing-at-point-looking-at markdown-regex-link-reference
)
7887 (setq bang
(match-string-no-properties 1)
7888 begin
(match-beginning 0)
7890 text
(match-string-no-properties 3))
7891 (when (char-equal (char-after (match-beginning 5)) ?\
[)
7892 (setq reference
(match-string-no-properties 6))))
7893 ;; Angle bracket URI at point.
7894 ((thing-at-point-looking-at markdown-regex-angle-uri
)
7895 (setq begin
(match-beginning 0)
7897 url
(match-string-no-properties 2)))
7898 ;; Plain URI at point.
7899 ((thing-at-point-looking-at markdown-regex-uri
)
7900 (setq begin
(match-beginning 0)
7902 url
(match-string-no-properties 1))))
7903 (list begin end text url reference title bang
))))
7905 (defun markdown-link-url ()
7906 "Return the URL part of the regular (non-wiki) link at point.
7907 Works with both inline and reference style links, and with images.
7908 If point is not at a link or the link reference is not defined
7910 (let* ((values (markdown-link-at-pos (point)))
7911 (text (nth 2 values
))
7912 (url (nth 3 values
))
7913 (ref (nth 4 values
)))
7914 (or url
(and ref
(car (markdown-reference-definition
7915 (downcase (if (string= ref
"") text ref
))))))))
7917 (defun markdown--browse-url (url)
7918 (let* ((struct (url-generic-parse-url url
))
7919 (full (url-fullness struct
))
7921 ;; Parse URL, determine fullness, strip query string
7922 (setq file
(car (url-path-and-query struct
)))
7923 ;; Open full URLs in browser, files in Emacs
7926 (when (and file
(> (length file
) 0))
7927 (let ((link-file (funcall markdown-translate-filename-function file
)))
7928 (if (and markdown-open-image-command
(string-match-p (image-file-name-regexp) link-file
))
7929 (if (functionp markdown-open-image-command
)
7930 (funcall markdown-open-image-command link-file
)
7931 (process-file markdown-open-image-command nil nil nil link-file
))
7932 (find-file link-file
)))))))
7934 (defun markdown-follow-link-at-point (&optional event
)
7935 "Open the non-wiki link at point or EVENT.
7936 If the link is a complete URL, open in browser with `browse-url'.
7937 Otherwise, open with `find-file' after stripping anchor and/or query string.
7938 Translate filenames using `markdown-filename-translate-function'."
7939 (interactive (list last-command-event
))
7940 (if event
(posn-set-point (event-start event
)))
7941 (if (markdown-link-p)
7942 (or (run-hook-with-args-until-success 'markdown-follow-link-functions
(markdown-link-url))
7943 (markdown--browse-url (markdown-link-url)))
7944 (user-error "Point is not at a Markdown link or URL")))
7946 (defun markdown-fontify-inline-links (last)
7947 "Add text properties to next inline link from point to LAST."
7948 (when (markdown-match-generic-links last nil
)
7949 (let* ((link-start (match-beginning 3))
7950 (link-end (match-end 3))
7951 (url-start (match-beginning 6))
7952 (url-end (match-end 6))
7953 (url (match-string-no-properties 6))
7954 (title-start (match-beginning 7))
7955 (title-end (match-end 7))
7956 (title (match-string-no-properties 7))
7958 (mp (list 'invisible
'markdown-markup
7960 'font-lock-multiline t
))
7961 ;; Link part (without face)
7962 (lp (list 'keymap markdown-mode-mouse-map
7963 'mouse-face
'markdown-highlight-face
7964 'font-lock-multiline t
7965 'help-echo
(if title
(concat title
"\n" url
) url
)))
7967 (up (list 'keymap markdown-mode-mouse-map
7968 'invisible
'markdown-markup
7969 'mouse-face
'markdown-highlight-face
7970 'font-lock-multiline t
))
7971 ;; URL composition character
7972 (url-char (markdown--first-displayable markdown-url-compose-char
))
7974 (tp (list 'invisible
'markdown-markup
7975 'font-lock-multiline t
)))
7976 (dolist (g '(1 2 4 5 8))
7978 (add-text-properties (match-beginning g
) (match-end g
) mp
)
7979 (add-face-text-property (match-beginning g
) (match-end g
) 'markdown-markup-face
)))
7980 ;; Preserve existing faces applied to link part (e.g., inline code)
7982 (add-text-properties link-start link-end lp
)
7983 (add-face-text-property link-start link-end
'markdown-link-face
))
7985 (add-text-properties url-start url-end up
)
7986 (add-face-text-property url-start url-end
'markdown-url-face
))
7988 (add-text-properties url-end title-end tp
)
7989 (add-face-text-property url-end title-end
'markdown-link-title-face
))
7990 (when (and markdown-hide-urls url-start
)
7991 (compose-region url-start
(or title-end url-end
) url-char
))
7994 (defun markdown-fontify-reference-links (last)
7995 "Add text properties to next reference link from point to LAST."
7996 (when (markdown-match-generic-links last t
)
7997 (let* ((link-start (match-beginning 3))
7998 (link-end (match-end 3))
7999 (ref-start (match-beginning 6))
8000 (ref-end (match-end 6))
8002 (mp (list 'invisible
'markdown-markup
8004 'font-lock-multiline t
))
8006 (lp (list 'keymap markdown-mode-mouse-map
8007 'mouse-face
'markdown-highlight-face
8008 'font-lock-multiline t
8009 'help-echo
(lambda (_ __ pos
)
8013 (or (markdown-link-url)
8014 "Undefined reference"))))))
8015 ;; URL composition character
8016 (url-char (markdown--first-displayable markdown-url-compose-char
))
8018 (rp (list 'invisible
'markdown-markup
8019 'font-lock-multiline t
)))
8020 (dolist (g '(1 2 4 5 8))
8022 (add-text-properties (match-beginning g
) (match-end g
) mp
)
8023 (add-face-text-property (match-beginning g
) (match-end g
) 'markdown-markup-face
)))
8025 (add-text-properties link-start link-end lp
)
8026 (add-face-text-property link-start link-end
'markdown-link-face
))
8028 (add-text-properties ref-start ref-end rp
)
8029 (add-face-text-property ref-start ref-end
'markdown-reference-face
)
8030 (when (and markdown-hide-urls
(> (- ref-end ref-start
) 2))
8031 (compose-region ref-start ref-end url-char
)))
8034 (defun markdown-fontify-angle-uris (last)
8035 "Add text properties to angle URIs from point to LAST."
8036 (when (markdown-match-angle-uris last
)
8037 (let* ((url-start (match-beginning 2))
8038 (url-end (match-end 2))
8040 (mp (list 'face
'markdown-markup-face
8041 'invisible
'markdown-markup
8043 'font-lock-multiline t
))
8045 (up (list 'keymap markdown-mode-mouse-map
8046 'face
'markdown-plain-url-face
8047 'mouse-face
'markdown-highlight-face
8048 'font-lock-multiline t
)))
8050 (add-text-properties (match-beginning g
) (match-end g
) mp
))
8051 (add-text-properties url-start url-end up
)
8054 (defun markdown-fontify-plain-uris (last)
8055 "Add text properties to plain URLs from point to LAST."
8056 (when (markdown-match-plain-uris last
)
8057 (let* ((start (match-beginning 0))
8059 (props (list 'keymap markdown-mode-mouse-map
8060 'face
'markdown-plain-url-face
8061 'mouse-face
'markdown-highlight-face
8063 'font-lock-multiline t
)))
8064 (add-text-properties start end props
)
8067 (defun markdown-toggle-url-hiding (&optional arg
)
8068 "Toggle the display or hiding of URLs.
8069 With a prefix argument ARG, enable URL hiding if ARG is positive,
8070 and disable it otherwise."
8071 (interactive (list (or current-prefix-arg
'toggle
)))
8072 (setq markdown-hide-urls
8073 (if (eq arg
'toggle
)
8074 (not markdown-hide-urls
)
8075 (> (prefix-numeric-value arg
) 0)))
8076 (if markdown-hide-urls
8077 (message "markdown-mode URL hiding enabled")
8078 (message "markdown-mode URL hiding disabled"))
8079 (markdown-reload-extensions))
8082 ;;; Wiki Links ================================================================
8084 (defun markdown-wiki-link-p ()
8085 "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
8086 A true wiki link name matches `markdown-regex-wiki-link' but does
8087 not match the current file name after conversion. This modifies
8088 the data returned by `match-data'. Note that the potential wiki
8089 link name must be available via `match-string'."
8090 (when markdown-enable-wiki-links
8091 (let ((case-fold-search nil
))
8092 (and (thing-at-point-looking-at markdown-regex-wiki-link
)
8093 (not (markdown-code-block-at-point-p))
8094 (or (not buffer-file-name
)
8095 (not (string-equal (buffer-file-name)
8096 (markdown-convert-wiki-link-to-filename
8097 (markdown-wiki-link-link)))))))))
8099 (defun markdown-wiki-link-link ()
8100 "Return the link part of the wiki link using current match data.
8101 The location of the link component depends on the value of
8102 `markdown-wiki-link-alias-first'."
8103 (if markdown-wiki-link-alias-first
8104 (or (match-string-no-properties 5) (match-string-no-properties 3))
8105 (match-string-no-properties 3)))
8107 (defun markdown-wiki-link-alias ()
8108 "Return the alias or text part of the wiki link using current match data.
8109 The location of the alias component depends on the value of
8110 `markdown-wiki-link-alias-first'."
8111 (if markdown-wiki-link-alias-first
8112 (match-string-no-properties 3)
8113 (or (match-string-no-properties 5) (match-string-no-properties 3))))
8115 (defun markdown--wiki-link-search-types ()
8116 (let ((ret (and markdown-wiki-link-search-type
8117 (cl-copy-list markdown-wiki-link-search-type
))))
8118 (when (and markdown-wiki-link-search-subdirectories
8119 (not (memq 'sub-directories markdown-wiki-link-search-type
)))
8120 (push 'sub-directories ret
))
8121 (when (and markdown-wiki-link-search-parent-directories
8122 (not (memq 'parent-directories markdown-wiki-link-search-type
)))
8123 (push 'parent-directories ret
))
8126 (defun markdown--project-root ()
8127 (or (cl-loop for dir in
'(".git" ".hg" ".svn")
8128 when
(locate-dominating-file default-directory dir
)
8132 (let ((project (project-current t
)))
8134 (if (fboundp 'project-root
)
8135 (project-root project
)
8136 (car (project-roots project
))))))))
8138 (defun markdown-convert-wiki-link-to-filename (name)
8139 "Generate a filename from the wiki link NAME.
8140 Spaces in NAME are replaced with `markdown-link-space-sub-char'.
8141 When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
8142 and [[test test]] both map to Test-test.ext. Look in the current
8143 directory first, then in subdirectories if
8144 `markdown-wiki-link-search-subdirectories' is non-nil, and then
8145 in parent directories if
8146 `markdown-wiki-link-search-parent-directories' is non-nil."
8148 ;; This function must not overwrite match data(PR #590)
8149 (let* ((basename (replace-regexp-in-string
8150 "[[:space:]\n]" markdown-link-space-sub-char name
))
8151 (basename (if (derived-mode-p 'gfm-mode
)
8152 (concat (upcase (substring basename
0 1))
8153 (downcase (substring basename
1 nil
)))
8155 (search-types (markdown--wiki-link-search-types))
8156 directory extension default candidates dir
)
8157 (when buffer-file-name
8158 (setq directory
(file-name-directory buffer-file-name
)
8159 extension
(file-name-extension buffer-file-name
)))
8160 (setq default
(concat basename
8161 (when extension
(concat "." extension
))))
8163 ;; Look in current directory first.
8164 ((or (null buffer-file-name
)
8165 (file-exists-p default
))
8167 ;; Possibly search in subdirectories, next.
8168 ((and (memq 'sub-directories search-types
)
8170 (directory-files-recursively
8171 directory
(concat "^" default
"$"))))
8173 ;; Possibly search in parent directories as a last resort.
8174 ((and (memq 'parent-directories search-types
)
8175 (setq dir
(locate-dominating-file directory default
)))
8176 (concat dir default
))
8177 ((and (memq 'project search-types
)
8179 (directory-files-recursively
8180 (markdown--project-root) (concat "^" default
"$"))))
8182 ;; If nothing is found, return default in current directory.
8185 (defun markdown-follow-wiki-link (name &optional other
)
8186 "Follow the wiki link NAME.
8187 Convert the name to a file name and call `find-file'. Ensure that
8188 the new buffer remains in `markdown-mode'. Open the link in another
8189 window when OTHER is non-nil."
8190 (let ((filename (markdown-convert-wiki-link-to-filename name
))
8191 (wp (when buffer-file-name
8192 (file-name-directory buffer-file-name
))))
8194 (user-error "Must be visiting a file")
8195 (when other
(other-window 1))
8196 (let ((default-directory wp
))
8197 (find-file filename
)))
8198 (unless (derived-mode-p 'markdown-mode
)
8201 (defun markdown-follow-wiki-link-at-point (&optional arg
)
8202 "Find Wiki Link at point.
8203 With prefix argument ARG, open the file in other window.
8204 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
8206 (if (markdown-wiki-link-p)
8207 (markdown-follow-wiki-link (markdown-wiki-link-link) arg
)
8208 (user-error "Point is not at a Wiki Link")))
8210 (defun markdown-highlight-wiki-link (from to face
)
8211 "Highlight the wiki link in the region between FROM and TO using FACE."
8212 (put-text-property from to
'font-lock-face face
))
8214 (defun markdown-unfontify-region-wiki-links (from to
)
8215 "Remove wiki link faces from the region specified by FROM and TO."
8217 (let ((modified (buffer-modified-p)))
8218 (remove-text-properties from to
'(font-lock-face markdown-link-face
))
8219 (remove-text-properties from to
'(font-lock-face markdown-missing-link-face
))
8220 ;; remove-text-properties marks the buffer modified in emacs 24.3,
8221 ;; undo that if it wasn't originally marked modified
8222 (set-buffer-modified-p modified
)))
8224 (defun markdown-fontify-region-wiki-links (from to
)
8225 "Search region given by FROM and TO for wiki links and fontify them.
8226 If a wiki link is found check to see if the backing file exists
8227 and highlight accordingly."
8230 (while (re-search-forward markdown-regex-wiki-link to t
)
8231 (when (not (markdown-code-block-at-point-p))
8232 (let ((highlight-beginning (match-beginning 1))
8233 (highlight-end (match-end 1))
8235 (markdown-convert-wiki-link-to-filename
8236 (markdown-wiki-link-link))))
8237 (if (condition-case nil
(file-exists-p file-name
) (error nil
))
8238 (markdown-highlight-wiki-link
8239 highlight-beginning highlight-end
'markdown-link-face
)
8240 (markdown-highlight-wiki-link
8241 highlight-beginning highlight-end
'markdown-missing-link-face
)))))))
8243 (defun markdown-extend-changed-region (from to
)
8244 "Extend region given by FROM and TO so that we can fontify all links.
8245 The region is extended to the first newline before and the first
8247 ;; start looking for the first new line before 'from
8249 (re-search-backward "\n" nil t
)
8250 (let ((new-from (point-min))
8251 (new-to (point-max)))
8252 (if (not (= (point) from
))
8253 (setq new-from
(point)))
8254 ;; do the same thing for the first new line after 'to
8256 (re-search-forward "\n" nil t
)
8257 (if (not (= (point) to
))
8258 (setq new-to
(point)))
8259 (cl-values new-from new-to
)))
8261 (defun markdown-check-change-for-wiki-link (from to
)
8262 "Check region between FROM and TO for wiki links and re-fontify as needed."
8264 (let* ((modified (buffer-modified-p))
8265 (buffer-undo-list t
)
8266 (inhibit-read-only t
)
8268 buffer-file-truename
)
8273 (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29
8274 ;; Extend the region to fontify so that it starts
8275 ;; and ends at safe places.
8276 (cl-multiple-value-bind (new-from new-to
)
8277 (markdown-extend-changed-region from to
)
8278 (goto-char new-from
)
8279 ;; Only refontify when the range contains text with a
8280 ;; wiki link face or if the wiki link regexp matches.
8281 (when (or (markdown-range-property-any
8282 new-from new-to
'font-lock-face
8283 '(markdown-link-face markdown-missing-link-face
))
8285 markdown-regex-wiki-link new-to t
))
8286 ;; Unfontify existing fontification (start from scratch)
8287 (markdown-unfontify-region-wiki-links new-from new-to
)
8288 ;; Now do the fontification.
8289 (markdown-fontify-region-wiki-links new-from new-to
))))))
8290 (cursor-intangible-mode -
1)
8293 (set-buffer-modified-p nil
)))))
8295 (defun markdown-check-change-for-wiki-link-after-change (from to _
)
8296 "Check region between FROM and TO for wiki links and re-fontify as needed.
8297 Designed to be used with the `after-change-functions' hook."
8298 (markdown-check-change-for-wiki-link from to
))
8300 (defun markdown-fontify-buffer-wiki-links ()
8301 "Refontify all wiki links in the buffer."
8303 (markdown-check-change-for-wiki-link (point-min) (point-max)))
8305 (defun markdown-toggle-wiki-links (&optional arg
)
8306 "Toggle support for wiki links.
8307 With a prefix argument ARG, enable wiki link support if ARG is positive,
8308 and disable it otherwise."
8309 (interactive (list (or current-prefix-arg
'toggle
)))
8310 (setq markdown-enable-wiki-links
8311 (if (eq arg
'toggle
)
8312 (not markdown-enable-wiki-links
)
8313 (> (prefix-numeric-value arg
) 0)))
8314 (if markdown-enable-wiki-links
8315 (message "markdown-mode wiki link support enabled")
8316 (message "markdown-mode wiki link support disabled"))
8317 (markdown-reload-extensions))
8319 (defun markdown-setup-wiki-link-hooks ()
8320 "Add or remove hooks for fontifying wiki links.
8321 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
8322 ;; Anytime text changes make sure it gets fontified correctly
8323 (if (and markdown-enable-wiki-links
8324 markdown-wiki-link-fontify-missing
)
8325 (add-hook 'after-change-functions
8326 #'markdown-check-change-for-wiki-link-after-change t t
)
8327 (remove-hook 'after-change-functions
8328 #'markdown-check-change-for-wiki-link-after-change t
))
8329 ;; If we left the buffer there is a really good chance we were
8330 ;; creating one of the wiki link documents. Make sure we get
8331 ;; refontified when we come back.
8332 (if (and markdown-enable-wiki-links
8333 markdown-wiki-link-fontify-missing
)
8335 (add-hook 'window-configuration-change-hook
8336 #'markdown-fontify-buffer-wiki-links t t
)
8337 (markdown-fontify-buffer-wiki-links))
8338 (remove-hook 'window-configuration-change-hook
8339 #'markdown-fontify-buffer-wiki-links t
)
8340 (markdown-unfontify-region-wiki-links (point-min) (point-max))))
8343 ;;; Following & Doing =========================================================
8345 (defun markdown-follow-thing-at-point (arg)
8346 "Follow thing at point if possible, such as a reference link or wiki link.
8347 Opens inline and reference links in a browser. Opens wiki links
8348 to other files in the current window, or the another window if
8350 See `markdown-follow-link-at-point' and
8351 `markdown-follow-wiki-link-at-point'."
8353 (cond ((markdown-link-p)
8354 (markdown-follow-link-at-point))
8355 ((markdown-wiki-link-p)
8356 (markdown-follow-wiki-link-at-point arg
))
8358 (let* ((values (markdown-link-at-pos (point)))
8359 (url (nth 3 values
)))
8361 (user-error "Nothing to follow at point"))
8362 (markdown--browse-url url
)))))
8364 (defun markdown-do ()
8365 "Do something sensible based on context at point.
8366 Jumps between reference links and definitions; between footnote
8367 markers and footnote text."
8370 ;; Footnote definition
8371 ((markdown-footnote-text-positions)
8372 (markdown-footnote-return))
8374 ((markdown-footnote-marker-positions)
8375 (markdown-footnote-goto-text))
8377 ((thing-at-point-looking-at markdown-regex-link-reference
)
8378 (markdown-reference-goto-definition))
8379 ;; Reference definition
8380 ((thing-at-point-looking-at markdown-regex-reference-definition
)
8381 (markdown-reference-goto-link (match-string-no-properties 2)))
8383 ((or (markdown-link-p) (markdown-wiki-link-p))
8384 (markdown-follow-thing-at-point nil
))
8385 ;; GFM task list item
8386 ((markdown-gfm-task-list-item-at-point)
8387 (markdown-toggle-gfm-checkbox))
8389 ((markdown-table-at-point-p)
8390 (call-interactively #'markdown-table-align
))
8393 (markdown-insert-gfm-checkbox))))
8396 ;;; Miscellaneous =============================================================
8398 (defun markdown-compress-whitespace-string (str)
8399 "Compress whitespace in STR and return result.
8400 Leading and trailing whitespace is removed. Sequences of multiple
8401 spaces, tabs, and newlines are replaced with single spaces."
8402 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
8403 (replace-regexp-in-string "[ \t\n]+" " " str
)))
8405 (defun markdown--substitute-command-keys (string)
8406 "Like `substitute-command-keys' but, but prefers control characters.
8407 First pass STRING to `substitute-command-keys' and then
8408 substitute `C-i` for `TAB` and `C-m` for `RET`."
8409 (replace-regexp-in-string
8411 (replace-regexp-in-string
8412 "\\<RET\\>" "C-m" (substitute-command-keys string
) t
) t
))
8414 (defun markdown-line-number-at-pos (&optional pos
)
8415 "Return (narrowed) buffer line number at position POS.
8416 If POS is nil, use current buffer location.
8417 This is an exact copy of `line-number-at-pos' for use in emacs21."
8418 (let ((opoint (or pos
(point))) start
)
8420 (goto-char (point-min))
8421 (setq start
(point))
8424 (1+ (count-lines start
(point))))))
8426 (defun markdown-inside-link-p ()
8427 "Return t if point is within a link."
8429 (thing-at-point-looking-at (markdown-make-regex-link-generic))))
8431 (defun markdown-line-is-reference-definition-p ()
8432 "Return whether the current line is a (non-footnote) reference definition."
8434 (move-beginning-of-line 1)
8435 (and (looking-at-p markdown-regex-reference-definition
)
8436 (not (looking-at-p "[ \t]*\\[^")))))
8438 (defun markdown-adaptive-fill-function ()
8439 "Return prefix for filling paragraph or nil if not determined."
8441 ;; List item inside blockquote
8442 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
8443 (replace-regexp-in-string
8444 "[0-9\\.*+-]" " " (match-string-no-properties 0)))
8446 ((looking-at markdown-regex-blockquote
)
8447 (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
8449 ((looking-at markdown-regex-list
)
8450 (match-string-no-properties 0))
8451 ;; Footnote definition
8452 ((looking-at-p markdown-regex-footnote-definition
)
8457 (defun markdown-fill-paragraph (&optional justify
)
8458 "Fill paragraph at or after point.
8459 This function is like \\[fill-paragraph], but it skips Markdown
8460 code blocks. If the point is in a code block, or just before one,
8461 do not fill. Otherwise, call `fill-paragraph' as usual. If
8462 JUSTIFY is non-nil, justify text as well. Since this function
8463 handles filling itself, it always returns t so that
8464 `fill-paragraph' doesn't run."
8466 (unless (or (markdown-code-block-at-point-p)
8468 (back-to-indentation)
8469 (skip-syntax-forward "-")
8470 (markdown-code-block-at-point-p)))
8471 (let ((fill-prefix (save-excursion
8472 (goto-char (line-beginning-position))
8473 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)")
8474 (match-string-no-properties 1)))))
8475 (fill-paragraph justify
)))
8478 (defun markdown-fill-forward-paragraph (&optional arg
)
8479 "Function used by `fill-paragraph' to move over ARG paragraphs.
8480 This is a `fill-forward-paragraph-function' for `markdown-mode'.
8481 It is called with a single argument specifying the number of
8482 paragraphs to move. Just like `forward-paragraph', it should
8483 return the number of paragraphs left to move."
8484 (or arg
(setq arg
1))
8486 ;; With positive ARG, move across ARG non-code-block paragraphs,
8487 ;; one at a time. When passing a code block, don't decrement ARG.
8488 (while (and (not (eobp))
8490 (= (forward-paragraph 1) 0)
8491 (or (markdown-code-block-at-pos (line-beginning-position 0))
8492 (setq arg
(1- arg
)))))
8493 ;; Move backward by one paragraph with negative ARG (always -1).
8494 (let ((start (point)))
8495 (setq arg
(forward-paragraph arg
))
8496 (while (and (not (eobp))
8497 (progn (move-to-left-margin) (not (eobp)))
8498 (looking-at-p paragraph-separate
))
8501 ;; Move point past whitespace following list marker.
8502 ((looking-at markdown-regex-list
)
8503 (goto-char (match-end 0)))
8504 ;; Move point past whitespace following pipe at beginning of line
8505 ;; to handle Pandoc line blocks.
8506 ((looking-at "^|\\s-*")
8507 (goto-char (match-end 0)))
8508 ;; Return point if the paragraph passed was a code block.
8509 ((markdown-code-block-at-pos (line-beginning-position 2))
8510 (goto-char start
)))))
8513 (defun markdown--inhibit-electric-quote ()
8514 "Function added to `electric-quote-inhibit-functions'.
8515 Return non-nil if the quote has been inserted inside a code block
8517 (let ((pos (1- (point))))
8518 (or (markdown-inline-code-at-pos pos
)
8519 (markdown-code-block-at-pos pos
))))
8522 ;;; Extension Framework =======================================================
8524 (defun markdown-reload-extensions ()
8525 "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
8527 (when (derived-mode-p 'markdown-mode
)
8530 ;; Add or remove hooks related to extensions
8531 (markdown-setup-wiki-link-hooks)))
8533 (defun markdown-handle-local-variables ()
8534 "Run in `hack-local-variables-hook' to update font lock rules.
8535 Checks to see if there is actually a ‘markdown-mode’ file local variable
8536 before regenerating font-lock rules for extensions."
8537 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist
)
8538 (assoc 'markdown-enable-math file-local-variables-alist
))
8539 (when (assoc 'markdown-enable-math file-local-variables-alist
)
8540 (markdown-toggle-math markdown-enable-math
))
8541 (markdown-reload-extensions)))
8544 ;;; Math Support ==============================================================
8546 (defconst markdown-mode-font-lock-keywords-math
8548 ;; Equation reference (eq:foo)
8549 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" .
((1 markdown-markup-face
)
8550 (2 markdown-reference-face
)
8551 (3 markdown-markup-face
)))
8552 ;; Equation reference \eqref{foo}
8553 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" .
((1 markdown-markup-face
)
8554 (2 markdown-reference-face
)
8555 (3 markdown-markup-face
))))
8556 "Font lock keywords to add and remove when toggling math support.")
8558 (defun markdown-toggle-math (&optional arg
)
8559 "Toggle support for inline and display LaTeX math expressions.
8560 With a prefix argument ARG, enable math mode if ARG is positive,
8561 and disable it otherwise. If called from Lisp, enable the mode
8562 if ARG is omitted or nil."
8563 (interactive (list (or current-prefix-arg
'toggle
)))
8564 (setq markdown-enable-math
8565 (if (eq arg
'toggle
)
8566 (not markdown-enable-math
)
8567 (> (prefix-numeric-value arg
) 0)))
8568 (if markdown-enable-math
8570 (font-lock-add-keywords
8571 'markdown-mode markdown-mode-font-lock-keywords-math
)
8572 (message "markdown-mode math support enabled"))
8573 (font-lock-remove-keywords
8574 'markdown-mode markdown-mode-font-lock-keywords-math
)
8575 (message "markdown-mode math support disabled"))
8576 (markdown-reload-extensions))
8579 ;;; GFM Checkboxes ============================================================
8581 (define-button-type 'markdown-gfm-checkbox-button
8583 'face
'markdown-gfm-checkbox-face
8584 'mouse-face
'markdown-highlight-face
8585 'action
#'markdown-toggle-gfm-checkbox-button
)
8587 (defun markdown-gfm-task-list-item-at-point (&optional bounds
)
8588 "Return non-nil if there is a GFM task list item at the point.
8589 Optionally, the list item BOUNDS may be given if available, as
8590 returned by `markdown-cur-list-item-bounds'. When a task list item
8591 is found, the return value is the same value returned by
8592 `markdown-cur-list-item-bounds'."
8594 (setq bounds
(markdown-cur-list-item-bounds)))
8595 (> (length (nth 5 bounds
)) 0))
8597 (defun markdown-insert-gfm-checkbox ()
8598 "Add GFM checkbox at point.
8600 Returns nil if non-applicable."
8602 (let ((bounds (markdown-cur-list-item-bounds)))
8604 (unless (cl-sixth bounds
)
8605 (let ((pos (+ (cl-first bounds
) (cl-fourth bounds
)))
8613 (syntax-propertize (+ (cl-second bounds
) 4))
8615 (unless (save-excursion
8616 (back-to-indentation)
8617 (or (markdown-list-item-at-point-p)
8618 (markdown-heading-at-point)
8619 (markdown-in-comment-p)
8620 (markdown-code-block-at-point-p)))
8621 (let ((pos (save-excursion
8622 (back-to-indentation)
8624 (markup (concat (or (save-excursion
8625 (beginning-of-line 0)
8626 (cl-fifth (markdown-cur-list-item-bounds)))
8627 markdown-unordered-list-item-prefix
)
8635 (syntax-propertize (line-end-position))
8638 (defun markdown-toggle-gfm-checkbox ()
8639 "Toggle GFM checkbox at point.
8640 Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
8641 Returns nil if there is no task list item at the point."
8645 (let ((bounds (markdown-cur-list-item-bounds)))
8647 ;; Move to beginning of task list item
8648 (goto-char (cl-first bounds
))
8649 ;; Advance to column of first non-whitespace after marker
8650 (forward-char (cl-fourth bounds
))
8651 (cond ((looking-at "\\[ \\]")
8653 (if markdown-gfm-uppercase-checkbox
"[X]" "[x]")
8655 (match-string-no-properties 0))
8656 ((looking-at "\\[[xX]\\]")
8657 (replace-match "[ ]" nil t
)
8658 (match-string-no-properties 0))))))))
8660 (defun markdown-toggle-gfm-checkbox-button (button)
8661 "Toggle GFM checkbox BUTTON on click."
8664 (goto-char (button-start button
))
8665 (markdown-toggle-gfm-checkbox))))
8667 (defun markdown-make-gfm-checkboxes-buttons (start end
)
8668 "Make GFM checkboxes buttons in region between START and END."
8671 (let ((case-fold-search t
))
8673 (while (re-search-forward markdown-regex-gfm-checkbox end t
)
8674 (make-button (match-beginning 1) (match-end 1)
8675 :type
'markdown-gfm-checkbox-button
))))))
8677 ;; Called when any modification is made to buffer text.
8678 (defun markdown-gfm-checkbox-after-change-function (beg end _
)
8679 "Add to `after-change-functions' to setup GFM checkboxes as buttons.
8680 BEG and END are the limits of scanned region."
8683 ;; Rescan between start of line from `beg' and start of line after `end'.
8684 (markdown-make-gfm-checkboxes-buttons
8685 (progn (goto-char beg
) (beginning-of-line) (point))
8686 (progn (goto-char end
) (forward-line 1) (point))))))
8688 (defun markdown-remove-gfm-checkbox-overlays ()
8689 "Remove all GFM checkbox overlays in buffer."
8693 (remove-overlays nil nil
'face
'markdown-gfm-checkbox-face
))))
8696 ;;; Display inline image ======================================================
8698 (defvar-local markdown-inline-image-overlays nil
)
8700 (defun markdown-remove-inline-images ()
8701 "Remove inline image overlays from image links in the buffer.
8702 This can be toggled with `markdown-toggle-inline-images'
8703 or \\[markdown-toggle-inline-images]."
8705 (mapc #'delete-overlay markdown-inline-image-overlays
)
8706 (setq markdown-inline-image-overlays nil
)
8707 (when (fboundp 'clear-image-cache
) (clear-image-cache)))
8709 (defcustom markdown-display-remote-images nil
8710 "If non-nil, download and display remote images.
8711 See also `markdown-inline-image-overlays'.
8713 Only image URLs specified with a protocol listed in
8714 `markdown-remote-image-protocols' are displayed."
8718 (defcustom markdown-remote-image-protocols
'("https")
8719 "List of protocols to use to download remote images.
8720 See also `markdown-display-remote-images'."
8722 :type
'(repeat string
))
8724 (defvar markdown--remote-image-cache
8725 (make-hash-table :test
'equal
)
8726 "A map from URLs to image paths.")
8728 (defun markdown--get-remote-image (url)
8729 "Retrieve the image path for a given URL."
8730 (or (gethash url markdown--remote-image-cache
)
8731 (let ((dl-path (make-temp-file "markdown-mode--image")))
8733 (url-copy-file url dl-path t
)
8734 (puthash url dl-path markdown--remote-image-cache
))))
8736 (defun markdown-display-inline-images ()
8737 "Add inline image overlays to image links in the buffer.
8738 This can be toggled with `markdown-toggle-inline-images'
8739 or \\[markdown-toggle-inline-images]."
8741 (unless (display-images-p)
8742 (error "Cannot show images"))
8746 (goto-char (point-min))
8747 (while (re-search-forward markdown-regex-link-inline nil t
)
8748 (let* ((start (match-beginning 0))
8749 (imagep (match-beginning 1))
8751 (file (match-string-no-properties 6)))
8753 (not (zerop (length file
))))
8754 (unless (file-exists-p file
)
8755 (let* ((download-file (funcall markdown-translate-filename-function file
))
8756 (valid-url (ignore-errors
8757 (member (downcase (url-type (url-generic-parse-url download-file
)))
8758 markdown-remote-image-protocols
))))
8759 (if (and markdown-display-remote-images valid-url
)
8760 (setq file
(markdown--get-remote-image download-file
))
8761 (when (not valid-url
)
8762 ;; strip query parameter
8763 (setq file
(replace-regexp-in-string "?.+\\'" "" file
))
8764 (unless (file-exists-p file
)
8765 (setq file
(url-unhex-string file
)))))))
8766 (when (file-exists-p file
)
8767 (let* ((abspath (if (file-name-absolute-p file
)
8769 (concat default-directory file
)))
8771 (cond ((and markdown-max-image-size
8772 (image-type-available-p 'imagemagick
))
8774 abspath
'imagemagick nil
8775 :max-width
(car markdown-max-image-size
)
8776 :max-height
(cdr markdown-max-image-size
)))
8777 (markdown-max-image-size
8778 (create-image abspath nil nil
8779 :max-width
(car markdown-max-image-size
)
8780 :max-height
(cdr markdown-max-image-size
)))
8781 (t (create-image abspath
)))))
8783 (let ((ov (make-overlay start end
)))
8784 (overlay-put ov
'display image
)
8785 (overlay-put ov
'face
'default
)
8786 (push ov markdown-inline-image-overlays
)))))))))))
8788 (defun markdown-toggle-inline-images ()
8789 "Toggle inline image overlays in the buffer."
8791 (if markdown-inline-image-overlays
8792 (markdown-remove-inline-images)
8793 (markdown-display-inline-images)))
8796 ;;; GFM Code Block Fontification ==============================================
8798 (defcustom markdown-fontify-code-blocks-natively nil
8799 "When non-nil, fontify code in code blocks using the native major mode.
8800 This only works for fenced code blocks where the language is
8801 specified where we can automatically determine the appropriate
8802 mode to use. The language to mode mapping may be customized by
8803 setting the variable `markdown-code-lang-modes'."
8807 :package-version
'(markdown-mode .
"2.3"))
8809 (defcustom markdown-fontify-code-block-default-mode nil
8810 "Default mode to use to fontify code blocks.
8811 This mode is used when automatic detection fails, such as for GFM
8812 code blocks with no language specified."
8814 :type
'(choice function
(const :tag
"None" nil
))
8815 :package-version
'(markdown-mode .
"2.4"))
8817 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg
)
8818 "Toggle the native fontification of code blocks.
8819 With a prefix argument ARG, enable if ARG is positive,
8820 and disable otherwise."
8821 (interactive (list (or current-prefix-arg
'toggle
)))
8822 (setq markdown-fontify-code-blocks-natively
8823 (if (eq arg
'toggle
)
8824 (not markdown-fontify-code-blocks-natively
)
8825 (> (prefix-numeric-value arg
) 0)))
8826 (if markdown-fontify-code-blocks-natively
8827 (message "markdown-mode native code block fontification enabled")
8828 (message "markdown-mode native code block fontification disabled"))
8829 (markdown-reload-extensions))
8831 ;; This is based on `org-src-lang-modes' from org-src.el
8832 (defcustom markdown-code-lang-modes
8833 '(("ocaml" . tuareg-mode
) ("elisp" . emacs-lisp-mode
) ("ditaa" . artist-mode
)
8834 ("asymptote" . asy-mode
) ("dot" . fundamental-mode
) ("sqlite" . sql-mode
)
8835 ("calc" . fundamental-mode
) ("C" . c-mode
) ("cpp" . c
++-mode
)
8836 ("C++" . c
++-mode
) ("screen" . shell-script-mode
) ("shell" . sh-mode
)
8838 "Alist mapping languages to their major mode.
8839 The key is the language name, the value is the major mode. For
8840 many languages this is simple, but for language where this is not
8841 the case, this variable provides a way to simplify things on the
8842 user side. For example, there is no ocaml-mode in Emacs, but the
8843 mode to use is `tuareg-mode'."
8847 (string "Language name")
8848 (symbol "Major mode")))
8849 :package-version
'(markdown-mode .
"2.3"))
8851 (defun markdown-get-lang-mode (lang)
8852 "Return major mode that should be used for LANG.
8853 LANG is a string, and the returned major mode is a symbol."
8855 #'markdown--lang-mode-predicate
8856 (nconc (list (cdr (assoc lang markdown-code-lang-modes
))
8857 (cdr (assoc (downcase lang
) markdown-code-lang-modes
)))
8858 (and (fboundp 'treesit-language-available-p
)
8859 (list (and (treesit-language-available-p (intern lang
))
8860 (intern (concat lang
"-ts-mode")))
8861 (and (treesit-language-available-p (intern (downcase lang
)))
8862 (intern (concat (downcase lang
) "-ts-mode")))))
8864 (intern (concat lang
"-mode"))
8865 (intern (concat (downcase lang
) "-mode"))))))
8867 (defun markdown--lang-mode-predicate (mode)
8871 ;; https://github.com/jrblevin/markdown-mode/issues/787
8872 ;; major-mode-remap-alist was introduced at Emacs 29.1
8873 (cl-loop for pair in
(bound-and-true-p major-mode-remap-alist
)
8874 for func
= (cdr pair
)
8875 thereis
(and (atom func
) (eq mode func
)))
8876 ;; https://github.com/jrblevin/markdown-mode/issues/761
8877 (cl-loop for pair in auto-mode-alist
8878 for func
= (cdr pair
)
8879 thereis
(and (atom func
) (eq mode func
))))))
8881 (defun markdown-fontify-code-blocks-generic (matcher last
)
8882 "Add text properties to next code block from point to LAST.
8883 Use matching function MATCHER."
8884 (when (funcall matcher last
)
8887 (let* ((start (match-beginning 0))
8889 ;; Find positions outside opening and closing backquotes.
8890 (bol-prev (progn (goto-char start
)
8891 (if (bolp) (line-beginning-position 0) (line-beginning-position))))
8892 (eol-next (progn (goto-char end
)
8893 (if (bolp) (line-beginning-position 2) (line-beginning-position 3))))
8895 (if (and markdown-fontify-code-blocks-natively
8896 (or (setq lang
(markdown-code-block-lang))
8897 markdown-fontify-code-block-default-mode
))
8898 (markdown-fontify-code-block-natively lang start end
)
8899 (add-text-properties start end
'(face markdown-pre-face
)))
8900 ;; Set background for block as well as opening and closing lines.
8901 (font-lock-append-text-property
8902 bol-prev eol-next
'face
'markdown-code-face
)
8903 ;; Set invisible property for lines before and after, including newline.
8904 (add-text-properties bol-prev start
'(invisible markdown-markup
))
8905 (add-text-properties end eol-next
'(invisible markdown-markup
)))))
8908 (defun markdown-fontify-gfm-code-blocks (last)
8909 "Add text properties to next GFM code block from point to LAST."
8910 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last
))
8912 (defun markdown-fontify-fenced-code-blocks (last)
8913 "Add text properties to next tilde fenced code block from point to LAST."
8914 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last
))
8916 ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
8917 (defun markdown-fontify-code-block-natively (lang start end
)
8918 "Fontify given GFM or fenced code block.
8919 This function is called by Emacs for automatic fontification when
8920 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
8921 language used in the block. START and END specify the block
8923 (let ((lang-mode (if lang
(markdown-get-lang-mode lang
)
8924 markdown-fontify-code-block-default-mode
)))
8925 (when (fboundp lang-mode
)
8926 (let ((string (buffer-substring-no-properties start end
))
8927 (modified (buffer-modified-p))
8928 (markdown-buffer (current-buffer)) pos next
)
8929 (remove-text-properties start end
'(face nil
))
8930 (with-current-buffer
8932 (concat " markdown-code-fontification:" (symbol-name lang-mode
)))
8933 ;; Make sure that modification hooks are not inhibited in
8934 ;; the org-src-fontification buffer in case we're called
8935 ;; from `jit-lock-function' (Bug#25132).
8936 (let ((inhibit-modification-hooks nil
))
8937 (delete-region (point-min) (point-max))
8938 (insert string
" ")) ;; so there's a final property change
8939 (unless (eq major-mode lang-mode
) (funcall lang-mode
))
8941 (setq pos
(point-min))
8942 (while (setq next
(next-single-property-change pos
'face
))
8943 (let ((val (get-text-property pos
'face
)))
8946 (+ start
(1- pos
)) (1- (+ start next
)) 'face
8947 val markdown-buffer
)))
8949 (add-text-properties
8951 '(font-lock-fontified t fontified t font-lock-multiline t
))
8952 (set-buffer-modified-p modified
)))))
8954 (require 'edit-indirect nil t
)
8955 (defvar edit-indirect-guess-mode-function
)
8956 (defvar edit-indirect-after-commit-functions
)
8958 (defun markdown--edit-indirect-after-commit-function (beg end
)
8959 "Corrective logic run on code block content from lines BEG to END.
8960 Restores code block indentation from BEG to END, and ensures trailing newlines
8961 at the END of code blocks."
8962 ;; ensure trailing newlines
8964 (unless (eq (char-before) ?
\n)
8966 ;; restore code block indentation
8967 (goto-char (- beg
1))
8968 (let ((block-indentation (current-indentation)))
8969 (when (> block-indentation
0)
8970 (indent-rigidly beg end block-indentation
)))
8973 (defun markdown-edit-code-block ()
8974 "Edit Markdown code block in an indirect buffer."
8977 (if (fboundp 'edit-indirect-region
)
8978 (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
8979 (begin (and bounds
(not (null (nth 0 bounds
))) (goto-char (nth 0 bounds
)) (line-beginning-position 2)))
8980 (end (and bounds
(not (null (nth 1 bounds
))) (goto-char (nth 1 bounds
)) (line-beginning-position 1))))
8982 (let* ((indentation (and (goto-char (nth 0 bounds
)) (current-indentation)))
8983 (lang (markdown-code-block-lang))
8984 (mode (or (and lang
(markdown-get-lang-mode lang
))
8985 markdown-edit-code-block-default-mode
))
8986 (edit-indirect-guess-mode-function
8987 (lambda (_parent-buffer _beg _end
)
8989 (indirect-buf (edit-indirect-region begin end
'display-buffer
)))
8990 ;; reset `sh-shell' when indirect buffer
8991 (when (and (not (member system-type
'(ms-dos windows-nt
)))
8992 (member mode
'(shell-script-mode sh-mode
))
8993 (member lang
(append
8994 (mapcar (lambda (e) (symbol-name (car e
)))
8996 '("csh" "rc" "sh"))))
8997 (with-current-buffer indirect-buf
8998 (sh-set-shell lang
)))
8999 (when (> indentation
0) ;; un-indent in edit-indirect buffer
9000 (with-current-buffer indirect-buf
9001 (indent-rigidly (point-min) (point-max) (- indentation
)))))
9002 (user-error "Not inside a GFM or tilde fenced code block")))
9003 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
9004 (progn (package-refresh-contents)
9005 (package-install 'edit-indirect
)
9006 (markdown-edit-code-block))))))
9009 ;;; Table Editing =============================================================
9011 ;; These functions were originally adapted from `org-table.el'.
9013 ;; General helper functions
9015 (defmacro markdown--with-gensyms
(symbols &rest body
)
9016 (declare (debug (sexp body
)) (indent 1))
9017 `(let ,(mapcar (lambda (s)
9018 `(,s
(make-symbol (concat "--" (symbol-name ',s
)))))
9022 (defun markdown--split-string (string &optional separators
)
9023 "Splits STRING into substrings at SEPARATORS.
9024 SEPARATORS is a regular expression. If nil it defaults to
9025 `split-string-default-separators'. This version returns no empty
9026 strings if there are matches at the beginning and end of string."
9027 (let ((start 0) notfirst list
)
9028 (while (and (string-match
9029 (or separators split-string-default-separators
)
9032 (= start
(match-beginning 0))
9033 (< start
(length string
)))
9035 (< (match-beginning 0) (length string
)))
9037 (or (eq (match-beginning 0) 0)
9038 (and (eq (match-beginning 0) (match-end 0))
9039 (eq (match-beginning 0) start
))
9040 (push (substring string start
(match-beginning 0)) list
))
9041 (setq start
(match-end 0)))
9042 (or (eq start
(length string
))
9043 (push (substring string start
) list
))
9046 (defun markdown--string-width (s)
9047 "Return width of string S.
9048 This version ignores characters with invisibility property
9051 (when (or (eq t buffer-invisibility-spec
)
9052 (member 'markdown-markup buffer-invisibility-spec
))
9053 (while (setq b
(text-property-any
9055 'invisible
'markdown-markup s
))
9058 (substring s
(or (next-single-property-change
9063 (defun markdown--remove-invisible-markup (s)
9064 "Remove Markdown markup from string S.
9065 This version removes characters with invisibility property
9068 (while (setq b
(text-property-any
9070 'invisible
'markdown-markup s
))
9073 (substring s
(or (next-single-property-change
9078 ;; Functions for maintaining tables
9080 (defvar markdown-table-at-point-p-function
#'markdown--table-at-point-p
9081 "Function to decide if point is inside a table.
9083 The indirection serves to differentiate between standard markdown
9084 tables and gfm tables which are less strict about the markup.")
9086 (defconst markdown-table-line-regexp
"^[ \t]*|"
9087 "Regexp matching any line inside a table.")
9089 (defconst markdown-table-hline-regexp
"^[ \t]*|[-:]"
9090 "Regexp matching hline inside a table.")
9092 (defconst markdown-table-dline-regexp
"^[ \t]*|[^-:]"
9093 "Regexp matching dline inside a table.")
9095 (defun markdown-table-at-point-p ()
9096 "Return non-nil when point is inside a table."
9097 (funcall markdown-table-at-point-p-function
))
9099 (defun markdown--table-at-point-p ()
9100 "Return non-nil when point is inside a table."
9103 (and (looking-at-p markdown-table-line-regexp
)
9104 (not (markdown-code-block-at-point-p)))))
9106 (defconst gfm-table-line-regexp
"^.?*|"
9107 "Regexp matching any line inside a table.")
9109 (defconst gfm-table-hline-regexp
"^-+\\(|-\\)+"
9110 "Regexp matching hline inside a table.")
9112 ;; GFM simplified tables syntax is as follows:
9113 ;; - A header line for the column names, this is any text
9114 ;; separated by `|'.
9115 ;; - Followed by a string -|-|- ..., the number of dashes is optional
9116 ;; but must be higher than 1. The number of separators should match
9117 ;; the number of columns.
9118 ;; - Followed by the rows of data, which has the same format as the
9126 (defun gfm--table-at-point-p ()
9127 "Return non-nil when point is inside a gfm-compatible table."
9128 (or (markdown--table-at-point-p)
9131 (when (looking-at-p gfm-table-line-regexp
)
9132 ;; we might be at the first line of the table, check if the
9133 ;; line below is the hline
9136 (looking-at-p gfm-table-hline-regexp
))
9137 ;; go up to find the header
9139 (while (looking-at-p gfm-table-line-regexp
)
9141 ((looking-at-p gfm-table-hline-regexp
)
9148 (defun markdown-table-hline-at-point-p ()
9149 "Return non-nil when point is on a hline in a table.
9150 This function assumes point is on a table."
9153 (looking-at-p markdown-table-hline-regexp
)))
9155 (defun markdown-table-begin ()
9156 "Find the beginning of the table and return its position.
9157 This function assumes point is on a table."
9159 (while (and (not (bobp))
9160 (markdown-table-at-point-p))
9163 (markdown-table-at-point-p))
9167 (defun markdown-table-end ()
9168 "Find the end of the table and return its position.
9169 This function assumes point is on a table."
9171 (while (and (not (eobp))
9172 (markdown-table-at-point-p))
9176 (defun markdown-table-get-dline ()
9177 "Return index of the table data line at point.
9178 This function assumes point is on a table."
9179 (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
9181 (goto-char (markdown-table-begin))
9182 (while (and (re-search-forward
9183 markdown-table-dline-regexp end t
)
9185 (< (line-end-position) pos
))))
9188 (defun markdown--thing-at-wiki-link (pos)
9189 (when markdown-enable-wiki-links
9193 (thing-at-point-looking-at markdown-regex-wiki-link
)))))
9195 (defun markdown-table-get-column ()
9196 "Return table column at point.
9197 This function assumes point is on a table."
9198 (let ((pos (point)) (cnt 0))
9201 (while (search-forward "|" pos t
)
9202 (when (and (not (looking-back "\\\\|" (line-beginning-position)))
9203 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9204 (setq cnt
(1+ cnt
)))))
9207 (defun markdown-table-get-cell (&optional n
)
9208 "Return the content of the cell in column N of current row.
9209 N defaults to column at point. This function assumes point is on
9211 (and n
(markdown-table-goto-column n
))
9212 (skip-chars-backward "^|\n") (backward-char 1)
9213 (if (looking-at "|[^|\r\n]*")
9214 (let* ((pos (match-beginning 0))
9215 (val (buffer-substring (1+ pos
) (match-end 0))))
9216 (goto-char (min (line-end-position) (+ 2 pos
)))
9218 (setq val
(replace-regexp-in-string "\\`[ \t]+" "" val
)
9219 val
(replace-regexp-in-string "[ \t]+\\'" "" val
)))
9220 (forward-char 1) ""))
9222 (defun markdown-table-goto-dline (n)
9223 "Go to the Nth data line in the table at point.
9224 Return t when the line exists, nil otherwise. This function
9225 assumes point is on a table."
9226 (goto-char (markdown-table-begin))
9227 (let ((end (markdown-table-end)) (cnt 0))
9228 (while (and (re-search-forward
9229 markdown-table-dline-regexp end t
)
9230 (< (setq cnt
(1+ cnt
)) n
)))
9233 (defun markdown-table-goto-column (n &optional on-delim
)
9234 "Go to the Nth column in the table line at point.
9235 With optional argument ON-DELIM, stop with point before the left
9236 delimiter of the cell. If there are less than N cells, just go
9237 beyond the last delimiter. This function assumes point is on a
9239 (beginning-of-line 1)
9241 (while (and (> n
0) (search-forward "|" (line-end-position) t
))
9242 (when (and (not (looking-back "\\\\|" (line-beginning-position)))
9243 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9247 (when (looking-at " ") (forward-char 1)))))
9249 (defmacro markdown-table-save-cell
(&rest body
)
9250 "Save cell at point, execute BODY and restore cell.
9251 This function assumes point is on a table."
9252 (declare (debug (body)))
9253 (markdown--with-gensyms (line column
)
9254 `(let ((,line
(copy-marker (line-beginning-position)))
9255 (,column
(markdown-table-get-column)))
9259 (markdown-table-goto-column ,column
)
9260 (set-marker ,line nil
)))))
9262 (defun markdown-table-blank-line (s)
9263 "Convert a table line S into a line with blank cells."
9264 (if (string-match "^[ \t]*|-" s
)
9266 (lambda (x) (if (member x
'(?| ?
+)) "|" " "))
9270 (goto-char (point-min))
9271 (when (re-search-forward "|" nil t
)
9274 (while (re-search-forward "|" nil t
)
9275 (when (and (not (eql (char-before (match-beginning 0)) ?
\\))
9276 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9277 (push (make-string (- (match-beginning 0) cur
) ?
) ret
)
9278 (setq cur
(match-end 0))))
9279 (format "|%s|" (string-join (nreverse ret
) "|")))))))
9281 (defun markdown-table-colfmt (fmtspec)
9282 "Process column alignment specifier FMTSPEC for tables."
9283 (when (stringp fmtspec
)
9285 (cond ((string-match-p "^:.*:$" x
) 'c
)
9286 ((string-match-p "^:" x
) 'l
)
9287 ((string-match-p ":$" x
) 'r
)
9289 (markdown--split-string fmtspec
"\\s-*|\\s-*"))))
9291 (defun markdown--first-column-p (bar-pos)
9295 (looking-back "^\\s-*" (line-beginning-position)))))
9297 (defun markdown--table-line-to-columns (line)
9300 (goto-char (point-min))
9303 (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t
)
9304 (if (markdown--first-column-p (match-beginning 1))
9305 (setq cur
(match-end 0))
9306 (cond ((eql (char-before (match-beginning 1)) ?
\\)
9308 (goto-char (match-end 1)))
9309 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing
9311 (push (buffer-substring-no-properties cur
(match-beginning 0)) ret
)
9312 (setq cur
(match-end 0))))))
9313 (when (< cur
(length line
))
9314 (push (buffer-substring-no-properties cur
(point-max)) ret
))
9317 (defsubst markdown--is-delimiter-row
(line)
9318 (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line
)
9319 (cl-loop for c across line
9320 always
(member c
'(?| ?- ?
: ?
\t ?
)))))
9322 (defun markdown-table-align ()
9323 "Align table at point.
9324 This function assumes point is on a table."
9326 (let ((begin (markdown-table-begin))
9327 (end (copy-marker (markdown-table-end))))
9328 (markdown-table-save-cell
9331 ;; Store table indent
9332 (indent (progn (looking-at "[ \t]*") (match-string 0)))
9333 ;; Split table in lines and save column format specifier
9334 (lines (mapcar (lambda (line)
9335 (if (markdown--is-delimiter-row line
)
9336 (progn (setq fmtspec
(or fmtspec line
)) nil
)
9338 (markdown--split-string (buffer-substring begin end
) "\n")))
9339 ;; Split lines in cells
9340 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l
))
9342 ;; Calculate maximum number of cells in a line
9344 (apply #'max
(mapcar #'length cells
))
9345 (user-error "Empty table")))
9346 ;; Empty cells to fill short lines
9347 (emptycells (make-list maxcells
""))
9349 ;; Calculate maximum width for each column
9350 (dotimes (i maxcells
)
9351 (let ((column (mapcar (lambda (x) (or (nth i x
) "")) cells
)))
9352 (push (apply #'max
1 (mapcar #'markdown--string-width column
))
9354 (setq maxwidths
(nreverse maxwidths
))
9355 ;; Process column format specifier
9356 (setq fmtspec
(markdown-table-colfmt fmtspec
))
9357 ;; Compute formats needed for output of table lines
9358 (let ((hfmt (concat indent
"|"))
9359 (rfmt (concat indent
"|"))
9361 (dolist (width maxwidths
(setq hfmt
(concat (substring hfmt
0 -
1) "|")))
9362 (setq fmt
(pop fmtspec
))
9363 (cond ((equal fmt
'l
) (setq hfmt1
":%s-|" rfmt1
" %%-%ds |"))
9364 ((equal fmt
'r
) (setq hfmt1
"-%s:|" rfmt1
" %%%ds |"))
9365 ((equal fmt
'c
) (setq hfmt1
":%s:|" rfmt1
" %%-%ds |"))
9366 (t (setq hfmt1
"-%s-|" rfmt1
" %%-%ds |")))
9367 (setq rfmt
(concat rfmt
(format rfmt1 width
)))
9368 (setq hfmt
(concat hfmt
(format hfmt1
(make-string width ?-
)))))
9369 ;; Replace modified lines only
9370 (dolist (line lines
)
9371 (let ((line (if line
9372 (apply #'format rfmt
(append (pop cells
) emptycells
))
9374 (previous (buffer-substring (point) (line-end-position))))
9375 (if (equal previous line
)
9378 (delete-region (point) (line-beginning-position 2))))))
9379 (set-marker end nil
)))))
9381 (defun markdown-table-insert-row (&optional arg
)
9382 "Insert a new row above the row at point into the table.
9383 With optional argument ARG, insert below the current row."
9385 (unless (markdown-table-at-point-p)
9386 (user-error "Not at a table"))
9387 (let* ((line (buffer-substring
9388 (line-beginning-position) (line-end-position)))
9389 (new (markdown-table-blank-line line
)))
9390 (beginning-of-line (if arg
2 1))
9391 (unless (bolp) (insert "\n"))
9392 (insert-before-markers new
"\n")
9393 (beginning-of-line 0)
9394 (re-search-forward "| ?" (line-end-position) t
)))
9396 (defun markdown-table-delete-row ()
9397 "Delete row or horizontal line at point from the table."
9399 (unless (markdown-table-at-point-p)
9400 (user-error "Not at a table"))
9401 (let ((col (current-column)))
9402 (kill-region (line-beginning-position)
9403 (min (1+ (line-end-position)) (point-max)))
9404 (unless (markdown-table-at-point-p) (beginning-of-line 0))
9405 (move-to-column col
)))
9407 (defun markdown-table-move-row (&optional up
)
9408 "Move table line at point down.
9409 With optional argument UP, move it up."
9411 (unless (markdown-table-at-point-p)
9412 (user-error "Not at a table"))
9413 (let* ((col (current-column)) (pos (point))
9414 (tonew (if up
0 2)) txt
)
9415 (beginning-of-line tonew
)
9416 (unless (markdown-table-at-point-p)
9417 (goto-char pos
) (user-error "Cannot move row further"))
9418 (goto-char pos
) (beginning-of-line 1) (setq pos
(point))
9419 (setq txt
(buffer-substring (point) (1+ (line-end-position))))
9420 (delete-region (point) (1+ (line-end-position)))
9421 (beginning-of-line tonew
)
9422 (insert txt
) (beginning-of-line 0)
9423 (move-to-column col
)))
9425 (defun markdown-table-move-row-up ()
9426 "Move table row at point up."
9428 (markdown-table-move-row 'up
))
9430 (defun markdown-table-move-row-down ()
9431 "Move table row at point down."
9433 (markdown-table-move-row nil
))
9435 (defun markdown-table-insert-column ()
9436 "Insert a new table column."
9438 (unless (markdown-table-at-point-p)
9439 (user-error "Not at a table"))
9440 (let* ((col (max 1 (markdown-table-get-column)))
9441 (begin (markdown-table-begin))
9442 (end (copy-marker (markdown-table-end))))
9443 (markdown-table-save-cell
9445 (while (< (point) end
)
9446 (markdown-table-goto-column col t
)
9447 (if (markdown-table-hline-at-point-p)
9451 (set-marker end nil
)
9452 (when markdown-table-align-p
9453 (markdown-table-align))))
9455 (defun markdown-table-delete-column ()
9456 "Delete column at point from table."
9458 (unless (markdown-table-at-point-p)
9459 (user-error "Not at a table"))
9460 (let ((col (markdown-table-get-column))
9461 (begin (markdown-table-begin))
9462 (end (copy-marker (markdown-table-end))))
9463 (markdown-table-save-cell
9465 (while (< (point) end
)
9466 (markdown-table-goto-column col t
)
9467 (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|")
9468 (replace-match "|"))
9470 (set-marker end nil
)
9471 (markdown-table-goto-column (max 1 (1- col
)))
9472 (when markdown-table-align-p
9473 (markdown-table-align))))
9475 (defun markdown-table-move-column (&optional left
)
9476 "Move table column at point to the right.
9477 With optional argument LEFT, move it to the left."
9479 (unless (markdown-table-at-point-p)
9480 (user-error "Not at a table"))
9481 (let* ((col (markdown-table-get-column))
9482 (col1 (if left
(1- col
) col
))
9483 (colpos (if left
(1- col
) (1+ col
)))
9484 (begin (markdown-table-begin))
9485 (end (copy-marker (markdown-table-end))))
9486 (when (and left
(= col
1))
9487 (user-error "Cannot move column further left"))
9488 (when (and (not left
) (looking-at "[^|\n]*|[^|\n]*$"))
9489 (user-error "Cannot move column further right"))
9490 (markdown-table-save-cell
9492 (while (< (point) end
)
9493 (markdown-table-goto-column col1 t
)
9494 (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|")
9495 (replace-match "|\\2|\\1|"))
9497 (set-marker end nil
)
9498 (markdown-table-goto-column colpos
)
9499 (when markdown-table-align-p
9500 (markdown-table-align))))
9502 (defun markdown-table-move-column-left ()
9503 "Move table column at point to the left."
9505 (markdown-table-move-column 'left
))
9507 (defun markdown-table-move-column-right ()
9508 "Move table column at point to the right."
9510 (markdown-table-move-column nil
))
9512 (defun markdown-table-next-row ()
9513 "Go to the next row (same column) in the table.
9514 Create new table lines if required."
9516 (unless (markdown-table-at-point-p)
9517 (user-error "Not at a table"))
9518 (if (or (looking-at "[ \t]*$")
9519 (save-excursion (skip-chars-backward " \t") (bolp)))
9521 (when markdown-table-align-p
9522 (markdown-table-align))
9523 (let ((col (markdown-table-get-column)))
9524 (beginning-of-line 2)
9525 (if (or (not (markdown-table-at-point-p))
9526 (markdown-table-hline-at-point-p))
9528 (beginning-of-line 0)
9529 (markdown-table-insert-row 'below
)))
9530 (markdown-table-goto-column col
)
9531 (skip-chars-backward "^|\n\r")
9532 (when (looking-at " ") (forward-char 1)))))
9534 (defun markdown-table-forward-cell ()
9535 "Go to the next cell in the table.
9536 Create new table lines if required."
9538 (unless (markdown-table-at-point-p)
9539 (user-error "Not at a table"))
9540 (when markdown-table-align-p
9541 (markdown-table-align))
9542 (let ((end (markdown-table-end)))
9543 (when (markdown-table-hline-at-point-p) (end-of-line 1))
9546 (re-search-forward "\\(?:^\\|[^\\]\\)|" end
)
9547 (when (looking-at "[ \t]*$")
9548 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end
))
9549 (when (and (looking-at "[-:]")
9550 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t
))
9551 (goto-char (match-beginning 1)))
9552 (if (looking-at "[-:]")
9554 (beginning-of-line 0)
9555 (markdown-table-insert-row 'below
))
9556 (when (looking-at " ") (forward-char 1))))
9557 (error (markdown-table-insert-row 'below
)))))
9559 (defun markdown-table-backward-cell ()
9560 "Go to the previous cell in the table."
9562 (unless (markdown-table-at-point-p)
9563 (user-error "Not at a table"))
9564 (when markdown-table-align-p
9565 (markdown-table-align))
9566 (when (markdown-table-hline-at-point-p) (beginning-of-line 1))
9569 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))
9570 ;; When this function is called while in the first cell in a
9571 ;; table, the point will now be at the beginning of a line. In
9572 ;; this case, we need to move past one additional table
9573 ;; boundary, the end of the table on the previous line.
9574 (when (= (point) (line-beginning-position))
9575 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
9576 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
9577 (error (user-error "Cannot move to previous table cell")))
9578 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0)))
9580 ;; This may have dropped point on the hline.
9581 (when (markdown-table-hline-at-point-p)
9582 (markdown-table-backward-cell)))
9584 (defun markdown-table-transpose ()
9585 "Transpose table at point.
9586 Horizontal separator lines will be eliminated."
9588 (unless (markdown-table-at-point-p)
9589 (user-error "Not at a table"))
9590 (let* ((table (buffer-substring-no-properties
9591 (markdown-table-begin) (markdown-table-end)))
9592 ;; Convert table to Lisp structure
9596 (unless (string-match-p
9597 markdown-table-hline-regexp x
)
9598 (markdown--table-line-to-columns x
)))
9599 (markdown--split-string table
"[ \t]*\n[ \t]*"))))
9600 (dline_old (markdown-table-get-dline))
9601 (col_old (markdown-table-get-column))
9602 (contents (mapcar (lambda (_)
9608 (setq tp
(cdr tp
))))
9611 (goto-char (markdown-table-begin))
9613 (re-search-forward "|") (backward-char)
9614 (delete-region (point) (markdown-table-end))
9617 (concat "| " (mapconcat 'identity x
" | " ) " |\n"))
9619 (markdown-table-goto-dline col_old
)
9620 (markdown-table-goto-column dline_old
))
9621 (when markdown-table-align-p
9622 (markdown-table-align)))
9624 (defun markdown-table-sort-lines (&optional sorting-type
)
9625 "Sort table lines according to the column at point.
9627 The position of point indicates the column to be used for
9628 sorting, and the range of lines is the range between the nearest
9629 horizontal separator lines, or the entire table of no such lines
9630 exist. If point is before the first column, user will be prompted
9631 for the sorting column. If there is an active region, the mark
9632 specifies the first line and the sorting column, while point
9633 should be in the last line to be included into the sorting.
9635 The command then prompts for the sorting type which can be
9636 alphabetically or numerically. Sorting in reverse order is also
9639 If SORTING-TYPE is specified when this function is called from a
9640 Lisp program, no prompting will take place. SORTING-TYPE must be
9641 a character, any of (?a ?A ?n ?N) where the capital letters
9642 indicate that sorting should be done in reverse order."
9644 (unless (markdown-table-at-point-p)
9645 (user-error "Not at a table"))
9646 ;; Set sorting type and column used for sorting
9647 (let ((column (let ((c (markdown-table-get-column)))
9649 ((called-interactively-p 'any
)
9650 (read-number "Use column N for sorting: "))
9656 ;; Emacs < 28 hides prompt message by another message. This erases it.
9658 (read-char-exclusive
9659 "Sort type: [a]lpha [n]umeric (A/N means reversed): ")))))
9661 ;; Narrow buffer to appropriate sorting area
9662 (if (region-active-p)
9666 (goto-char (region-beginning)) (line-beginning-position)))
9669 (goto-char (region-end)) (line-end-position))))
9670 (let ((start (markdown-table-begin))
9671 (end (markdown-table-end)))
9674 (if (re-search-backward
9675 markdown-table-hline-regexp start t
)
9676 (line-beginning-position 2)
9678 (if (save-excursion (re-search-forward
9679 markdown-table-hline-regexp end t
))
9682 ;; Determine arguments for `sort-subr'
9683 (let* ((extract-key-from-cell
9684 (cl-case sorting-type
9685 ((?a ?A
) #'markdown--remove-invisible-markup
) ;; #'identity)
9686 ((?n ?N
) #'string-to-number
)
9687 (t (user-error "Invalid sorting type: %c" sorting-type
))))
9689 (cl-case sorting-type
9691 ((?a ?A
) #'string
<))))
9692 ;; Sort selected area
9693 (goto-char (point-min))
9694 (sort-subr (memq sorting-type
'(?A ?N
))
9697 (while (and (not (eobp))
9699 markdown-table-dline-regexp
)))
9703 (funcall extract-key-from-cell
9704 (markdown-table-get-cell column
)))
9707 (goto-char (point-min))))))
9709 (defun markdown-table-convert-region (begin end
&optional separator
)
9710 "Convert region from BEGIN to END to table with SEPARATOR.
9712 If every line contains at least one TAB character, the function
9713 assumes that the material is tab separated (TSV). If every line
9714 contains a comma, comma-separated values (CSV) are assumed. If
9715 not, lines are split at whitespace into cells.
9717 You can use a prefix argument to force a specific separator:
9718 \\[universal-argument] once forces CSV, \\[universal-argument]
9719 twice forces TAB, and \\[universal-argument] three times will
9720 prompt for a regular expression to match the separator, and a
9721 numeric argument N indicates that at least N consecutive
9722 spaces, or alternatively a TAB should be used as the separator."
9724 (interactive "r\nP")
9725 (let* ((begin (min begin end
)) (end (max begin end
)) re
)
9726 (goto-char begin
) (beginning-of-line 1)
9727 (setq begin
(point-marker))
9729 (if (bolp) (backward-char 1) (end-of-line 1))
9730 (setq end
(point-marker))
9731 (when (equal separator
'(64))
9732 (setq separator
(read-regexp "Regexp for cell separator: ")))
9734 ;; Get the right cell separator
9738 ((not (re-search-forward "^[^\n\t]+$" end t
)) '(16))
9739 ((not (re-search-forward "^[^\n,]+$" end t
)) '(4))
9742 (if (equal separator
'(4))
9744 (while (< (point) end
)
9746 ((looking-at "^") (insert "| "))
9747 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
9748 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
9749 (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
9750 ((looking-at "[^,\n]+") (goto-char (match-end 0)))
9751 ((looking-at "[ \t]*,") (replace-match " | "))
9752 (t (beginning-of-line 2))))
9755 ((equal separator
'(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
9756 ((equal separator
'(16)) "^\\|\t")
9757 ((integerp separator
)
9759 (user-error "Cell separator must contain one or more spaces")
9760 (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator
)))
9761 ((stringp separator
) (format "^ *\\|%s" separator
))
9762 (t (error "Invalid cell separator"))))
9764 (while (and (not finish
) (re-search-forward re end t
))
9767 (replace-match "|" t t
)
9771 (replace-match "| " t t
)))))
9773 (when markdown-table-align-p
9774 (markdown-table-align))))
9776 (defun markdown-insert-table (&optional rows columns align
)
9777 "Insert an empty pipe table.
9778 Optional arguments ROWS, COLUMNS, and ALIGN specify number of
9779 rows and columns and the column alignment."
9781 (let* ((rows (or rows
(read-number "Number of Rows: ")))
9782 (columns (or columns
(read-number "Number of Columns: ")))
9783 (align (or align
(read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): ")))
9784 (align (cond ((equal align
"l") ":--")
9785 ((equal align
"r") "--:")
9786 ((equal align
"c") ":-:")
9789 (indent (make-string (current-column) ?\
))
9791 (apply 'concat indent
"|"
9792 (make-list columns
" |")) "\n"))
9793 (hline (apply 'concat indent
"|"
9794 (make-list columns
(concat align
"|")))))
9796 "^[ \t]*$" (buffer-substring-no-properties
9797 (line-beginning-position) (point)))
9798 (beginning-of-line 1)
9800 (dotimes (_ rows
) (insert line
))
9804 (end-of-line 1) (insert (concat "\n" hline
)) (goto-char pos
)))
9805 (markdown-table-forward-cell)))
9808 ;;; ElDoc Support =============================================================
9810 (defun markdown-eldoc-function (&rest _ignored
)
9811 "Return a helpful string when appropriate based on context.
9812 * Report URL when point is at a hidden URL.
9813 * Report language name when point is a code block with hidden markup."
9815 ;; Hidden URL or reference for inline link
9816 ((and (or (thing-at-point-looking-at markdown-regex-link-inline
)
9817 (thing-at-point-looking-at markdown-regex-link-reference
))
9818 (or markdown-hide-urls markdown-hide-markup
))
9819 (let* ((imagep (string-equal (match-string 1) "!"))
9820 (referencep (string-equal (match-string 5) "["))
9821 (link (match-string-no-properties 6))
9822 (edit-keys (markdown--substitute-command-keys
9824 "\\[markdown-insert-image]"
9825 "\\[markdown-insert-link]")))
9826 (edit-str (propertize edit-keys
'face
'font-lock-constant-face
))
9827 (object (if referencep
"reference" "URL")))
9828 (format "Hidden %s (%s to edit): %s" object edit-str
9831 (propertize "[" 'face
'markdown-markup-face
)
9832 (propertize link
'face
'markdown-reference-face
)
9833 (propertize "]" 'face
'markdown-markup-face
))
9834 (propertize link
'face
'markdown-url-face
)))))
9835 ;; Hidden language name for fenced code blocks
9836 ((and (markdown-code-block-at-point-p)
9837 (not (get-text-property (point) 'markdown-pre
))
9838 markdown-hide-markup
)
9839 (let ((lang (save-excursion (markdown-code-block-lang))))
9840 (unless lang
(setq lang
"[unspecified]"))
9841 (format "Hidden code block language: %s (%s to toggle markup)"
9842 (propertize lang
'face
'markdown-language-keyword-face
)
9843 (markdown--substitute-command-keys
9844 "\\[markdown-toggle-markup-hiding]"))))))
9846 (defun markdown--image-media-handler (mimetype data
)
9847 (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype
)))
9848 (filename (read-string "Insert filename for image: "))
9849 (link-text (read-string "Link text: "))
9850 (filepath (file-name-with-extension filename ext
))
9851 (dir (file-name-directory filepath
)))
9852 (when (and dir
(not (file-directory-p dir
)))
9853 (make-directory dir t
))
9854 (with-temp-file filepath
9856 (when (string-match-p "\\s-" filepath
)
9857 (setq filepath
(concat "<" filepath
">")))
9858 (markdown-insert-inline-image link-text filepath
)))
9860 (defun markdown--file-media-handler (_mimetype data
)
9861 (let* ((data (split-string data
"[\0\r\n]" t
"^file://"))
9863 (while (not (null files
))
9864 (let* ((file (url-unhex-string (car files
)))
9865 (file (file-relative-name file
))
9866 (prompt (format "Link text(%s): " (file-name-nondirectory file
)))
9867 (link-text (read-string prompt
)))
9868 (when (string-match-p "\\s-" file
)
9869 (setq file
(concat "<" file
">")))
9870 (markdown-insert-inline-image link-text file
)
9871 (when (not (null (cdr files
)))
9873 (setq files
(cdr files
))))))
9875 (defun markdown--dnd-local-file-handler (url _action
)
9878 (let* ((filename (dnd-get-local-file-name url
))
9879 (mimetype (mailcap-file-name-to-mime-type filename
))
9880 (file (file-relative-name filename
))
9881 (link-text "link text"))
9882 (when (string-match-p "\\s-" file
)
9883 (setq file
(concat "<" file
">")))
9884 (if (string-prefix-p "image/" mimetype
)
9885 (markdown-insert-inline-image link-text file
)
9886 (markdown-insert-inline-link link-text file
))))
9889 ;;; Mode Definition ==========================================================
9891 (defun markdown-show-version ()
9892 "Show the version number in the minibuffer."
9894 (message "markdown-mode, version %s" markdown-mode-version
))
9896 (defun markdown-mode-info ()
9897 "Open the `markdown-mode' homepage."
9899 (browse-url "https://jblevins.org/projects/markdown-mode/"))
9902 (define-derived-mode markdown-mode text-mode
"Markdown"
9903 "Major mode for editing Markdown files."
9904 (when buffer-read-only
9905 (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name)))
9906 (setq-local buffer-read-only nil
)))
9907 ;; Natural Markdown tab width
9910 (setq-local comment-start
"<!-- ")
9911 (setq-local comment-end
" -->")
9912 (setq-local comment-start-skip
"<!--[ \t]*")
9913 (setq-local comment-column
0)
9914 (setq-local comment-auto-fill-only-comments nil
)
9915 (setq-local comment-use-syntax t
)
9917 (setq-local sentence-end-base
"[.?!…‽][]\"'”’)}»›*_`~]*")
9919 (add-hook 'syntax-propertize-extend-region-functions
9920 #'markdown-syntax-propertize-extend-region nil t
)
9921 (add-hook 'jit-lock-after-change-extend-region-functions
9922 #'markdown-font-lock-extend-region-function t t
)
9923 (setq-local syntax-propertize-function
#'markdown-syntax-propertize
)
9924 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
9926 (setq font-lock-defaults
9927 '(markdown-mode-font-lock-keywords
9929 (font-lock-multiline . t
)
9930 (font-lock-syntactic-face-function . markdown-syntactic-face
)
9931 (font-lock-extra-managed-props
9932 .
(composition display invisible rear-nonsticky
9933 keymap help-echo mouse-face
))))
9934 (if markdown-hide-markup
9935 (add-to-invisibility-spec 'markdown-markup
)
9936 (remove-from-invisibility-spec 'markdown-markup
))
9938 (markdown-setup-wiki-link-hooks)
9940 (when markdown-enable-math
(markdown-toggle-math t
))
9941 ;; Add a buffer-local hook to reload after file-local variables are read
9942 (add-hook 'hack-local-variables-hook
#'markdown-handle-local-variables nil t
)
9943 ;; For imenu support
9944 (setq imenu-create-index-function
9945 (if markdown-nested-imenu-heading-index
9946 #'markdown-imenu-create-nested-index
9947 #'markdown-imenu-create-flat-index
))
9950 (setq-local beginning-of-defun-function
#'markdown-beginning-of-defun
)
9951 (setq-local end-of-defun-function
#'markdown-end-of-defun
)
9952 ;; Paragraph filling
9953 (setq-local fill-paragraph-function
#'markdown-fill-paragraph
)
9954 (setq-local paragraph-start
9955 ;; Should match start of lines that start or separate paragraphs
9956 (mapconcat #'identity
9958 "\f" ; starts with a literal line-feed
9959 "[ \t\f]*$" ; space-only line
9960 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9961 "[ \t]*[*+-][ \t]+" ; unordered list item
9962 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
9963 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
9964 "[ \t]*:[ \t]+" ; definition
9965 "^|" ; table or Pandoc line block
9968 (setq-local paragraph-separate
9969 ;; Should match lines that separate paragraphs without being
9970 ;; part of any paragraph:
9971 (mapconcat #'identity
9972 '("[ \t\f]*$" ; space-only line
9973 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9974 ;; The following is not ideal, but the Fill customization
9975 ;; options really only handle paragraph-starting prefixes,
9976 ;; not paragraph-ending suffixes:
9977 ".* $" ; line ending in two spaces
9979 "^\\(?: \\)?[-=]+[ \t]*$" ;; setext
9980 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
9982 (setq-local adaptive-fill-first-line-regexp
"\\`[ \t]*[A-Z]?>[ \t]*?\\'")
9983 (setq-local adaptive-fill-regexp
"\\s-*")
9984 (setq-local adaptive-fill-function
#'markdown-adaptive-fill-function
)
9985 (setq-local fill-forward-paragraph-function
#'markdown-fill-forward-paragraph
)
9987 (setq-local outline-regexp markdown-regex-header
)
9988 (setq-local outline-level
#'markdown-outline-level
)
9989 ;; Cause use of ellipses for invisible text.
9990 (add-to-invisibility-spec '(outline . t
))
9992 (if (boundp 'eldoc-documentation-functions
)
9993 (add-hook 'eldoc-documentation-functions
#'markdown-eldoc-function nil t
)
9994 (add-function :before-until
(local 'eldoc-documentation-function
)
9995 #'markdown-eldoc-function
))
9996 ;; Inhibiting line-breaking:
9997 ;; Separating out each condition into a separate function so that users can
9998 ;; override if desired (with remove-hook)
9999 (add-hook 'fill-nobreak-predicate
10000 #'markdown-line-is-reference-definition-p nil t
)
10001 (add-hook 'fill-nobreak-predicate
10002 #'markdown-pipe-at-bol-p nil t
)
10005 (setq-local indent-line-function markdown-indent-function
)
10006 (setq-local indent-region-function
#'markdown--indent-region
)
10009 (setq-local flyspell-generic-check-word-predicate
10010 #'markdown-flyspell-check-word-p
)
10012 ;; Electric quoting
10013 (add-hook 'electric-quote-inhibit-functions
10014 #'markdown--inhibit-electric-quote nil
:local
)
10016 ;; drag and drop handler
10017 (setq-local dnd-protocol-alist
(cons '("^file:///" . markdown--dnd-local-file-handler
)
10018 dnd-protocol-alist
))
10021 (when (version< "29" emacs-version
)
10022 (yank-media-handler "image/.*" #'markdown--image-media-handler
)
10023 ;; TODO support other than GNOME, like KDE etc
10024 (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler
))
10026 ;; Make checkboxes buttons
10027 (when markdown-make-gfm-checkboxes-buttons
10028 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
10029 (add-hook 'after-change-functions
#'markdown-gfm-checkbox-after-change-function t t
)
10030 (add-hook 'change-major-mode-hook
#'markdown-remove-gfm-checkbox-overlays t t
))
10033 (add-hook 'edit-indirect-after-commit-functions
10034 #'markdown--edit-indirect-after-commit-function
10037 ;; Marginalized headings
10038 (when markdown-marginalize-headers
10039 (add-hook 'window-configuration-change-hook
10040 #'markdown-marginalize-update-current nil t
))
10042 ;; add live preview export hook
10043 (add-hook 'after-save-hook
#'markdown-live-preview-if-markdown t t
)
10044 (add-hook 'kill-buffer-hook
#'markdown-live-preview-remove-on-kill t t
))
10047 (add-to-list 'auto-mode-alist
10048 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode
))
10051 ;;; GitHub Flavored Markdown Mode ============================================
10053 (defun gfm--electric-pair-fence-code-block ()
10054 (when (and electric-pair-mode
10055 (not markdown-gfm-use-electric-backquote
)
10056 (eql last-command-event ?
`)
10058 (while (eql (char-before (- (point) count
)) ?
`)
10061 (eql (char-after) ?
`))
10062 (save-excursion (insert (make-string 2 ?
`)))))
10064 (defvar gfm-mode-hook nil
10065 "Hook run when entering GFM mode.")
10068 (define-derived-mode gfm-mode markdown-mode
"GFM"
10069 "Major mode for editing GitHub Flavored Markdown files."
10070 (setq markdown-link-space-sub-char
"-")
10071 (setq markdown-wiki-link-search-subdirectories t
)
10072 (setq-local markdown-table-at-point-p-function
#'gfm--table-at-point-p
)
10073 (add-hook 'post-self-insert-hook
#'gfm--electric-pair-fence-code-block
'append t
)
10074 (markdown-gfm-parse-buffer-for-languages))
10077 ;;; Viewing modes =============================================================
10079 (defcustom markdown-hide-markup-in-view-modes t
10080 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
10085 (defvar markdown-view-mode-map
10086 (let ((map (make-sparse-keymap)))
10087 (define-key map
(kbd "p") #'markdown-outline-previous
)
10088 (define-key map
(kbd "n") #'markdown-outline-next
)
10089 (define-key map
(kbd "f") #'markdown-outline-next-same-level
)
10090 (define-key map
(kbd "b") #'markdown-outline-previous-same-level
)
10091 (define-key map
(kbd "u") #'markdown-outline-up
)
10092 (define-key map
(kbd "DEL") #'scroll-down-command
)
10093 (define-key map
(kbd "SPC") #'scroll-up-command
)
10094 (define-key map
(kbd ">") #'end-of-buffer
)
10095 (define-key map
(kbd "<") #'beginning-of-buffer
)
10096 (define-key map
(kbd "q") #'kill-this-buffer
)
10097 (define-key map
(kbd "?") #'describe-mode
)
10099 "Keymap for `markdown-view-mode'.")
10101 (defun markdown--filter-visible (beg end
&optional delete
)
10103 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face
)))
10105 (when (markdown--face-p beg invisible-faces
)
10107 (while (and (markdown--face-p beg invisible-faces
) (< beg end
))
10109 (let ((next (next-single-char-property-change beg
'invisible
)))
10110 (unless (get-char-property beg
'invisible
)
10111 (setq result
(concat result
(buffer-substring beg
(min end next
)))))
10115 (let ((inhibit-read-only t
))
10116 (delete-region beg end
))))))
10119 (define-derived-mode markdown-view-mode markdown-mode
"Markdown-View"
10120 "Major mode for viewing Markdown content."
10121 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes
)
10122 (add-to-invisibility-spec 'markdown-markup
)
10123 (setq-local filter-buffer-substring-function
#'markdown--filter-visible
)
10124 (read-only-mode 1))
10126 (defvar gfm-view-mode-map
10127 markdown-view-mode-map
10128 "Keymap for `gfm-view-mode'.")
10131 (define-derived-mode gfm-view-mode gfm-mode
"GFM-View"
10132 "Major mode for viewing GitHub Flavored Markdown content."
10133 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes
)
10134 (setq-local markdown-fontify-code-blocks-natively t
)
10135 (setq-local filter-buffer-substring-function
#'markdown--filter-visible
)
10136 (add-to-invisibility-spec 'markdown-markup
)
10137 (read-only-mode 1))
10140 ;;; Live Preview Mode ========================================================
10142 (define-minor-mode markdown-live-preview-mode
10143 "Toggle native previewing on save for a specific markdown file."
10144 :lighter
" MD-Preview"
10145 (if markdown-live-preview-mode
10146 (if (markdown-live-preview-get-filename)
10147 (markdown-display-buffer-other-window (markdown-live-preview-export))
10148 (markdown-live-preview-mode -
1)
10149 (user-error "Buffer %s does not visit a file" (current-buffer)))
10150 (markdown-live-preview-remove)))
10153 (provide 'markdown-mode
)
10155 ;; Local Variables:
10156 ;; indent-tabs-mode: nil
10159 ;;; markdown-mode.el ends here