Update markdown-table-align to allow tabs before a delimiter
[markdown-mode.git] / markdown-mode.el
blobaba9e6f5492162a8b4534bd2a9fc7a8ace23bbf0
1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2007-2020 Jason R. Blevins and markdown-mode
4 ;; contributors (see the commit log for details).
6 ;; Author: Jason R. Blevins <jblevins@xbeta.org>
7 ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org>
8 ;; Created: May 24, 2007
9 ;; Version: 2.5-dev
10 ;; Package-Requires: ((emacs "25.1"))
11 ;; Keywords: Markdown, GitHub Flavored Markdown, itex
12 ;; URL: https://jblevins.org/projects/markdown-mode/
14 ;; This file is not part of GNU Emacs.
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
29 ;;; Commentary:
31 ;; See the README.md file for details.
34 ;;; Code:
36 (require 'easymenu)
37 (require 'outline)
38 (require 'thingatpt)
39 (require 'cl-lib)
40 (require 'url-parse)
41 (require 'button)
42 (require 'color)
43 (require 'rx)
44 (require 'subr-x)
46 (defvar jit-lock-start)
47 (defvar jit-lock-end)
48 (defvar flyspell-generic-check-word-predicate)
49 (defvar electric-pair-pairs)
51 (declare-function project-roots "project")
54 ;;; Constants =================================================================
56 (defconst markdown-mode-version "2.5-dev"
57 "Markdown mode version number.")
59 (defconst markdown-output-buffer-name "*markdown-output*"
60 "Name of temporary buffer for markdown command output.")
63 ;;; Global Variables ==========================================================
65 (defvar markdown-reference-label-history nil
66 "History of used reference labels.")
68 (defvar markdown-live-preview-mode nil
69 "Sentinel variable for command `markdown-live-preview-mode'.")
71 (defvar markdown-gfm-language-history nil
72 "History list of languages used in the current buffer in GFM code blocks.")
75 ;;; Customizable Variables ====================================================
77 (defvar markdown-mode-hook nil
78 "Hook run when entering Markdown mode.")
80 (defvar markdown-before-export-hook nil
81 "Hook run before running Markdown to export XHTML output.
82 The hook may modify the buffer, which will be restored to it's
83 original state after exporting is complete.")
85 (defvar markdown-after-export-hook nil
86 "Hook run after XHTML output has been saved.
87 Any changes to the output buffer made by this hook will be saved.")
89 (defgroup markdown nil
90 "Major mode for editing text files in Markdown format."
91 :prefix "markdown-"
92 :group 'text
93 :link '(url-link "https://jblevins.org/projects/markdown-mode/"))
95 (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py")
96 when (executable-find cmd)
97 return (file-name-nondirectory it))))
98 (or command "markdown"))
99 "Command to run markdown."
100 :group 'markdown
101 :type '(choice (string :tag "Shell command") (repeat (string)) function))
103 (defcustom markdown-command-needs-filename nil
104 "Set to non-nil if `markdown-command' does not accept input from stdin.
105 Instead, it will be passed a filename as the final command line
106 option. As a result, you will only be able to run Markdown from
107 buffers which are visiting a file."
108 :group 'markdown
109 :type 'boolean)
111 (defcustom markdown-open-command nil
112 "Command used for opening Markdown files directly.
113 For example, a standalone Markdown previewer. This command will
114 be called with a single argument: the filename of the current
115 buffer. It can also be a function, which will be called without
116 arguments."
117 :group 'markdown
118 :type '(choice file function (const :tag "None" nil)))
120 (defcustom markdown-open-image-command nil
121 "Command used for opening image files directly.
122 This is used at `markdown-follow-link-at-point'."
123 :group 'markdown
124 :type '(choice file function (const :tag "None" nil)))
126 (defcustom markdown-hr-strings
127 '("-------------------------------------------------------------------------------"
128 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
129 "---------------------------------------"
130 "* * * * * * * * * * * * * * * * * * * *"
131 "---------"
132 "* * * * *")
133 "Strings to use when inserting horizontal rules.
134 The first string in the list will be the default when inserting a
135 horizontal rule. Strings should be listed in decreasing order of
136 prominence (as in headings from level one to six) for use with
137 promotion and demotion functions."
138 :group 'markdown
139 :type '(repeat string))
141 (defcustom markdown-bold-underscore nil
142 "Use two underscores when inserting bold text instead of two asterisks."
143 :group 'markdown
144 :type 'boolean)
146 (defcustom markdown-italic-underscore nil
147 "Use underscores when inserting italic text instead of asterisks."
148 :group 'markdown
149 :type 'boolean)
151 (defcustom markdown-marginalize-headers nil
152 "When non-nil, put opening atx header markup in a left margin.
154 This setting goes well with `markdown-asymmetric-header'. But
155 sadly it conflicts with `linum-mode' since they both use the
156 same margin."
157 :group 'markdown
158 :type 'boolean
159 :safe 'booleanp
160 :package-version '(markdown-mode . "2.4"))
162 (defcustom markdown-marginalize-headers-margin-width 6
163 "Character width of margin used for marginalized headers.
164 The default value is based on there being six heading levels
165 defined by Markdown and HTML. Increasing this produces extra
166 whitespace on the left. Decreasing it may be preferred when
167 fewer than six nested heading levels are used."
168 :group 'markdown
169 :type 'natnump
170 :safe 'natnump
171 :package-version '(markdown-mode . "2.4"))
173 (defcustom markdown-asymmetric-header nil
174 "Determines if atx header style will be asymmetric.
175 Set to a non-nil value to use asymmetric header styling, placing
176 header markup only at the beginning of the line. By default,
177 balanced markup will be inserted at the beginning and end of the
178 line around the header title."
179 :group 'markdown
180 :type 'boolean)
182 (defcustom markdown-indent-function 'markdown-indent-line
183 "Function to use to indent."
184 :group 'markdown
185 :type 'function)
187 (defcustom markdown-indent-on-enter t
188 "Determines indentation behavior when pressing \\[newline].
189 Possible settings are nil, t, and 'indent-and-new-item.
191 When non-nil, pressing \\[newline] will call `newline-and-indent'
192 to indent the following line according to the context using
193 `markdown-indent-function'. In this case, note that
194 \\[electric-newline-and-maybe-indent] can still be used to insert
195 a newline without indentation.
197 When set to 'indent-and-new-item and the point is in a list item
198 when \\[newline] is pressed, the list will be continued on the next
199 line, where a new item will be inserted.
201 When set to nil, simply call `newline' as usual. In this case,
202 you can still indent lines using \\[markdown-cycle] and continue
203 lists with \\[markdown-insert-list-item].
205 Note that this assumes the variable `electric-indent-mode' is
206 non-nil (enabled). When it is *disabled*, the behavior of
207 \\[newline] and `\\[electric-newline-and-maybe-indent]' are
208 reversed."
209 :group 'markdown
210 :type '(choice (const :tag "Don't automatically indent" nil)
211 (const :tag "Automatically indent" t)
212 (const :tag "Automatically indent and insert new list items" indent-and-new-item)))
214 (defcustom markdown-enable-wiki-links nil
215 "Syntax highlighting for wiki links.
216 Set this to a non-nil value to turn on wiki link support by default.
217 Support can be toggled later using the `markdown-toggle-wiki-links'
218 function or \\[markdown-toggle-wiki-links]."
219 :group 'markdown
220 :type 'boolean
221 :safe 'booleanp
222 :package-version '(markdown-mode . "2.2"))
224 (defcustom markdown-wiki-link-alias-first t
225 "When non-nil, treat aliased wiki links like [[alias text|PageName]].
226 Otherwise, they will be treated as [[PageName|alias text]]."
227 :group 'markdown
228 :type 'boolean
229 :safe 'booleanp)
231 (defcustom markdown-wiki-link-search-subdirectories nil
232 "When non-nil, search for wiki link targets in subdirectories.
233 This is the default search behavior for GitHub and is
234 automatically set to t in `gfm-mode'."
235 :group 'markdown
236 :type 'boolean
237 :safe 'booleanp
238 :package-version '(markdown-mode . "2.2"))
240 (defcustom markdown-wiki-link-search-parent-directories nil
241 "When non-nil, search for wiki link targets in parent directories.
242 This is the default search behavior of Ikiwiki."
243 :group 'markdown
244 :type 'boolean
245 :safe 'booleanp
246 :package-version '(markdown-mode . "2.2"))
248 (defcustom markdown-wiki-link-search-type nil
249 "Searching type for markdown wiki link.
251 sub-directories: search for wiki link targets in sub directories
252 parent-directories: search for wiki link targets in parent directories
253 project: search for wiki link targets under project root"
254 :group 'markdown
255 :type '(set
256 (const :tag "search wiki link from subdirectories" sub-directories)
257 (const :tag "search wiki link from parent directories" parent-directories)
258 (const :tag "search wiki link under project root" project))
259 :package-version '(markdown-mode . "2.5"))
261 (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5")
262 (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5")
264 (defcustom markdown-wiki-link-fontify-missing nil
265 "When non-nil, change wiki link face according to existence of target files.
266 This is expensive because it requires checking for the file each time the buffer
267 changes or the user switches windows. It is disabled by default because it may
268 cause lag when typing on slower machines."
269 :group 'markdown
270 :type 'boolean
271 :safe 'booleanp
272 :package-version '(markdown-mode . "2.2"))
274 (defcustom markdown-uri-types
275 '("acap" "cid" "data" "dav" "fax" "file" "ftp"
276 "gopher" "http" "https" "imap" "ldap" "mailto"
277 "mid" "message" "modem" "news" "nfs" "nntp"
278 "pop" "prospero" "rtsp" "service" "sip" "tel"
279 "telnet" "tip" "urn" "vemmi" "wais")
280 "Link types for syntax highlighting of URIs."
281 :group 'markdown
282 :type '(repeat (string :tag "URI scheme")))
284 (defcustom markdown-url-compose-char
285 '(?∞ ?… ?⋯ ?# ?★ ?⚓)
286 "Placeholder character for hidden URLs.
287 This may be a single character or a list of characters. In case
288 of a list, the first one that satisfies `char-displayable-p' will
289 be used."
290 :type '(choice
291 (character :tag "Single URL replacement character")
292 (repeat :tag "List of possible URL replacement characters"
293 character))
294 :package-version '(markdown-mode . "2.3"))
296 (defcustom markdown-blockquote-display-char
297 '("▌" "┃" ">")
298 "String to display when hiding blockquote markup.
299 This may be a single string or a list of string. In case of a
300 list, the first one that satisfies `char-displayable-p' will be
301 used."
302 :type 'string
303 :type '(choice
304 (string :tag "Single blockquote display string")
305 (repeat :tag "List of possible blockquote display strings" string))
306 :package-version '(markdown-mode . "2.3"))
308 (defcustom markdown-hr-display-char
309 '(?─ ?━ ?-)
310 "Character for hiding horizontal rule markup.
311 This may be a single character or a list of characters. In case
312 of a list, the first one that satisfies `char-displayable-p' will
313 be used."
314 :group 'markdown
315 :type '(choice
316 (character :tag "Single HR display character")
317 (repeat :tag "List of possible HR display characters" character))
318 :package-version '(markdown-mode . "2.3"))
320 (defcustom markdown-definition-display-char
321 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:)
322 "Character for replacing definition list markup.
323 This may be a single character or a list of characters. In case
324 of a list, the first one that satisfies `char-displayable-p' will
325 be used."
326 :type '(choice
327 (character :tag "Single definition list character")
328 (repeat :tag "List of possible definition list characters" character))
329 :package-version '(markdown-mode . "2.3"))
331 (defcustom markdown-enable-math nil
332 "Syntax highlighting for inline LaTeX and itex expressions.
333 Set this to a non-nil value to turn on math support by default.
334 Math support can be enabled, disabled, or toggled later using
335 `markdown-toggle-math' or \\[markdown-toggle-math]."
336 :group 'markdown
337 :type 'boolean
338 :safe 'booleanp)
339 (make-variable-buffer-local 'markdown-enable-math)
341 (defcustom markdown-enable-html t
342 "Enable font-lock support for HTML tags and attributes."
343 :group 'markdown
344 :type 'boolean
345 :safe 'booleanp
346 :package-version '(markdown-mode . "2.4"))
348 (defcustom markdown-css-paths nil
349 "List of URLs of CSS files to link to in the output XHTML."
350 :group 'markdown
351 :type '(repeat (string :tag "CSS File Path")))
353 (defcustom markdown-content-type "text/html"
354 "Content type string for the http-equiv header in XHTML output.
355 When set to an empty string, this attribute is omitted. Defaults to
356 `text/html'."
357 :group 'markdown
358 :type 'string)
360 (defcustom markdown-coding-system nil
361 "Character set string for the http-equiv header in XHTML output.
362 Defaults to `buffer-file-coding-system' (and falling back to
363 `utf-8' when not available). Common settings are `iso-8859-1'
364 and `iso-latin-1'. Use `list-coding-systems' for more choices."
365 :group 'markdown
366 :type 'coding-system)
368 (defcustom markdown-export-kill-buffer t
369 "Kill output buffer after HTML export.
370 When non-nil, kill the HTML output buffer after
371 exporting with `markdown-export'."
372 :group 'markdown
373 :type 'boolean
374 :safe 'booleanp
375 :package-version '(markdown-mode . "2.4"))
377 (defcustom markdown-xhtml-header-content ""
378 "Additional content to include in the XHTML <head> block."
379 :group 'markdown
380 :type 'string)
382 (defcustom markdown-xhtml-body-preamble ""
383 "Content to include in the XHTML <body> block, before the output."
384 :group 'markdown
385 :type 'string
386 :safe 'stringp
387 :package-version '(markdown-mode . "2.4"))
389 (defcustom markdown-xhtml-body-epilogue ""
390 "Content to include in the XHTML <body> block, after the output."
391 :group 'markdown
392 :type 'string
393 :safe 'stringp
394 :package-version '(markdown-mode . "2.4"))
396 (defcustom markdown-xhtml-standalone-regexp
397 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
398 "Regexp indicating whether `markdown-command' output is standalone XHTML."
399 :group 'markdown
400 :type 'regexp)
402 (defcustom markdown-link-space-sub-char "_"
403 "Character to use instead of spaces when mapping wiki links to filenames."
404 :group 'markdown
405 :type 'string)
407 (defcustom markdown-reference-location 'header
408 "Position where new reference definitions are inserted in the document."
409 :group 'markdown
410 :type '(choice (const :tag "At the end of the document" end)
411 (const :tag "Immediately after the current block" immediately)
412 (const :tag "At the end of the subtree" subtree)
413 (const :tag "Before next header" header)))
415 (defcustom markdown-footnote-location 'end
416 "Position where new footnotes are inserted in the document."
417 :group 'markdown
418 :type '(choice (const :tag "At the end of the document" end)
419 (const :tag "Immediately after the current block" immediately)
420 (const :tag "At the end of the subtree" subtree)
421 (const :tag "Before next header" header)))
423 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8))
424 "Display specification for footnote markers and inline footnotes.
425 By default, footnote text is reduced in size and raised. Set to
426 nil to disable this."
427 :group 'markdown
428 :type '(choice (sexp :tag "Display specification")
429 (const :tag "Don't set display property" nil))
430 :package-version '(markdown-mode . "2.4"))
432 (defcustom markdown-sub-superscript-display
433 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7)))
434 "Display specification for subscript and superscripts.
435 The car is used for subscript, the cdr is used for superscripts."
436 :group 'markdown
437 :type '(cons (choice (sexp :tag "Subscript form")
438 (const :tag "No lowering" nil))
439 (choice (sexp :tag "Superscript form")
440 (const :tag "No raising" nil)))
441 :package-version '(markdown-mode . "2.4"))
443 (defcustom markdown-unordered-list-item-prefix " * "
444 "String inserted before unordered list items."
445 :group 'markdown
446 :type 'string)
448 (defcustom markdown-ordered-list-enumeration t
449 "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker.
450 While nil, always uses '1.' for the marker"
451 :group 'markdown
452 :type 'boolean
453 :package-version '(markdown-mode . "2.5"))
455 (defcustom markdown-nested-imenu-heading-index t
456 "Use nested or flat imenu heading index.
457 A nested index may provide more natural browsing from the menu,
458 but a flat list may allow for faster keyboard navigation via tab
459 completion."
460 :group 'markdown
461 :type 'boolean
462 :safe 'booleanp
463 :package-version '(markdown-mode . "2.2"))
465 (defcustom markdown-add-footnotes-to-imenu t
466 "Add footnotes to end of imenu heading index."
467 :group 'markdown
468 :type 'boolean
469 :safe 'booleanp
470 :package-version '(markdown-mode . "2.4"))
472 (defcustom markdown-make-gfm-checkboxes-buttons t
473 "When non-nil, make GFM checkboxes into buttons."
474 :group 'markdown
475 :type 'boolean)
477 (defcustom markdown-use-pandoc-style-yaml-metadata nil
478 "When non-nil, allow YAML metadata anywhere in the document."
479 :group 'markdown
480 :type 'boolean)
482 (defcustom markdown-split-window-direction 'any
483 "Preference for splitting windows for static and live preview.
484 The default value is 'any, which instructs Emacs to use
485 `split-window-sensibly' to automatically choose how to split
486 windows based on the values of `split-width-threshold' and
487 `split-height-threshold' and the available windows. To force
488 vertically split (left and right) windows, set this to 'vertical
489 or 'right. To force horizontally split (top and bottom) windows,
490 set this to 'horizontal or 'below.
492 If this value is 'any and `display-buffer-alist' is set then
493 `display-buffer' is used for open buffer function"
494 :group 'markdown
495 :type '(choice (const :tag "Automatic" any)
496 (const :tag "Right (vertical)" right)
497 (const :tag "Below (horizontal)" below))
498 :package-version '(markdown-mode . "2.2"))
500 (defcustom markdown-live-preview-window-function
501 'markdown-live-preview-window-eww
502 "Function to display preview of Markdown output within Emacs.
503 Function must update the buffer containing the preview and return
504 the buffer."
505 :group 'markdown
506 :type 'function)
508 (defcustom markdown-live-preview-delete-export 'delete-on-destroy
509 "Delete exported HTML file when using `markdown-live-preview-export'.
510 If set to 'delete-on-export, delete on every export. When set to
511 'delete-on-destroy delete when quitting from command
512 `markdown-live-preview-mode'. Never delete if set to nil."
513 :group 'markdown
514 :type '(choice
515 (const :tag "Delete on every export" delete-on-export)
516 (const :tag "Delete when quitting live preview" delete-on-destroy)
517 (const :tag "Never delete" nil)))
519 (defcustom markdown-list-indent-width 4
520 "Depth of indentation for markdown lists.
521 Used in `markdown-demote-list-item' and
522 `markdown-promote-list-item'."
523 :group 'markdown
524 :type 'integer)
526 (defcustom markdown-enable-prefix-prompts t
527 "Display prompts for certain prefix commands.
528 Set to nil to disable these prompts."
529 :group 'markdown
530 :type 'boolean
531 :safe 'booleanp
532 :package-version '(markdown-mode . "2.3"))
534 (defcustom markdown-gfm-additional-languages nil
535 "Extra languages made available when inserting GFM code blocks.
536 Language strings must have be trimmed of whitespace and not
537 contain any curly braces. They may be of arbitrary
538 capitalization, though."
539 :group 'markdown
540 :type '(repeat (string :validate markdown-validate-language-string)))
542 (defcustom markdown-gfm-use-electric-backquote t
543 "Use `markdown-electric-backquote' when backquote is hit three times."
544 :group 'markdown
545 :type 'boolean)
547 (defcustom markdown-gfm-downcase-languages t
548 "If non-nil, downcase suggested languages.
549 This applies to insertions done with
550 `markdown-electric-backquote'."
551 :group 'markdown
552 :type 'boolean)
554 (defcustom markdown-edit-code-block-default-mode 'normal-mode
555 "Default mode to use for editing code blocks.
556 This mode is used when automatic detection fails, such as for GFM
557 code blocks with no language specified."
558 :group 'markdown
559 :type '(choice function (const :tag "None" nil))
560 :package-version '(markdown-mode . "2.4"))
562 (defcustom markdown-gfm-uppercase-checkbox nil
563 "If non-nil, use [X] for completed checkboxes, [x] otherwise."
564 :group 'markdown
565 :type 'boolean
566 :safe 'booleanp)
568 (defcustom markdown-hide-urls nil
569 "Hide URLs of inline links and reference tags of reference links.
570 Such URLs will be replaced by a single customizable
571 character, defined by `markdown-url-compose-char', but are still part
572 of the buffer. Links can be edited interactively with
573 \\[markdown-insert-link] or, for example, by deleting the final
574 parenthesis to remove the invisibility property. You can also
575 hover your mouse pointer over the link text to see the URL.
576 Set this to a non-nil value to turn this feature on by default.
577 You can interactively set the value of this variable by calling
578 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
579 or from the menu Markdown > Links & Images menu."
580 :group 'markdown
581 :type 'boolean
582 :safe 'booleanp
583 :package-version '(markdown-mode . "2.3"))
584 (make-variable-buffer-local 'markdown-hide-urls)
586 (defcustom markdown-translate-filename-function #'identity
587 "Function to use to translate filenames when following links.
588 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
589 call this function with the filename as only argument whenever
590 they encounter a filename (instead of a URL) to be visited and
591 use its return value instead of the filename in the link. For
592 example, if absolute filenames are actually relative to a server
593 root directory, you can set
594 `markdown-translate-filename-function' to a function that
595 prepends the root directory to the given filename."
596 :group 'markdown
597 :type 'function
598 :risky t
599 :package-version '(markdown-mode . "2.4"))
601 (defcustom markdown-max-image-size nil
602 "Maximum width and height for displayed inline images.
603 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
604 When nil, use the actual size. Otherwise, use ImageMagick to
605 resize larger images to be of the given maximum dimensions. This
606 requires Emacs to be built with ImageMagick support."
607 :group 'markdown
608 :package-version '(markdown-mode . "2.4")
609 :type '(choice
610 (const :tag "Use actual image width" nil)
611 (cons (choice (sexp :tag "Maximum width in pixels")
612 (const :tag "No maximum width" nil))
613 (choice (sexp :tag "Maximum height in pixels")
614 (const :tag "No maximum height" nil)))))
616 (defcustom markdown-mouse-follow-link t
617 "Non-nil means mouse on a link will follow the link.
618 This variable must be set before loading markdown-mode."
619 :group 'markdown
620 :type 'bool
621 :safe 'booleanp
622 :package-version '(markdown-mode . "2.5"))
625 ;;; Markdown-Specific `rx' Macro ==============================================
627 ;; Based on python-rx from python.el.
628 (eval-and-compile
629 (defconst markdown-rx-constituents
630 `((newline . ,(rx "\n"))
631 ;; Note: #405 not consider markdown-list-indent-width however this is never used
632 (indent . ,(rx (or (repeat 4 " ") "\t")))
633 (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end))))
634 (numeral . ,(rx (and (one-or-more (any "0-9#")) ".")))
635 (bullet . ,(rx (any "*+:-")))
636 (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".")
637 (any "*+:-"))))
638 (checkbox . ,(rx "[" (any " xX") "]")))
639 "Markdown-specific sexps for `markdown-rx'")
641 (defun markdown-rx-to-string (form &optional no-group)
642 "Markdown mode specialized `rx-to-string' function.
643 This variant supports named Markdown expressions in FORM.
644 NO-GROUP non-nil means don't put shy groups around the result."
645 (let ((rx-constituents (append markdown-rx-constituents rx-constituents)))
646 (rx-to-string form no-group)))
648 (defmacro markdown-rx (&rest regexps)
649 "Markdown mode specialized rx macro.
650 This variant of `rx' supports common Markdown named REGEXPS."
651 (cond ((null regexps)
652 (error "No regexp"))
653 ((cdr regexps)
654 (markdown-rx-to-string `(and ,@regexps) t))
656 (markdown-rx-to-string (car regexps) t)))))
659 ;;; Regular Expressions =======================================================
661 (defconst markdown-regex-comment-start
662 "<!--"
663 "Regular expression matches HTML comment opening.")
665 (defconst markdown-regex-comment-end
666 "--[ \t]*>"
667 "Regular expression matches HTML comment closing.")
669 (defconst markdown-regex-link-inline
670 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)"
671 "Regular expression for a [text](file) or an image link ![text](file).
672 Group 1 matches the leading exclamation point (optional).
673 Group 2 matches the opening square bracket.
674 Group 3 matches the text inside the square brackets.
675 Group 4 matches the closing square bracket.
676 Group 5 matches the opening parenthesis.
677 Group 6 matches the URL.
678 Group 7 matches the title (optional).
679 Group 8 matches the closing parenthesis.")
681 (defconst markdown-regex-link-reference
682 "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)"
683 "Regular expression for a reference link [text][id].
684 Group 1 matches the leading exclamation point (optional).
685 Group 2 matches the opening square bracket for the link text.
686 Group 3 matches the text inside the square brackets.
687 Group 4 matches the closing square bracket for the link text.
688 Group 5 matches the opening square bracket for the reference label.
689 Group 6 matches the reference label.
690 Group 7 matches the closing square bracket for the reference label.")
692 (defconst markdown-regex-reference-definition
693 "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)"
694 "Regular expression for a reference definition.
695 Group 1 matches the opening square bracket.
696 Group 2 matches the reference label.
697 Group 3 matches the closing square bracket.
698 Group 4 matches the colon.
699 Group 5 matches the URL.
700 Group 6 matches the title attribute (optional).")
702 (defconst markdown-regex-footnote
703 "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)"
704 "Regular expression for a footnote marker [^fn].
705 Group 1 matches the opening square bracket and carat.
706 Group 2 matches only the label, without the surrounding markup.
707 Group 3 matches the closing square bracket.")
709 (defconst markdown-regex-header
710 "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$"
711 "Regexp identifying Markdown headings.
712 Group 1 matches the text of a setext heading.
713 Group 2 matches the underline of a level-1 setext heading.
714 Group 3 matches the underline of a level-2 setext heading.
715 Group 4 matches the opening hash marks of an atx heading and whitespace.
716 Group 5 matches the text, without surrounding whitespace, of an atx heading.
717 Group 6 matches the closing whitespace and hash marks of an atx heading.")
719 (defconst markdown-regex-header-setext
720 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
721 "Regular expression for generic setext-style (underline) headers.")
723 (defconst markdown-regex-header-atx
724 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
725 "Regular expression for generic atx-style (hash mark) headers.")
727 (defconst markdown-regex-hr
728 (rx line-start
729 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* ")))
730 (and (repeat 3 (and "-" (? " "))) (* (any "- ")))
731 (and (repeat 3 (and "_" (? " "))) (* (any "_ ")))))
732 line-end)
733 "Regular expression for matching Markdown horizontal rules.")
735 (defconst markdown-regex-code
736 "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)"
737 "Regular expression for matching inline code fragments.
739 Group 1 matches the entire code fragment including the backquotes.
740 Group 2 matches the opening backquotes.
741 Group 3 matches the code fragment itself, without backquotes.
742 Group 4 matches the closing backquotes.
744 The leading, unnumbered group ensures that the leading backquote
745 character is not escaped.
746 The last group, also unnumbered, requires that the character
747 following the code fragment is not a backquote.
748 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
749 but not two newlines in a row.")
751 (defconst markdown-regex-kbd
752 "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)"
753 "Regular expression for matching <kbd> tags.
754 Groups 1 and 3 match the opening and closing tags.
755 Group 2 matches the key sequence.")
757 (defconst markdown-regex-gfm-code-block-open
758 "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$"
759 "Regular expression matching opening of GFM code blocks.
760 Group 1 matches the opening three backquotes and any following whitespace.
761 Group 2 matches the opening brace (optional) and surrounding whitespace.
762 Group 3 matches the language identifier (optional).
763 Group 4 matches the info string (optional).
764 Group 5 matches the closing brace (optional), whitespace, and newline.
765 Groups need to agree with `markdown-regex-tilde-fence-begin'.")
767 (defconst markdown-regex-gfm-code-block-close
768 "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$"
769 "Regular expression matching closing of GFM code blocks.
770 Group 1 matches the closing three backquotes.
771 Group 2 matches any whitespace and the final newline.")
773 (defconst markdown-regex-pre
774 "^\\( \\|\t\\).*$"
775 "Regular expression for matching preformatted text sections.")
777 (defconst markdown-regex-list
778 (markdown-rx line-start
779 ;; 1. Leading whitespace
780 (group (* blank))
781 ;; 2. List marker: a numeral, bullet, or colon
782 (group list-marker)
783 ;; 3. Trailing whitespace
784 (group (+ blank))
785 ;; 4. Optional checkbox for GFM task list items
786 (opt (group (and checkbox (* blank)))))
787 "Regular expression for matching list items.")
789 (defconst markdown-regex-bold
790 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)"
791 "Regular expression for matching bold text.
792 Group 1 matches the character before the opening asterisk or
793 underscore, if any, ensuring that it is not a backslash escape.
794 Group 2 matches the entire expression, including delimiters.
795 Groups 3 and 5 matches the opening and closing delimiters.
796 Group 4 matches the text inside the delimiters.")
798 (defconst markdown-regex-italic
799 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)"
800 "Regular expression for matching italic text.
801 The leading unnumbered matches the character before the opening
802 asterisk or underscore, if any, ensuring that it is not a
803 backslash escape.
804 Group 1 matches the entire expression, including delimiters.
805 Groups 2 and 4 matches the opening and closing delimiters.
806 Group 3 matches the text inside the delimiters.")
808 (defconst markdown-regex-strike-through
809 "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)"
810 "Regular expression for matching strike-through text.
811 Group 1 matches the character before the opening tilde, if any,
812 ensuring that it is not a backslash escape.
813 Group 2 matches the entire expression, including delimiters.
814 Groups 3 and 5 matches the opening and closing delimiters.
815 Group 4 matches the text inside the delimiters.")
817 (defconst markdown-regex-gfm-italic
818 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)"
819 "Regular expression for matching italic text in GitHub Flavored Markdown.
820 Underscores in words are not treated as special.
821 Group 1 matches the entire expression, including delimiters.
822 Groups 2 and 4 matches the opening and closing delimiters.
823 Group 3 matches the text inside the delimiters.")
825 (defconst markdown-regex-blockquote
826 "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$"
827 "Regular expression for matching blockquote lines.
828 Also accounts for a potential capital letter preceding the angle
829 bracket, for use with Leanpub blocks (asides, warnings, info
830 blocks, etc.).
831 Group 1 matches the leading angle bracket.
832 Group 2 matches the separating whitespace.
833 Group 3 matches the text.")
835 (defconst markdown-regex-line-break
836 "[^ \n\t][ \t]*\\( \\)$"
837 "Regular expression for matching line breaks.")
839 (defconst markdown-regex-wiki-link
840 "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)"
841 "Regular expression for matching wiki links.
842 This matches typical bracketed [[WikiLinks]] as well as 'aliased'
843 wiki links of the form [[PageName|link text]].
844 The meanings of the first and second components depend
845 on the value of `markdown-wiki-link-alias-first'.
847 Group 1 matches the entire link.
848 Group 2 matches the opening square brackets.
849 Group 3 matches the first component of the wiki link.
850 Group 4 matches the pipe separator, when present.
851 Group 5 matches the second component of the wiki link, when present.
852 Group 6 matches the closing square brackets.")
854 (defconst markdown-regex-uri
855 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)")
856 "Regular expression for matching inline URIs.")
858 (defconst markdown-regex-angle-uri
859 (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)")
860 "Regular expression for matching inline URIs in angle brackets.")
862 (defconst markdown-regex-email
863 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
864 "Regular expression for matching inline email addresses.")
866 (defsubst markdown-make-regex-link-generic ()
867 "Make regular expression for matching any recognized link."
868 (concat "\\(?:" markdown-regex-link-inline
869 (when markdown-enable-wiki-links
870 (concat "\\|" markdown-regex-wiki-link))
871 "\\|" markdown-regex-link-reference
872 "\\|" markdown-regex-angle-uri "\\)"))
874 (defconst markdown-regex-gfm-checkbox
875 " \\(\\[[ xX]\\]\\) "
876 "Regular expression for matching GFM checkboxes.
877 Group 1 matches the text to become a button.")
879 (defconst markdown-regex-blank-line
880 "^[[:blank:]]*$"
881 "Regular expression that matches a blank line.")
883 (defconst markdown-regex-block-separator
884 "\n[\n\t\f ]*\n"
885 "Regular expression for matching block boundaries.")
887 (defconst markdown-regex-block-separator-noindent
888 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)")
889 "Regexp for block separators before lines with no indentation.")
891 (defconst markdown-regex-math-inline-single
892 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)"
893 "Regular expression for itex $..$ math mode expressions.
894 Groups 1 and 3 match the opening and closing dollar signs.
895 Group 2 matches the mathematical expression contained within.")
897 (defconst markdown-regex-math-inline-double
898 "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)"
899 "Regular expression for itex $$..$$ math mode expressions.
900 Groups 1 and 3 match opening and closing dollar signs.
901 Group 2 matches the mathematical expression contained within.")
903 (defconst markdown-regex-math-display
904 (rx line-start (* blank)
905 (group (group (repeat 1 2 "\\")) "[")
906 (group (*? anything))
907 (group (backref 2) "]")
908 line-end)
909 "Regular expression for \[..\] or \\[..\\] display math.
910 Groups 1 and 4 match the opening and closing markup.
911 Group 3 matches the mathematical expression contained within.
912 Group 2 matches the opening slashes, and is used internally to
913 match the closing slashes.")
915 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line)
916 "Return regexp matching a tilde code fence at least NUM-TILDES long.
917 END-OF-LINE is the regexp construct to indicate end of line; $ if
918 missing."
919 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)"
920 (or end-of-line "$")))
922 (defconst markdown-regex-tilde-fence-begin
923 (markdown-make-tilde-fence-regex
924 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
925 "Regular expression for matching tilde-fenced code blocks.
926 Group 1 matches the opening tildes.
927 Group 2 matches (optional) opening brace and surrounding whitespace.
928 Group 3 matches the language identifier (optional).
929 Group 4 matches the info string (optional).
930 Group 5 matches the closing brace (optional) and any surrounding whitespace.
931 Groups need to agree with `markdown-regex-gfm-code-block-open'.")
933 (defconst markdown-regex-declarative-metadata
934 "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
935 "Regular expression for matching declarative metadata statements.
936 This matches MultiMarkdown metadata as well as YAML and TOML
937 assignments such as the following:
939 variable: value
943 variable = value")
945 (defconst markdown-regex-pandoc-metadata
946 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
947 "Regular expression for matching Pandoc metadata.")
949 (defconst markdown-regex-yaml-metadata-border
950 "\\(-\\{3\\}\\)$"
951 "Regular expression for matching YAML metadata.")
953 (defconst markdown-regex-yaml-pandoc-metadata-end-border
954 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
955 "Regular expression for matching YAML metadata end borders.")
957 (defsubst markdown-get-yaml-metadata-start-border ()
958 "Return YAML metadata start border depending upon whether Pandoc is used."
959 (concat
960 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`")
961 markdown-regex-yaml-metadata-border))
963 (defsubst markdown-get-yaml-metadata-end-border (_)
964 "Return YAML metadata end border depending upon whether Pandoc is used."
965 (if markdown-use-pandoc-style-yaml-metadata
966 markdown-regex-yaml-pandoc-metadata-end-border
967 markdown-regex-yaml-metadata-border))
969 (defconst markdown-regex-inline-attributes
970 "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$"
971 "Regular expression for matching inline identifiers or attribute lists.
972 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
974 (defconst markdown-regex-leanpub-sections
975 (concat
976 "^\\({\\)\\("
977 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
978 "\\)\\(}\\)[ \t]*\n")
979 "Regular expression for Leanpub section markers and related syntax.")
981 (defconst markdown-regex-sub-superscript
982 "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[[:alnum:]]+\\)\\(?4:\\2\\)\\)"
983 "The regular expression matching a sub- or superscript.
984 The leading un-numbered group matches the character before the
985 opening tilde or carat, if any, ensuring that it is not a
986 backslash escape, carat, or tilde.
987 Group 1 matches the entire expression, including markup.
988 Group 2 matches the opening markup--a tilde or carat.
989 Group 3 matches the text inside the delimiters.
990 Group 4 matches the closing markup--a tilde or carat.")
992 (defconst markdown-regex-include
993 "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$"
994 "Regular expression matching common forms of include syntax.
995 Marked 2, Leanpub, and other processors support some of these forms:
997 <<[sections/section1.md]
998 <<(folder/filename)
999 <<[Code title](folder/filename)
1000 <<{folder/raw_file.html}
1002 Group 1 matches the opening two angle brackets.
1003 Groups 2-4 match the opening square bracket, the text inside,
1004 and the closing square bracket, respectively.
1005 Groups 5-7 match the opening parenthesis, the text inside, and
1006 the closing parenthesis.
1007 Groups 8-10 match the opening brace, the text inside, and the brace.")
1009 (defconst markdown-regex-pandoc-inline-footnote
1010 "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)"
1011 "Regular expression for Pandoc inline footnote^[footnote text].
1012 Group 1 matches the opening caret.
1013 Group 2 matches the opening square bracket.
1014 Group 3 matches the footnote text, without the surrounding markup.
1015 Group 4 matches the closing square bracket.")
1017 (defconst markdown-regex-html-attr
1018 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
1019 "Regular expression for matching HTML attributes and values.
1020 Group 1 matches the attribute name.
1021 Group 2 matches the following whitespace, equals sign, and value, if any.
1022 Group 3 matches the equals sign, if any.
1023 Group 4 matches single-, double-, or un-quoted attribute values.")
1025 (defconst markdown-regex-html-tag
1026 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
1027 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
1028 "Regular expression for matching HTML tags.
1029 Groups 1 and 9 match the beginning and ending angle brackets and slashes.
1030 Group 2 matches the tag name.
1031 Group 3 matches all attributes and whitespace following the tag name.")
1033 (defconst markdown-regex-html-entity
1034 "\\(&#?[[:alnum:]]+;\\)"
1035 "Regular expression for matching HTML entities.")
1038 ;;; Syntax ====================================================================
1040 (defvar markdown--syntax-properties
1041 (list 'markdown-tilde-fence-begin nil
1042 'markdown-tilde-fence-end nil
1043 'markdown-fenced-code nil
1044 'markdown-yaml-metadata-begin nil
1045 'markdown-yaml-metadata-end nil
1046 'markdown-yaml-metadata-section nil
1047 'markdown-gfm-block-begin nil
1048 'markdown-gfm-block-end nil
1049 'markdown-gfm-code nil
1050 'markdown-list-item nil
1051 'markdown-pre nil
1052 'markdown-blockquote nil
1053 'markdown-hr nil
1054 'markdown-comment nil
1055 'markdown-heading nil
1056 'markdown-heading-1-setext nil
1057 'markdown-heading-2-setext nil
1058 'markdown-heading-1-atx nil
1059 'markdown-heading-2-atx nil
1060 'markdown-heading-3-atx nil
1061 'markdown-heading-4-atx nil
1062 'markdown-heading-5-atx nil
1063 'markdown-heading-6-atx nil
1064 'markdown-metadata-key nil
1065 'markdown-metadata-value nil
1066 'markdown-metadata-markup nil)
1067 "Property list of all Markdown syntactic properties.")
1069 (defsubst markdown-in-comment-p (&optional pos)
1070 "Return non-nil if POS is in a comment.
1071 If POS is not given, use point instead."
1072 (get-text-property (or pos (point)) 'markdown-comment))
1074 (defun markdown--face-p (pos faces)
1075 "Return non-nil if face of POS contain FACES."
1076 (let ((face-prop (get-text-property pos 'face)))
1077 (if (listp face-prop)
1078 (cl-loop for face in face-prop
1079 thereis (memq face faces))
1080 (memq face-prop faces))))
1082 (defun markdown-syntax-propertize-extend-region (start end)
1083 "Extend START to END region to include an entire block of text.
1084 This helps improve syntax analysis for block constructs.
1085 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
1086 Function is called repeatedly until it returns nil. For details, see
1087 `syntax-propertize-extend-region-functions'."
1088 (save-match-data
1089 (save-excursion
1090 (let* ((new-start (progn (goto-char start)
1091 (skip-chars-forward "\n")
1092 (if (re-search-backward "\n\n" nil t)
1093 (min start (match-end 0))
1094 (point-min))))
1095 (new-end (progn (goto-char end)
1096 (skip-chars-backward "\n")
1097 (if (re-search-forward "\n\n" nil t)
1098 (max end (match-beginning 0))
1099 (point-max))))
1100 (code-match (markdown-code-block-at-pos new-start))
1101 (new-start (or (and code-match (cl-first code-match)) new-start))
1102 (code-match (and (< end (point-max)) (markdown-code-block-at-pos end)))
1103 (new-end (or (and code-match (cl-second code-match)) new-end)))
1104 (unless (and (eq new-start start) (eq new-end end))
1105 (cons new-start (min new-end (point-max))))))))
1107 (defun markdown-font-lock-extend-region-function (start end _)
1108 "Used in `jit-lock-after-change-extend-region-functions'.
1109 Delegates to `markdown-syntax-propertize-extend-region'. START
1110 and END are the previous region to refontify."
1111 (let ((res (markdown-syntax-propertize-extend-region start end)))
1112 (when res
1113 ;; syntax-propertize-function is not called when character at
1114 ;; (point-max) is deleted, but font-lock-extend-region-functions
1115 ;; are called. Force a syntax property update in that case.
1116 (when (= end (point-max))
1117 ;; This function is called in a buffer modification hook.
1118 ;; `markdown-syntax-propertize' doesn't save the match data,
1119 ;; so we have to do it here.
1120 (save-match-data
1121 (markdown-syntax-propertize (car res) (cdr res))))
1122 (setq jit-lock-start (car res)
1123 jit-lock-end (cdr res)))))
1125 (defun markdown--cur-list-item-bounds ()
1126 "Return a list describing the list item at point.
1127 Assumes that match data is set for `markdown-regex-list'. See the
1128 documentation for `markdown-cur-list-item-bounds' for the format of
1129 the returned list."
1130 (save-excursion
1131 (let* ((begin (match-beginning 0))
1132 (indent (length (match-string-no-properties 1)))
1133 (nonlist-indent (- (match-end 3) (match-beginning 0)))
1134 (marker (buffer-substring-no-properties
1135 (match-beginning 2) (match-end 3)))
1136 (checkbox (match-string-no-properties 4))
1137 (match (butlast (match-data t)))
1138 (end (markdown-cur-list-item-end nonlist-indent)))
1139 (list begin end indent nonlist-indent marker checkbox match))))
1141 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds)
1142 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
1143 Here, MARKER is a string representing the type of list and INDENT
1144 is an integer giving the indentation, in spaces, of the current
1145 block. CUR-BOUNDS is a list of the form returned by
1146 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
1147 values for parent list items. When BOUNDS is nil, it means we are
1148 at baseline (not inside of a nested list)."
1149 (let ((prev-indent (or (cl-third (car bounds)) 0)))
1150 (cond
1151 ;; New list item at baseline.
1152 ((and marker (null bounds))
1153 (list cur-bounds))
1154 ;; List item with greater indentation (four or more spaces).
1155 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
1156 ((and marker (>= indent (+ prev-indent markdown-list-indent-width)))
1157 (cons cur-bounds bounds))
1158 ;; List item with greater or equal indentation (less than four spaces).
1159 ;; Keep list level the same by replacing the car of BOUNDS.
1160 ((and marker (>= indent prev-indent))
1161 (cons cur-bounds (cdr bounds)))
1162 ;; Lesser indentation level.
1163 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
1164 ;; indentation could move back more than one list level). Note
1165 ;; that this block need not be the beginning of list item.
1166 ((< indent prev-indent)
1167 (while (and (> (length bounds) 1)
1168 (setq prev-indent (cl-third (cadr bounds)))
1169 (< indent (+ prev-indent markdown-list-indent-width)))
1170 (setq bounds (cdr bounds)))
1171 (cons cur-bounds bounds))
1172 ;; Otherwise, do nothing.
1173 (t bounds))))
1175 (defun markdown-syntax-propertize-list-items (start end)
1176 "Propertize list items from START to END.
1177 Stores nested list item information in the `markdown-list-item'
1178 text property to make later syntax analysis easier. The value of
1179 this property is a list with elements of the form (begin . end)
1180 giving the bounds of the current and parent list items."
1181 (save-excursion
1182 (goto-char start)
1183 (let ((prev-list-line -100)
1184 bounds level pre-regexp)
1185 ;; Find a baseline point with zero list indentation
1186 (markdown-search-backward-baseline)
1187 ;; Search for all list items between baseline and END
1188 (while (and (< (point) end)
1189 (re-search-forward markdown-regex-list end 'limit))
1190 ;; Level of list nesting
1191 (setq level (length bounds))
1192 ;; Pre blocks need to be indented one level past the list level
1193 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level)))
1194 (beginning-of-line)
1195 (cond
1196 ;; Reset at headings, horizontal rules, and top-level blank lines.
1197 ;; Propertize baseline when in range.
1198 ((markdown-new-baseline)
1199 (setq bounds nil))
1200 ;; Make sure this is not a line from a pre block
1201 ((and (looking-at-p pre-regexp)
1202 ;; too indented line is also treated as list if previous line is list
1203 (>= (- (line-number-at-pos) prev-list-line) 2)))
1204 ;; If not, then update levels and propertize list item when in range.
1206 (let* ((indent (current-indentation))
1207 (cur-bounds (markdown--cur-list-item-bounds))
1208 (first (cl-first cur-bounds))
1209 (last (cl-second cur-bounds))
1210 (marker (cl-fifth cur-bounds)))
1211 (setq bounds (markdown--append-list-item-bounds
1212 marker indent cur-bounds bounds))
1213 (when (and (<= start (point)) (<= (point) end))
1214 (setq prev-list-line (line-number-at-pos first))
1215 (put-text-property first last 'markdown-list-item bounds)))))
1216 (end-of-line)))))
1218 (defun markdown-syntax-propertize-pre-blocks (start end)
1219 "Match preformatted text blocks from START to END."
1220 (save-excursion
1221 (goto-char start)
1222 (let (finish)
1223 ;; Use loop for avoiding too many recursive calls
1224 ;; https://github.com/jrblevin/markdown-mode/issues/512
1225 (while (not finish)
1226 (let ((levels (markdown-calculate-list-levels))
1227 indent pre-regexp close-regexp open close)
1228 (while (and (< (point) end) (not close))
1229 ;; Search for a region with sufficient indentation
1230 (if (null levels)
1231 (setq indent 1)
1232 (setq indent (1+ (length levels))))
1233 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent))
1234 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent)))
1236 (cond
1237 ;; If not at the beginning of a line, move forward
1238 ((not (bolp)) (forward-line))
1239 ;; Move past blank lines
1240 ((markdown-cur-line-blank-p) (forward-line))
1241 ;; At headers and horizontal rules, reset levels
1242 ((markdown-new-baseline) (forward-line) (setq levels nil))
1243 ;; If the current line has sufficient indentation, mark out pre block
1244 ;; The opening should be preceded by a blank line.
1245 ((and (markdown-prev-line-blank) (looking-at pre-regexp))
1246 (setq open (match-beginning 0))
1247 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p))
1248 (not (eobp)))
1249 (forward-line))
1250 (skip-syntax-backward "-")
1251 (setq close (point)))
1252 ;; If current line has a list marker, update levels, move to end of block
1253 ((looking-at markdown-regex-list)
1254 (setq levels (markdown-update-list-levels
1255 (match-string 2) (current-indentation) levels))
1256 (markdown-end-of-text-block))
1257 ;; If this is the end of the indentation level, adjust levels accordingly.
1258 ;; Only match end of indentation level if levels is not the empty list.
1259 ((and (car levels) (looking-at-p close-regexp))
1260 (setq levels (markdown-update-list-levels
1261 nil (current-indentation) levels))
1262 (markdown-end-of-text-block))
1263 (t (markdown-end-of-text-block))))
1265 (if (and open close)
1266 ;; Set text property data and continue to search
1267 (put-text-property open close 'markdown-pre (list open close))
1268 (setq finish t))))
1269 nil)))
1271 (defconst markdown-fenced-block-pairs
1272 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin)
1273 (markdown-make-tilde-fence-regex markdown-tilde-fence-end)
1274 markdown-fenced-code)
1275 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin)
1276 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end)
1277 markdown-yaml-metadata-section)
1278 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin)
1279 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end)
1280 markdown-gfm-code))
1281 "Mapping of regular expressions to \"fenced-block\" constructs.
1282 These constructs are distinguished by having a distinctive start
1283 and end pattern, both of which take up an entire line of text,
1284 but no special pattern to identify text within the fenced
1285 blocks (unlike blockquotes and indented-code sections).
1287 Each element within this list takes the form:
1289 ((START-REGEX-OR-FUN START-PROPERTY)
1290 (END-REGEX-OR-FUN END-PROPERTY)
1291 MIDDLE-PROPERTY)
1293 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
1294 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
1295 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
1296 which is the length of the first group of the START-REGEX-OR-FUN match, which
1297 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
1298 evaluate these into \"real\" regexps.
1300 The *-PROPERTY elements are the text properties applied to each part of the
1301 block construct when it is matched using
1302 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
1303 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
1304 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
1305 `match-data' when the regexp was matched to the text. In the case of
1306 MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with
1307 begin and end set to the edges of the \"middle\" text. This makes fontification
1308 easier.")
1310 (defun markdown-text-property-at-point (prop)
1311 (get-text-property (point) prop))
1313 (defsubst markdown-maybe-funcall-regexp (object &optional arg)
1314 (cond ((functionp object)
1315 (if arg (funcall object arg) (funcall object)))
1316 ((stringp object) object)
1317 (t (error "Object cannot be turned into regex"))))
1319 (defsubst markdown-get-start-fence-regexp ()
1320 "Return regexp to find all \"start\" sections of fenced block constructs.
1321 Which construct is actually contained in the match must be found separately."
1322 (mapconcat
1323 #'identity
1324 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry)))
1325 markdown-fenced-block-pairs)
1326 "\\|"))
1328 (defun markdown-get-fenced-block-begin-properties ()
1329 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs))
1331 (defun markdown-get-fenced-block-end-properties ()
1332 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs))
1334 (defun markdown-get-fenced-block-middle-properties ()
1335 (cl-mapcar #'cl-third markdown-fenced-block-pairs))
1337 (defun markdown-find-previous-prop (prop &optional lim)
1338 "Find previous place where property PROP is non-nil, up to LIM.
1339 Return a cons of (pos . property). pos is point if point contains
1340 non-nil PROP."
1341 (let ((res
1342 (if (get-text-property (point) prop) (point)
1343 (previous-single-property-change
1344 (point) prop nil (or lim (point-min))))))
1345 (when (and (not (get-text-property res prop))
1346 (> res (point-min))
1347 (get-text-property (1- res) prop))
1348 (cl-decf res))
1349 (when (and res (get-text-property res prop)) (cons res prop))))
1351 (defun markdown-find-next-prop (prop &optional lim)
1352 "Find next place where property PROP is non-nil, up to LIM.
1353 Return a cons of (POS . PROPERTY) where POS is point if point
1354 contains non-nil PROP."
1355 (let ((res
1356 (if (get-text-property (point) prop) (point)
1357 (next-single-property-change
1358 (point) prop nil (or lim (point-max))))))
1359 (when (and res (get-text-property res prop)) (cons res prop))))
1361 (defun markdown-min-of-seq (map-fn seq)
1362 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
1363 (cl-loop for el in seq
1364 with min = 1.0e+INF ; infinity
1365 with min-el = nil
1366 do (let ((res (funcall map-fn el)))
1367 (when (< res min)
1368 (setq min res)
1369 (setq min-el el)))
1370 finally return min-el))
1372 (defun markdown-max-of-seq (map-fn seq)
1373 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
1374 (cl-loop for el in seq
1375 with max = -1.0e+INF ; negative infinity
1376 with max-el = nil
1377 do (let ((res (funcall map-fn el)))
1378 (when (and res (> res max))
1379 (setq max res)
1380 (setq max-el el)))
1381 finally return max-el))
1383 (defun markdown-find-previous-block ()
1384 "Find previous block.
1385 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
1386 unable to propertize the entire block, but was able to propertize the beginning
1387 of the block. If so, return a cons of (pos . property) where the beginning of
1388 the block was propertized."
1389 (let ((start-pt (point))
1390 (closest-open
1391 (markdown-max-of-seq
1392 #'car
1393 (cl-remove-if
1394 #'null
1395 (cl-mapcar
1396 #'markdown-find-previous-prop
1397 (markdown-get-fenced-block-begin-properties))))))
1398 (when closest-open
1399 (let* ((length-of-open-match
1400 (let ((match-d
1401 (get-text-property (car closest-open) (cdr closest-open))))
1402 (- (cl-fourth match-d) (cl-third match-d))))
1403 (end-regexp
1404 (markdown-maybe-funcall-regexp
1405 (cl-caadr
1406 (cl-find-if
1407 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open)))
1408 markdown-fenced-block-pairs))
1409 length-of-open-match))
1410 (end-prop-loc
1411 (save-excursion
1412 (save-match-data
1413 (goto-char (car closest-open))
1414 (and (re-search-forward end-regexp start-pt t)
1415 (match-beginning 0))))))
1416 (and (not end-prop-loc) closest-open)))))
1418 (defun markdown-get-fenced-block-from-start (prop)
1419 "Return limits of an enclosing fenced block from its start, using PROP.
1420 Return value is a list usable as `match-data'."
1421 (catch 'no-rest-of-block
1422 (let* ((correct-entry
1423 (cl-find-if
1424 (lambda (entry) (eq (cl-cadar entry) prop))
1425 markdown-fenced-block-pairs))
1426 (begin-of-begin (cl-first (markdown-text-property-at-point prop)))
1427 (middle-prop (cl-third correct-entry))
1428 (end-prop (cl-cadadr correct-entry))
1429 (end-of-end
1430 (save-excursion
1431 (goto-char (match-end 0)) ; end of begin
1432 (unless (eobp) (forward-char))
1433 (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
1434 (if (not mid-prop-v) ; no middle
1435 (progn
1436 ;; try to find end by advancing one
1437 (let ((end-prop-v
1438 (markdown-text-property-at-point end-prop)))
1439 (if end-prop-v (cl-second end-prop-v)
1440 (throw 'no-rest-of-block nil))))
1441 (set-match-data mid-prop-v)
1442 (goto-char (match-end 0)) ; end of middle
1443 (beginning-of-line) ; into end
1444 (cl-second (markdown-text-property-at-point end-prop)))))))
1445 (list begin-of-begin end-of-end))))
1447 (defun markdown-get-fenced-block-from-middle (prop)
1448 "Return limits of an enclosing fenced block from its middle, using PROP.
1449 Return value is a list usable as `match-data'."
1450 (let* ((correct-entry
1451 (cl-find-if
1452 (lambda (entry) (eq (cl-third entry) prop))
1453 markdown-fenced-block-pairs))
1454 (begin-prop (cl-cadar correct-entry))
1455 (begin-of-begin
1456 (save-excursion
1457 (goto-char (match-beginning 0))
1458 (unless (bobp) (forward-line -1))
1459 (beginning-of-line)
1460 (cl-first (markdown-text-property-at-point begin-prop))))
1461 (end-prop (cl-cadadr correct-entry))
1462 (end-of-end
1463 (save-excursion
1464 (goto-char (match-end 0))
1465 (beginning-of-line)
1466 (cl-second (markdown-text-property-at-point end-prop)))))
1467 (list begin-of-begin end-of-end)))
1469 (defun markdown-get-fenced-block-from-end (prop)
1470 "Return limits of an enclosing fenced block from its end, using PROP.
1471 Return value is a list usable as `match-data'."
1472 (let* ((correct-entry
1473 (cl-find-if
1474 (lambda (entry) (eq (cl-cadadr entry) prop))
1475 markdown-fenced-block-pairs))
1476 (end-of-end (cl-second (markdown-text-property-at-point prop)))
1477 (middle-prop (cl-third correct-entry))
1478 (begin-prop (cl-cadar correct-entry))
1479 (begin-of-begin
1480 (save-excursion
1481 (goto-char (match-beginning 0)) ; beginning of end
1482 (unless (bobp) (backward-char)) ; into middle
1483 (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
1484 (if (not mid-prop-v)
1485 (progn
1486 (beginning-of-line)
1487 (cl-first (markdown-text-property-at-point begin-prop)))
1488 (set-match-data mid-prop-v)
1489 (goto-char (match-beginning 0)) ; beginning of middle
1490 (unless (bobp) (forward-line -1)) ; into beginning
1491 (beginning-of-line)
1492 (cl-first (markdown-text-property-at-point begin-prop)))))))
1493 (list begin-of-begin end-of-end)))
1495 (defun markdown-get-enclosing-fenced-block-construct (&optional pos)
1496 "Get \"fake\" match data for block enclosing POS.
1497 Returns fake match data which encloses the start, middle, and end
1498 of the block construct enclosing POS, if it exists. Used in
1499 `markdown-code-block-at-pos'."
1500 (save-excursion
1501 (when pos (goto-char pos))
1502 (beginning-of-line)
1503 (car
1504 (cl-remove-if
1505 #'null
1506 (cl-mapcar
1507 (lambda (fun-and-prop)
1508 (cl-destructuring-bind (fun prop) fun-and-prop
1509 (when prop
1510 (save-match-data
1511 (set-match-data (markdown-text-property-at-point prop))
1512 (funcall fun prop)))))
1513 `((markdown-get-fenced-block-from-start
1514 ,(cl-find-if
1515 #'markdown-text-property-at-point
1516 (markdown-get-fenced-block-begin-properties)))
1517 (markdown-get-fenced-block-from-middle
1518 ,(cl-find-if
1519 #'markdown-text-property-at-point
1520 (markdown-get-fenced-block-middle-properties)))
1521 (markdown-get-fenced-block-from-end
1522 ,(cl-find-if
1523 #'markdown-text-property-at-point
1524 (markdown-get-fenced-block-end-properties)))))))))
1526 (defun markdown-propertize-end-match (reg end fence-spec middle-begin)
1527 "Get match for REG up to END, if exists, and propertize appropriately.
1528 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
1529 MIDDLE-BEGIN is the start of the \"middle\" section of the block."
1530 (when (re-search-forward reg end t)
1531 (let ((close-begin (match-beginning 0)) ; Start of closing line.
1532 (close-end (match-end 0)) ; End of closing line.
1533 (close-data (match-data t))) ; Match data for closing line.
1534 ;; Propertize middle section of fenced block.
1535 (put-text-property middle-begin close-begin
1536 (cl-third fence-spec)
1537 (list middle-begin close-begin))
1538 ;; If the block is a YAML block, propertize the declarations inside
1539 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)
1540 ;; Propertize closing line of fenced block.
1541 (put-text-property close-begin close-end
1542 (cl-cadadr fence-spec) close-data))))
1544 (defun markdown-syntax-propertize-fenced-block-constructs (start end)
1545 "Propertize according to `markdown-fenced-block-pairs' from START to END.
1546 If unable to propertize an entire block (if the start of a block is within START
1547 and END, but the end of the block is not), propertize the start section of a
1548 block, then in a subsequent call propertize both middle and end by finding the
1549 start which was previously propertized."
1550 (let ((start-reg (markdown-get-start-fence-regexp)))
1551 (save-excursion
1552 (goto-char start)
1553 ;; start from previous unclosed block, if exists
1554 (let ((prev-begin-block (markdown-find-previous-block)))
1555 (when prev-begin-block
1556 (let* ((correct-entry
1557 (cl-find-if (lambda (entry)
1558 (eq (cdr prev-begin-block) (cl-cadar entry)))
1559 markdown-fenced-block-pairs))
1560 (enclosed-text-start (1+ (car prev-begin-block)))
1561 (start-length
1562 (save-excursion
1563 (goto-char (car prev-begin-block))
1564 (string-match
1565 (markdown-maybe-funcall-regexp
1566 (caar correct-entry))
1567 (buffer-substring
1568 (point-at-bol) (point-at-eol)))
1569 (- (match-end 1) (match-beginning 1))))
1570 (end-reg (markdown-maybe-funcall-regexp
1571 (cl-caadr correct-entry) start-length)))
1572 (markdown-propertize-end-match
1573 end-reg end correct-entry enclosed-text-start))))
1574 ;; find all new blocks within region
1575 (while (re-search-forward start-reg end t)
1576 ;; we assume the opening constructs take up (only) an entire line,
1577 ;; so we re-check the current line
1578 (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol)))
1579 ;; find entry in `markdown-fenced-block-pairs' corresponding
1580 ;; to regex which was matched
1581 (correct-entry
1582 (cl-find-if
1583 (lambda (fenced-pair)
1584 (string-match-p
1585 (markdown-maybe-funcall-regexp (caar fenced-pair))
1586 cur-line))
1587 markdown-fenced-block-pairs))
1588 (enclosed-text-start
1589 (save-excursion (1+ (point-at-eol))))
1590 (end-reg
1591 (markdown-maybe-funcall-regexp
1592 (cl-caadr correct-entry)
1593 (if (and (match-beginning 1) (match-end 1))
1594 (- (match-end 1) (match-beginning 1))
1595 0))))
1596 ;; get correct match data
1597 (save-excursion
1598 (beginning-of-line)
1599 (re-search-forward
1600 (markdown-maybe-funcall-regexp (caar correct-entry))
1601 (point-at-eol)))
1602 ;; mark starting, even if ending is outside of region
1603 (put-text-property (match-beginning 0) (match-end 0)
1604 (cl-cadar correct-entry) (match-data t))
1605 (markdown-propertize-end-match
1606 end-reg end correct-entry enclosed-text-start))))))
1608 (defun markdown-syntax-propertize-blockquotes (start end)
1609 "Match blockquotes from START to END."
1610 (save-excursion
1611 (goto-char start)
1612 (while (and (re-search-forward markdown-regex-blockquote end t)
1613 (not (markdown-code-block-at-pos (match-beginning 0))))
1614 (put-text-property (match-beginning 0) (match-end 0)
1615 'markdown-blockquote
1616 (match-data t)))))
1618 (defun markdown-syntax-propertize-hrs (start end)
1619 "Match horizontal rules from START to END."
1620 (save-excursion
1621 (goto-char start)
1622 (while (re-search-forward markdown-regex-hr end t)
1623 (let ((beg (match-beginning 0))
1624 (end (match-end 0)))
1625 (goto-char beg)
1626 (unless (or (markdown-on-heading-p)
1627 (markdown-code-block-at-point-p))
1628 (put-text-property beg end 'markdown-hr (match-data t)))
1629 (goto-char end)))))
1631 (defun markdown-syntax-propertize-yaml-metadata (start end)
1632 "Propertize elements inside YAML metadata blocks from START to END.
1633 Assumes region from START and END is already known to be the interior
1634 region of a YAML metadata block as propertized by
1635 `markdown-syntax-propertize-fenced-block-constructs'."
1636 (save-excursion
1637 (goto-char start)
1638 (cl-loop
1639 while (re-search-forward markdown-regex-declarative-metadata end t)
1640 do (progn
1641 (put-text-property (match-beginning 1) (match-end 1)
1642 'markdown-metadata-key (match-data t))
1643 (put-text-property (match-beginning 2) (match-end 2)
1644 'markdown-metadata-markup (match-data t))
1645 (put-text-property (match-beginning 3) (match-end 3)
1646 'markdown-metadata-value (match-data t))))))
1648 (defun markdown-syntax-propertize-headings (start end)
1649 "Match headings of type SYMBOL with REGEX from START to END."
1650 (goto-char start)
1651 (while (re-search-forward markdown-regex-header end t)
1652 (unless (markdown-code-block-at-pos (match-beginning 0))
1653 (put-text-property
1654 (match-beginning 0) (match-end 0) 'markdown-heading
1655 (match-data t))
1656 (put-text-property
1657 (match-beginning 0) (match-end 0)
1658 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext)
1659 ((match-string-no-properties 3) 'markdown-heading-2-setext)
1660 (t (let ((atx-level (length (markdown-trim-whitespace
1661 (match-string-no-properties 4)))))
1662 (intern (format "markdown-heading-%d-atx" atx-level)))))
1663 (match-data t)))))
1665 (defun markdown-syntax-propertize-comments (start end)
1666 "Match HTML comments from the START to END."
1667 ;; Implement by loop instead of recursive call for avoiding
1668 ;; exceed max-lisp-eval-depth issue
1669 ;; https://github.com/jrblevin/markdown-mode/issues/536
1670 (let (finish)
1671 (goto-char start)
1672 (while (not finish)
1673 (let* ((in-comment (nth 4 (syntax-ppss)))
1674 (comment-begin (nth 8 (syntax-ppss))))
1675 (cond
1676 ;; Comment start
1677 ((and (not in-comment)
1678 (re-search-forward markdown-regex-comment-start end t)
1679 (not (markdown-inline-code-at-point-p))
1680 (not (markdown-code-block-at-point-p)))
1681 (let ((open-beg (match-beginning 0)))
1682 (put-text-property open-beg (1+ open-beg)
1683 'syntax-table (string-to-syntax "<"))
1684 (goto-char (min (1+ (match-end 0)) end (point-max)))))
1685 ;; Comment end
1686 ((and in-comment comment-begin
1687 (re-search-forward markdown-regex-comment-end end t))
1688 (let ((comment-end (match-end 0)))
1689 (put-text-property (1- comment-end) comment-end
1690 'syntax-table (string-to-syntax ">"))
1691 ;; Remove any other text properties inside the comment
1692 (remove-text-properties comment-begin comment-end
1693 markdown--syntax-properties)
1694 (put-text-property comment-begin comment-end
1695 'markdown-comment (list comment-begin comment-end))
1696 (goto-char (min comment-end end (point-max)))))
1697 ;; Nothing found
1698 (t (setq finish t)))))
1699 nil))
1701 (defun markdown-syntax-propertize (start end)
1702 "Function used as `syntax-propertize-function'.
1703 START and END delimit region to propertize."
1704 (with-silent-modifications
1705 (save-excursion
1706 (remove-text-properties start end markdown--syntax-properties)
1707 (markdown-syntax-propertize-fenced-block-constructs start end)
1708 (markdown-syntax-propertize-list-items start end)
1709 (markdown-syntax-propertize-pre-blocks start end)
1710 (markdown-syntax-propertize-blockquotes start end)
1711 (markdown-syntax-propertize-headings start end)
1712 (markdown-syntax-propertize-hrs start end)
1713 (markdown-syntax-propertize-comments start end))))
1716 ;;; Markup Hiding =============================================================
1718 (defconst markdown-markup-properties
1719 '(face markdown-markup-face invisible markdown-markup)
1720 "List of properties and values to apply to markup.")
1722 (defconst markdown-language-keyword-properties
1723 '(face markdown-language-keyword-face invisible markdown-markup)
1724 "List of properties and values to apply to code block language names.")
1726 (defconst markdown-language-info-properties
1727 '(face markdown-language-info-face invisible markdown-markup)
1728 "List of properties and values to apply to code block language info strings.")
1730 (defconst markdown-include-title-properties
1731 '(face markdown-link-title-face invisible markdown-markup)
1732 "List of properties and values to apply to included code titles.")
1734 (defcustom markdown-hide-markup nil
1735 "Determines whether markup in the buffer will be hidden.
1736 When set to nil, all markup is displayed in the buffer as it
1737 appears in the file. An exception is when `markdown-hide-urls'
1738 is non-nil.
1739 Set this to a non-nil value to turn this feature on by default.
1740 You can interactively toggle the value of this variable with
1741 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
1742 or from the Markdown > Show & Hide menu.
1744 Markup hiding works by adding text properties to positions in the
1745 buffer---either the `invisible' property or the `display' property
1746 in cases where alternative glyphs are used (e.g., list bullets).
1747 This does not, however, affect printing or other output.
1748 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
1749 not honor these text properties. For printing, it would be better
1750 to first convert to HTML or PDF (e.g,. using Pandoc)."
1751 :group 'markdown
1752 :type 'boolean
1753 :safe 'booleanp
1754 :package-version '(markdown-mode . "2.3"))
1755 (make-variable-buffer-local 'markdown-hide-markup)
1757 (defun markdown-toggle-markup-hiding (&optional arg)
1758 "Toggle the display or hiding of markup.
1759 With a prefix argument ARG, enable markup hiding if ARG is positive,
1760 and disable it otherwise.
1761 See `markdown-hide-markup' for additional details."
1762 (interactive (list (or current-prefix-arg 'toggle)))
1763 (setq markdown-hide-markup
1764 (if (eq arg 'toggle)
1765 (not markdown-hide-markup)
1766 (> (prefix-numeric-value arg) 0)))
1767 (if markdown-hide-markup
1768 (progn (add-to-invisibility-spec 'markdown-markup)
1769 (message "markdown-mode markup hiding enabled"))
1770 (progn (remove-from-invisibility-spec 'markdown-markup)
1771 (message "markdown-mode markup hiding disabled")))
1772 (markdown-reload-extensions))
1775 ;;; Font Lock =================================================================
1777 (require 'font-lock)
1779 (defgroup markdown-faces nil
1780 "Faces used in Markdown Mode."
1781 :group 'markdown
1782 :group 'faces)
1784 (defface markdown-italic-face
1785 '((t (:inherit italic)))
1786 "Face for italic text."
1787 :group 'markdown-faces)
1789 (defface markdown-bold-face
1790 '((t (:inherit bold)))
1791 "Face for bold text."
1792 :group 'markdown-faces)
1794 (defface markdown-strike-through-face
1795 '((t (:strike-through t)))
1796 "Face for strike-through text."
1797 :group 'markdown-faces)
1799 (defface markdown-markup-face
1800 '((t (:inherit shadow :slant normal :weight normal)))
1801 "Face for markup elements."
1802 :group 'markdown-faces)
1804 (defface markdown-header-rule-face
1805 '((t (:inherit markdown-markup-face)))
1806 "Base face for headers rules."
1807 :group 'markdown-faces)
1809 (defface markdown-header-delimiter-face
1810 '((t (:inherit markdown-markup-face)))
1811 "Base face for headers hash delimiter."
1812 :group 'markdown-faces)
1814 (defface markdown-list-face
1815 '((t (:inherit markdown-markup-face)))
1816 "Face for list item markers."
1817 :group 'markdown-faces)
1819 (defface markdown-blockquote-face
1820 '((t (:inherit font-lock-doc-face)))
1821 "Face for blockquote sections."
1822 :group 'markdown-faces)
1824 (defface markdown-code-face
1825 '((t (:inherit fixed-pitch)))
1826 "Face for inline code, pre blocks, and fenced code blocks.
1827 This may be used, for example, to add a contrasting background to
1828 inline code fragments and code blocks."
1829 :group 'markdown-faces)
1831 (defface markdown-inline-code-face
1832 '((t (:inherit (markdown-code-face font-lock-constant-face))))
1833 "Face for inline code."
1834 :group 'markdown-faces)
1836 (defface markdown-pre-face
1837 '((t (:inherit (markdown-code-face font-lock-constant-face))))
1838 "Face for preformatted text."
1839 :group 'markdown-faces)
1841 (defface markdown-table-face
1842 '((t (:inherit (markdown-code-face))))
1843 "Face for tables."
1844 :group 'markdown-faces)
1846 (defface markdown-language-keyword-face
1847 '((t (:inherit font-lock-type-face)))
1848 "Face for programming language identifiers."
1849 :group 'markdown-faces)
1851 (defface markdown-language-info-face
1852 '((t (:inherit font-lock-string-face)))
1853 "Face for programming language info strings."
1854 :group 'markdown-faces)
1856 (defface markdown-link-face
1857 '((t (:inherit link)))
1858 "Face for links."
1859 :group 'markdown-faces)
1861 (defface markdown-missing-link-face
1862 '((t (:inherit font-lock-warning-face)))
1863 "Face for missing links."
1864 :group 'markdown-faces)
1866 (defface markdown-reference-face
1867 '((t (:inherit markdown-markup-face)))
1868 "Face for link references."
1869 :group 'markdown-faces)
1871 (defface markdown-footnote-marker-face
1872 '((t (:inherit markdown-markup-face)))
1873 "Face for footnote markers."
1874 :group 'markdown-faces)
1876 (defface markdown-footnote-text-face
1877 '((t (:inherit font-lock-comment-face)))
1878 "Face for footnote text."
1879 :group 'markdown-faces)
1881 (defface markdown-url-face
1882 '((t (:inherit font-lock-string-face)))
1883 "Face for URLs that are part of markup.
1884 For example, this applies to URLs in inline links:
1885 [link text](http://example.com/)."
1886 :group 'markdown-faces)
1888 (defface markdown-plain-url-face
1889 '((t (:inherit markdown-link-face)))
1890 "Face for URLs that are also links.
1891 For example, this applies to plain angle bracket URLs:
1892 <http://example.com/>."
1893 :group 'markdown-faces)
1895 (defface markdown-link-title-face
1896 '((t (:inherit font-lock-comment-face)))
1897 "Face for reference link titles."
1898 :group 'markdown-faces)
1900 (defface markdown-line-break-face
1901 '((t (:inherit font-lock-constant-face :underline t)))
1902 "Face for hard line breaks."
1903 :group 'markdown-faces)
1905 (defface markdown-comment-face
1906 '((t (:inherit font-lock-comment-face)))
1907 "Face for HTML comments."
1908 :group 'markdown-faces)
1910 (defface markdown-math-face
1911 '((t (:inherit font-lock-string-face)))
1912 "Face for LaTeX expressions."
1913 :group 'markdown-faces)
1915 (defface markdown-metadata-key-face
1916 '((t (:inherit font-lock-variable-name-face)))
1917 "Face for metadata keys."
1918 :group 'markdown-faces)
1920 (defface markdown-metadata-value-face
1921 '((t (:inherit font-lock-string-face)))
1922 "Face for metadata values."
1923 :group 'markdown-faces)
1925 (defface markdown-gfm-checkbox-face
1926 '((t (:inherit font-lock-builtin-face)))
1927 "Face for GFM checkboxes."
1928 :group 'markdown-faces)
1930 (defface markdown-highlight-face
1931 '((t (:inherit highlight)))
1932 "Face for mouse highlighting."
1933 :group 'markdown-faces)
1935 (defface markdown-hr-face
1936 '((t (:inherit markdown-markup-face)))
1937 "Face for horizontal rules."
1938 :group 'markdown-faces)
1940 (defface markdown-html-tag-name-face
1941 '((t (:inherit font-lock-type-face)))
1942 "Face for HTML tag names."
1943 :group 'markdown-faces)
1945 (defface markdown-html-tag-delimiter-face
1946 '((t (:inherit markdown-markup-face)))
1947 "Face for HTML tag delimiters."
1948 :group 'markdown-faces)
1950 (defface markdown-html-attr-name-face
1951 '((t (:inherit font-lock-variable-name-face)))
1952 "Face for HTML attribute names."
1953 :group 'markdown-faces)
1955 (defface markdown-html-attr-value-face
1956 '((t (:inherit font-lock-string-face)))
1957 "Face for HTML attribute values."
1958 :group 'markdown-faces)
1960 (defface markdown-html-entity-face
1961 '((t (:inherit font-lock-variable-name-face)))
1962 "Face for HTML entities."
1963 :group 'markdown-faces)
1965 (defcustom markdown-header-scaling nil
1966 "Whether to use variable-height faces for headers.
1967 When non-nil, `markdown-header-face' will inherit from
1968 `variable-pitch' and the scaling values in
1969 `markdown-header-scaling-values' will be applied to
1970 headers of levels one through six respectively."
1971 :type 'boolean
1972 :initialize 'custom-initialize-default
1973 :set (lambda (symbol value)
1974 (set-default symbol value)
1975 (markdown-update-header-faces value))
1976 :group 'markdown-faces
1977 :package-version '(markdown-mode . "2.2"))
1979 (defcustom markdown-header-scaling-values
1980 '(2.0 1.7 1.4 1.1 1.0 1.0)
1981 "List of scaling values for headers of level one through six.
1982 Used when `markdown-header-scaling' is non-nil."
1983 :type 'list
1984 :initialize 'custom-initialize-default
1985 :set (lambda (symbol value)
1986 (set-default symbol value)
1987 (markdown-update-header-faces markdown-header-scaling value))
1988 :group 'markdown-faces)
1990 (defun markdown-make-header-faces ()
1991 "Build the faces used for Markdown headers."
1992 (let ((inherit-faces '(font-lock-function-name-face)))
1993 (when markdown-header-scaling
1994 (setq inherit-faces (cons 'variable-pitch inherit-faces)))
1995 (defface markdown-header-face
1996 `((t (:inherit ,inherit-faces :weight bold)))
1997 "Base face for headers."
1998 :group 'markdown-faces))
1999 (dotimes (num 6)
2000 (let* ((num1 (1+ num))
2001 (face-name (intern (format "markdown-header-face-%s" num1)))
2002 (scale (if markdown-header-scaling
2003 (float (nth num markdown-header-scaling-values))
2004 1.0)))
2005 (eval
2006 `(defface ,face-name
2007 '((t (:inherit markdown-header-face :height ,scale)))
2008 (format "Face for level %s headers.
2009 You probably don't want to customize this face directly. Instead
2010 you can customize the base face `markdown-header-face' or the
2011 variable-height variable `markdown-header-scaling'." ,num1)
2012 :group 'markdown-faces)))))
2014 (markdown-make-header-faces)
2016 (defun markdown-update-header-faces (&optional scaling scaling-values)
2017 "Update header faces, depending on if header SCALING is desired.
2018 If so, use given list of SCALING-VALUES relative to the baseline
2019 size of `markdown-header-face'."
2020 (dotimes (num 6)
2021 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num))))
2022 (scale (cond ((not scaling) 1.0)
2023 (scaling-values (float (nth num scaling-values)))
2024 (t (float (nth num markdown-header-scaling-values))))))
2025 (unless (get face-name 'saved-face) ; Don't update customized faces
2026 (set-face-attribute face-name nil :height scale)))))
2028 (defun markdown-syntactic-face (state)
2029 "Return font-lock face for characters with given STATE.
2030 See `font-lock-syntactic-face-function' for details."
2031 (let ((in-comment (nth 4 state)))
2032 (cond
2033 (in-comment 'markdown-comment-face)
2034 (t nil))))
2036 (defcustom markdown-list-item-bullets
2037 '("●" "◎" "○" "◆" "◇" "►" "•")
2038 "List of bullets to use for unordered lists.
2039 It can contain any number of symbols, which will be repeated.
2040 Depending on your font, some reasonable choices are:
2041 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸."
2042 :group 'markdown
2043 :type '(repeat (string :tag "Bullet character"))
2044 :package-version '(markdown-mode . "2.3"))
2046 (defun markdown--footnote-marker-properties ()
2047 "Return a font-lock facespec expression for footnote marker text."
2048 `(face markdown-footnote-marker-face
2049 ,@(when markdown-hide-markup
2050 `(display ,markdown-footnote-display))))
2052 (defun markdown--pandoc-inline-footnote-properties ()
2053 "Return a font-lock facespec expression for Pandoc inline footnote text."
2054 `(face markdown-footnote-text-face
2055 ,@(when markdown-hide-markup
2056 `(display ,markdown-footnote-display))))
2058 (defvar markdown-mode-font-lock-keywords
2059 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face)))
2060 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face)))
2061 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face)
2062 (2 'markdown-markup-face)
2063 (3 'markdown-metadata-value-face)))
2064 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties)
2065 (2 markdown-markup-properties nil t)
2066 (3 markdown-language-keyword-properties nil t)
2067 (4 markdown-language-info-properties nil t)
2068 (5 markdown-markup-properties nil t)))
2069 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties)))
2070 (markdown-fontify-gfm-code-blocks)
2071 (markdown-fontify-tables)
2072 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties)
2073 (2 markdown-markup-properties nil t)
2074 (3 markdown-language-keyword-properties nil t)
2075 (4 markdown-language-info-properties nil t)
2076 (5 markdown-markup-properties nil t)))
2077 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties)))
2078 (markdown-fontify-fenced-code-blocks)
2079 (markdown-match-pre-blocks . ((0 'markdown-pre-face)))
2080 (markdown-fontify-headings)
2081 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face)
2082 (2 'markdown-markup-face)
2083 (3 'markdown-metadata-value-face)))
2084 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face)
2085 (2 'markdown-markup-face)
2086 (3 'markdown-metadata-value-face)))
2087 (markdown-fontify-hrs)
2088 (markdown-match-code . ((1 markdown-markup-properties prepend)
2089 (2 'markdown-inline-code-face prepend)
2090 (3 markdown-markup-properties prepend)))
2091 (,markdown-regex-kbd . ((1 markdown-markup-properties)
2092 (2 'markdown-inline-code-face)
2093 (3 markdown-markup-properties)))
2094 (markdown-fontify-angle-uris)
2095 (,markdown-regex-email . 'markdown-plain-url-face)
2096 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t)
2097 (2 'markdown-html-tag-name-face t)
2098 (3 'markdown-html-tag-delimiter-face t)
2099 ;; Anchored matcher for HTML tag attributes
2100 (,markdown-regex-html-attr
2101 ;; Before searching, move past tag
2102 ;; name; set limit at tag close.
2103 (progn
2104 (goto-char (match-end 2)) (match-end 3))
2106 . ((1 'markdown-html-attr-name-face)
2107 (3 'markdown-html-tag-delimiter-face nil t)
2108 (4 'markdown-html-attr-value-face nil t)))))
2109 (,markdown-regex-html-entity . 'markdown-html-entity-face)
2110 (markdown-fontify-list-items)
2111 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^
2112 (2 (markdown--footnote-marker-properties)) ; label
2113 (3 markdown-markup-properties))) ; ]
2114 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^
2115 (2 markdown-markup-properties) ; [
2116 (3 (markdown--pandoc-inline-footnote-properties)) ; text
2117 (4 markdown-markup-properties))) ; ]
2118 (markdown-match-includes . ((1 markdown-markup-properties)
2119 (2 markdown-markup-properties nil t)
2120 (3 markdown-include-title-properties nil t)
2121 (4 markdown-markup-properties nil t)
2122 (5 markdown-markup-properties)
2123 (6 'markdown-url-face)
2124 (7 markdown-markup-properties)))
2125 (markdown-fontify-inline-links)
2126 (markdown-fontify-reference-links)
2127 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [
2128 (2 'markdown-reference-face) ; label
2129 (3 'markdown-markup-face) ; ]
2130 (4 'markdown-markup-face) ; :
2131 (5 'markdown-url-face) ; url
2132 (6 'markdown-link-title-face))) ; "title" (optional)
2133 (markdown-fontify-plain-uris)
2134 ;; Math mode $..$
2135 (markdown-match-math-single . ((1 'markdown-markup-face prepend)
2136 (2 'markdown-math-face append)
2137 (3 'markdown-markup-face prepend)))
2138 ;; Math mode $$..$$
2139 (markdown-match-math-double . ((1 'markdown-markup-face prepend)
2140 (2 'markdown-math-face append)
2141 (3 'markdown-markup-face prepend)))
2142 ;; Math mode \[..\] and \\[..\\]
2143 (markdown-match-math-display . ((1 'markdown-markup-face prepend)
2144 (3 'markdown-math-face append)
2145 (4 'markdown-markup-face prepend)))
2146 (markdown-match-bold . ((1 markdown-markup-properties prepend)
2147 (2 'markdown-bold-face append)
2148 (3 markdown-markup-properties prepend)))
2149 (markdown-match-italic . ((1 markdown-markup-properties prepend)
2150 (2 'markdown-italic-face append)
2151 (3 markdown-markup-properties prepend)))
2152 (,markdown-regex-strike-through . ((3 markdown-markup-properties)
2153 (4 'markdown-strike-through-face)
2154 (5 markdown-markup-properties)))
2155 (,markdown-regex-line-break . (1 'markdown-line-break-face prepend))
2156 (markdown-fontify-sub-superscripts)
2157 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend)))
2158 (markdown-match-leanpub-sections . ((0 markdown-markup-properties)))
2159 (markdown-fontify-blockquotes)
2160 (markdown-match-wiki-link . ((0 'markdown-link-face prepend))))
2161 "Syntax highlighting for Markdown files.")
2163 ;; Footnotes
2164 (defvar-local markdown-footnote-counter 0
2165 "Counter for footnote numbers.")
2167 (defconst markdown-footnote-chars
2168 "[[:alnum:]-]"
2169 "Regular expression matching any character for a footnote identifier.")
2171 (defconst markdown-regex-footnote-definition
2172 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)")
2173 "Regular expression matching a footnote definition, capturing the label.")
2176 ;;; Compatibility =============================================================
2178 (defun markdown-flyspell-check-word-p ()
2179 "Return t if `flyspell' should check word just before point.
2180 Used for `flyspell-generic-check-word-predicate'."
2181 (save-excursion
2182 (goto-char (1- (point)))
2183 ;; https://github.com/jrblevin/markdown-mode/issues/560
2184 ;; enable spell check YAML meta data
2185 (if (or (and (markdown-code-block-at-point-p)
2186 (not (markdown-text-property-at-point 'markdown-yaml-metadata-section)))
2187 (markdown-inline-code-at-point-p)
2188 (markdown-in-comment-p)
2189 (markdown--face-p (point) '(markdown-reference-face
2190 markdown-markup-face
2191 markdown-plain-url-face
2192 markdown-inline-code-face
2193 markdown-url-face)))
2194 (prog1 nil
2195 ;; If flyspell overlay is put, then remove it
2196 (let ((bounds (bounds-of-thing-at-point 'word)))
2197 (when bounds
2198 (cl-loop for ov in (overlays-in (car bounds) (cdr bounds))
2199 when (overlay-get ov 'flyspell-overlay)
2201 (delete-overlay ov)))))
2202 t)))
2205 ;;; Markdown Parsing Functions ================================================
2207 (defun markdown-cur-line-blank-p ()
2208 "Return t if the current line is blank and nil otherwise."
2209 (save-excursion
2210 (beginning-of-line)
2211 (looking-at-p markdown-regex-blank-line)))
2213 (defun markdown-prev-line-blank ()
2214 "Return t if the previous line is blank and nil otherwise.
2215 If we are at the first line, then consider the previous line to be blank."
2216 (or (= (line-beginning-position) (point-min))
2217 (save-excursion
2218 (forward-line -1)
2219 (looking-at markdown-regex-blank-line))))
2221 (defun markdown-prev-line-blank-p ()
2222 "Like `markdown-prev-line-blank', but preserve `match-data'."
2223 (save-match-data (markdown-prev-line-blank)))
2225 (defun markdown-next-line-blank-p ()
2226 "Return t if the next line is blank and nil otherwise.
2227 If we are at the last line, then consider the next line to be blank."
2228 (or (= (line-end-position) (point-max))
2229 (save-excursion
2230 (forward-line 1)
2231 (markdown-cur-line-blank-p))))
2233 (defun markdown-prev-line-indent ()
2234 "Return the number of leading whitespace characters in the previous line.
2235 Return 0 if the current line is the first line in the buffer."
2236 (save-excursion
2237 (if (= (line-beginning-position) (point-min))
2239 (forward-line -1)
2240 (current-indentation))))
2242 (defun markdown-next-line-indent ()
2243 "Return the number of leading whitespace characters in the next line.
2244 Return 0 if line is the last line in the buffer."
2245 (save-excursion
2246 (if (= (line-end-position) (point-max))
2248 (forward-line 1)
2249 (current-indentation))))
2251 (defun markdown-new-baseline ()
2252 "Determine if the current line begins a new baseline level.
2253 Assume point is positioned at beginning of line."
2254 (or (looking-at markdown-regex-header)
2255 (looking-at markdown-regex-hr)
2256 (and (= (current-indentation) 0)
2257 (not (looking-at markdown-regex-list))
2258 (markdown-prev-line-blank))))
2260 (defun markdown-search-backward-baseline ()
2261 "Search backward baseline point with no indentation and not a list item."
2262 (end-of-line)
2263 (let (stop)
2264 (while (not (or stop (bobp)))
2265 (re-search-backward markdown-regex-block-separator-noindent nil t)
2266 (when (match-end 2)
2267 (goto-char (match-end 2))
2268 (cond
2269 ((markdown-new-baseline)
2270 (setq stop t))
2271 ((looking-at-p markdown-regex-list)
2272 (setq stop nil))
2273 (t (setq stop t)))))))
2275 (defun markdown-update-list-levels (marker indent levels)
2276 "Update list levels given list MARKER, block INDENT, and current LEVELS.
2277 Here, MARKER is a string representing the type of list, INDENT is an integer
2278 giving the indentation, in spaces, of the current block, and LEVELS is a
2279 list of the indentation levels of parent list items. When LEVELS is nil,
2280 it means we are at baseline (not inside of a nested list)."
2281 (cond
2282 ;; New list item at baseline.
2283 ((and marker (null levels))
2284 (setq levels (list indent)))
2285 ;; List item with greater indentation (four or more spaces).
2286 ;; Increase list level.
2287 ((and marker (>= indent (+ (car levels) markdown-list-indent-width)))
2288 (setq levels (cons indent levels)))
2289 ;; List item with greater or equal indentation (less than four spaces).
2290 ;; Do not increase list level.
2291 ((and marker (>= indent (car levels)))
2292 levels)
2293 ;; Lesser indentation level.
2294 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
2295 ;; indentation could move back more than one list level). Note
2296 ;; that this block need not be the beginning of list item.
2297 ((< indent (car levels))
2298 (while (and (> (length levels) 1)
2299 (< indent (+ (cadr levels) markdown-list-indent-width)))
2300 (setq levels (cdr levels)))
2301 levels)
2302 ;; Otherwise, do nothing.
2303 (t levels)))
2305 (defun markdown-calculate-list-levels ()
2306 "Calculate list levels at point.
2307 Return a list of the form (n1 n2 n3 ...) where n1 is the
2308 indentation of the deepest nested list item in the branch of
2309 the list at the point, n2 is the indentation of the parent
2310 list item, and so on. The depth of the list item is therefore
2311 the length of the returned list. If the point is not at or
2312 immediately after a list item, return nil."
2313 (save-excursion
2314 (let ((first (point)) levels indent pre-regexp)
2315 ;; Find a baseline point with zero list indentation
2316 (markdown-search-backward-baseline)
2317 ;; Search for all list items between baseline and LOC
2318 (while (and (< (point) first)
2319 (re-search-forward markdown-regex-list first t))
2320 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels))))
2321 (beginning-of-line)
2322 (cond
2323 ;; Make sure this is not a header or hr
2324 ((markdown-new-baseline) (setq levels nil))
2325 ;; Make sure this is not a line from a pre block
2326 ((looking-at-p pre-regexp))
2327 ;; If not, then update levels
2329 (setq indent (current-indentation))
2330 (setq levels (markdown-update-list-levels (match-string 2)
2331 indent levels))))
2332 (end-of-line))
2333 levels)))
2335 (defun markdown-prev-list-item (level)
2336 "Search backward from point for a list item with indentation LEVEL.
2337 Set point to the beginning of the item, and return point, or nil
2338 upon failure."
2339 (let (bounds indent prev)
2340 (setq prev (point))
2341 (forward-line -1)
2342 (setq indent (current-indentation))
2343 (while
2344 (cond
2345 ;; List item
2346 ((and (looking-at-p markdown-regex-list)
2347 (setq bounds (markdown-cur-list-item-bounds)))
2348 (cond
2349 ;; Stop and return point at item of equal indentation
2350 ((= (nth 3 bounds) level)
2351 (setq prev (point))
2352 nil)
2353 ;; Stop and return nil at item with lesser indentation
2354 ((< (nth 3 bounds) level)
2355 (setq prev nil)
2356 nil)
2357 ;; Stop at beginning of buffer
2358 ((bobp) (setq prev nil))
2359 ;; Continue at item with greater indentation
2360 ((> (nth 3 bounds) level) t)))
2361 ;; Stop at beginning of buffer
2362 ((bobp) (setq prev nil))
2363 ;; Continue if current line is blank
2364 ((markdown-cur-line-blank-p) t)
2365 ;; Continue while indentation is the same or greater
2366 ((>= indent level) t)
2367 ;; Stop if current indentation is less than list item
2368 ;; and the next is blank
2369 ((and (< indent level)
2370 (markdown-next-line-blank-p))
2371 (setq prev nil))
2372 ;; Stop at a header
2373 ((looking-at-p markdown-regex-header) (setq prev nil))
2374 ;; Stop at a horizontal rule
2375 ((looking-at-p markdown-regex-hr) (setq prev nil))
2376 ;; Otherwise, continue.
2377 (t t))
2378 (forward-line -1)
2379 (setq indent (current-indentation)))
2380 prev))
2382 (defun markdown-next-list-item (level)
2383 "Search forward from point for the next list item with indentation LEVEL.
2384 Set point to the beginning of the item, and return point, or nil
2385 upon failure."
2386 (let (bounds indent next)
2387 (setq next (point))
2388 (if (looking-at markdown-regex-header-setext)
2389 (goto-char (match-end 0)))
2390 (forward-line)
2391 (setq indent (current-indentation))
2392 (while
2393 (cond
2394 ;; Stop at end of the buffer.
2395 ((eobp) nil)
2396 ;; Continue if the current line is blank
2397 ((markdown-cur-line-blank-p) t)
2398 ;; List item
2399 ((and (looking-at-p markdown-regex-list)
2400 (setq bounds (markdown-cur-list-item-bounds)))
2401 (cond
2402 ;; Continue at item with greater indentation
2403 ((> (nth 3 bounds) level) t)
2404 ;; Stop and return point at item of equal indentation
2405 ((= (nth 3 bounds) level)
2406 (setq next (point))
2407 nil)
2408 ;; Stop and return nil at item with lesser indentation
2409 ((< (nth 3 bounds) level)
2410 (setq next nil)
2411 nil)))
2412 ;; Continue while indentation is the same or greater
2413 ((>= indent level) t)
2414 ;; Stop if current indentation is less than list item
2415 ;; and the previous line was blank.
2416 ((and (< indent level)
2417 (markdown-prev-line-blank-p))
2418 (setq next nil))
2419 ;; Stop at a header
2420 ((looking-at-p markdown-regex-header) (setq next nil))
2421 ;; Stop at a horizontal rule
2422 ((looking-at-p markdown-regex-hr) (setq next nil))
2423 ;; Otherwise, continue.
2424 (t t))
2425 (forward-line)
2426 (setq indent (current-indentation)))
2427 next))
2429 (defun markdown-cur-list-item-end (level)
2430 "Move to end of list item with pre-marker indentation LEVEL.
2431 Return the point at the end when a list item was found at the
2432 original point. If the point is not in a list item, do nothing."
2433 (let (indent)
2434 (forward-line)
2435 (setq indent (current-indentation))
2436 (while
2437 (cond
2438 ;; Stop at end of the buffer.
2439 ((eobp) nil)
2440 ;; Continue while indentation is the same or greater
2441 ((>= indent level) t)
2442 ;; Continue if the current line is blank
2443 ((looking-at markdown-regex-blank-line) t)
2444 ;; Stop if current indentation is less than list item
2445 ;; and the previous line was blank.
2446 ((and (< indent level)
2447 (markdown-prev-line-blank))
2448 nil)
2449 ;; Stop at a new list items of the same or lesser
2450 ;; indentation, headings, and horizontal rules.
2451 ((looking-at (concat "\\(?:" markdown-regex-list
2452 "\\|" markdown-regex-header
2453 "\\|" markdown-regex-hr "\\)"))
2454 nil)
2455 ;; Otherwise, continue.
2456 (t t))
2457 (forward-line)
2458 (setq indent (current-indentation)))
2459 ;; Don't skip over whitespace for empty list items (marker and
2460 ;; whitespace only), just move to end of whitespace.
2461 (if (save-excursion
2462 (beginning-of-line)
2463 (looking-at (concat markdown-regex-list "[ \t]*$")))
2464 (goto-char (match-end 3))
2465 (skip-chars-backward " \t\n"))
2466 (end-of-line)
2467 (point)))
2469 (defun markdown-cur-list-item-bounds ()
2470 "Return bounds for list item at point.
2471 Return a list of the following form:
2473 (begin end indent nonlist-indent marker checkbox match)
2475 The named components are:
2477 - begin: Position of beginning of list item, including leading indentation.
2478 - end: Position of the end of the list item, including list item text.
2479 - indent: Number of characters of indentation before list marker (an integer).
2480 - nonlist-indent: Number characters of indentation, list
2481 marker, and whitespace following list marker (an integer).
2482 - marker: String containing the list marker and following whitespace
2483 (e.g., \"- \" or \"* \").
2484 - checkbox: String containing the GFM checkbox portion, if any,
2485 including any trailing whitespace before the text
2486 begins (e.g., \"[x] \").
2487 - match: match data for markdown-regex-list
2489 As an example, for the following unordered list item
2491 - item
2493 the returned list would be
2495 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
2497 If the point is not inside a list item, return nil."
2498 (car (get-text-property (point-at-bol) 'markdown-list-item)))
2500 (defun markdown-list-item-at-point-p ()
2501 "Return t if there is a list item at the point and nil otherwise."
2502 (save-match-data (markdown-cur-list-item-bounds)))
2504 (defun markdown-prev-list-item-bounds ()
2505 "Return bounds of previous item in the same list of any level.
2506 The return value has the same form as that of
2507 `markdown-cur-list-item-bounds'."
2508 (save-excursion
2509 (let ((cur-bounds (markdown-cur-list-item-bounds))
2510 (beginning-of-list (save-excursion (markdown-beginning-of-list)))
2511 stop)
2512 (when cur-bounds
2513 (goto-char (nth 0 cur-bounds))
2514 (while (and (not stop) (not (bobp))
2515 (re-search-backward markdown-regex-list
2516 beginning-of-list t))
2517 (unless (or (looking-at markdown-regex-hr)
2518 (markdown-code-block-at-point-p))
2519 (setq stop (point))))
2520 (markdown-cur-list-item-bounds)))))
2522 (defun markdown-next-list-item-bounds ()
2523 "Return bounds of next item in the same list of any level.
2524 The return value has the same form as that of
2525 `markdown-cur-list-item-bounds'."
2526 (save-excursion
2527 (let ((cur-bounds (markdown-cur-list-item-bounds))
2528 (end-of-list (save-excursion (markdown-end-of-list)))
2529 stop)
2530 (when cur-bounds
2531 (goto-char (nth 0 cur-bounds))
2532 (end-of-line)
2533 (while (and (not stop) (not (eobp))
2534 (re-search-forward markdown-regex-list
2535 end-of-list t))
2536 (unless (or (looking-at markdown-regex-hr)
2537 (markdown-code-block-at-point-p))
2538 (setq stop (point))))
2539 (when stop
2540 (markdown-cur-list-item-bounds))))))
2542 (defun markdown-beginning-of-list ()
2543 "Move point to beginning of list at point, if any."
2544 (interactive)
2545 (let ((orig-point (point))
2546 (list-begin (save-excursion
2547 (markdown-search-backward-baseline)
2548 ;; Stop at next list item, regardless of the indentation.
2549 (markdown-next-list-item (point-max))
2550 (when (looking-at markdown-regex-list)
2551 (point)))))
2552 (when (and list-begin (<= list-begin orig-point))
2553 (goto-char list-begin))))
2555 (defun markdown-end-of-list ()
2556 "Move point to end of list at point, if any."
2557 (interactive)
2558 (let ((start (point))
2559 (end (save-excursion
2560 (when (markdown-beginning-of-list)
2561 ;; Items can't have nonlist-indent <= 1, so this
2562 ;; moves past all list items.
2563 (markdown-next-list-item 1)
2564 (skip-syntax-backward "-")
2565 (unless (eobp) (forward-char 1))
2566 (point)))))
2567 (when (and end (>= end start))
2568 (goto-char end))))
2570 (defun markdown-up-list ()
2571 "Move point to beginning of parent list item."
2572 (interactive)
2573 (let ((cur-bounds (markdown-cur-list-item-bounds)))
2574 (when cur-bounds
2575 (markdown-prev-list-item (1- (nth 3 cur-bounds)))
2576 (let ((up-bounds (markdown-cur-list-item-bounds)))
2577 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds)))
2578 (point))))))
2580 (defun markdown-bounds-of-thing-at-point (thing)
2581 "Call `bounds-of-thing-at-point' for THING with slight modifications.
2582 Does not include trailing newlines when THING is 'line. Handles the
2583 end of buffer case by setting both endpoints equal to the value of
2584 `point-max', since an empty region will trigger empty markup insertion.
2585 Return bounds of form (beg . end) if THING is found, or nil otherwise."
2586 (let* ((bounds (bounds-of-thing-at-point thing))
2587 (a (car bounds))
2588 (b (cdr bounds)))
2589 (when bounds
2590 (when (eq thing 'line)
2591 (cond ((and (eobp) (markdown-cur-line-blank-p))
2592 (setq a b))
2593 ((char-equal (char-before b) ?\^J)
2594 (setq b (1- b)))))
2595 (cons a b))))
2597 (defun markdown-reference-definition (reference)
2598 "Find out whether Markdown REFERENCE is defined.
2599 REFERENCE should not include the square brackets.
2600 When REFERENCE is defined, return a list of the form (text start end)
2601 containing the definition text itself followed by the start and end
2602 locations of the text. Otherwise, return nil.
2603 Leave match data for `markdown-regex-reference-definition'
2604 intact additional processing."
2605 (let ((reference (downcase reference)))
2606 (save-excursion
2607 (goto-char (point-min))
2608 (catch 'found
2609 (while (re-search-forward markdown-regex-reference-definition nil t)
2610 (when (string= reference (downcase (match-string-no-properties 2)))
2611 (throw 'found
2612 (list (match-string-no-properties 5)
2613 (match-beginning 5) (match-end 5)))))))))
2615 (defun markdown-get-defined-references ()
2616 "Return all defined reference labels and their line numbers (not including square brackets)."
2617 (save-excursion
2618 (goto-char (point-min))
2619 (let (refs)
2620 (while (re-search-forward markdown-regex-reference-definition nil t)
2621 (let ((target (match-string-no-properties 2)))
2622 (cl-pushnew
2623 (cons (downcase target)
2624 (markdown-line-number-at-pos (match-beginning 2)))
2625 refs :test #'equal :key #'car)))
2626 (reverse refs))))
2628 (defun markdown-get-used-uris ()
2629 "Return a list of all used URIs in the buffer."
2630 (save-excursion
2631 (goto-char (point-min))
2632 (let (uris)
2633 (while (re-search-forward
2634 (concat "\\(?:" markdown-regex-link-inline
2635 "\\|" markdown-regex-angle-uri
2636 "\\|" markdown-regex-uri
2637 "\\|" markdown-regex-email
2638 "\\)")
2639 nil t)
2640 (unless (or (markdown-inline-code-at-point-p)
2641 (markdown-code-block-at-point-p))
2642 (cl-pushnew (or (match-string-no-properties 6)
2643 (match-string-no-properties 10)
2644 (match-string-no-properties 12)
2645 (match-string-no-properties 13))
2646 uris :test #'equal)))
2647 (reverse uris))))
2649 (defun markdown-inline-code-at-pos (pos)
2650 "Return non-nil if there is an inline code fragment at POS.
2651 Return nil otherwise. Set match data according to
2652 `markdown-match-code' upon success.
2653 This function searches the block for a code fragment that
2654 contains the point using `markdown-match-code'. We do this
2655 because `thing-at-point-looking-at' does not work reliably with
2656 `markdown-regex-code'.
2658 The match data is set as follows:
2659 Group 1 matches the opening backquotes.
2660 Group 2 matches the code fragment itself, without backquotes.
2661 Group 3 matches the closing backquotes."
2662 (save-excursion
2663 (goto-char pos)
2664 (let ((old-point (point))
2665 (end-of-block (progn (markdown-end-of-text-block) (point)))
2666 found)
2667 (markdown-beginning-of-text-block)
2668 (while (and (markdown-match-code end-of-block)
2669 (setq found t)
2670 (< (match-end 0) old-point)))
2671 (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1)))
2672 (and found ; matched something
2673 (<= (match-beginning match-group) old-point) ; match contains old-point
2674 (> (match-end 0) old-point))))))
2676 (defun markdown-inline-code-at-pos-p (pos)
2677 "Return non-nil if there is an inline code fragment at POS.
2678 Like `markdown-inline-code-at-pos`, but preserves match data."
2679 (save-match-data (markdown-inline-code-at-pos pos)))
2681 (defun markdown-inline-code-at-point ()
2682 "Return non-nil if the point is at an inline code fragment.
2683 See `markdown-inline-code-at-pos' for details."
2684 (markdown-inline-code-at-pos (point)))
2686 (defun markdown-inline-code-at-point-p (&optional pos)
2687 "Return non-nil if there is inline code at the POS.
2688 This is a predicate function counterpart to
2689 `markdown-inline-code-at-point' which does not modify the match
2690 data. See `markdown-code-block-at-point-p' for code blocks."
2691 (save-match-data (markdown-inline-code-at-pos (or pos (point)))))
2693 (defun markdown-code-block-at-pos (pos)
2694 "Return match data list if there is a code block at POS.
2695 Uses text properties at the beginning of the line position.
2696 This includes pre blocks, tilde-fenced code blocks, and GFM
2697 quoted code blocks. Return nil otherwise."
2698 (let ((bol (save-excursion (goto-char pos) (point-at-bol))))
2699 (or (get-text-property bol 'markdown-pre)
2700 (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos))
2701 (second (cl-second bounds)))
2702 (if second
2703 ;; chunks are right open
2704 (when (< pos second)
2705 bounds)
2706 bounds)))))
2708 ;; Function was renamed to emphasize that it does not modify match-data.
2709 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p)
2711 (defun markdown-code-block-at-point-p (&optional pos)
2712 "Return non-nil if there is a code block at the POS.
2713 This includes pre blocks, tilde-fenced code blocks, and GFM
2714 quoted code blocks. This function does not modify the match
2715 data. See `markdown-inline-code-at-point-p' for inline code."
2716 (save-match-data (markdown-code-block-at-pos (or pos (point)))))
2718 (defun markdown-heading-at-point (&optional pos)
2719 "Return non-nil if there is a heading at the POS.
2720 Set match data for `markdown-regex-header'."
2721 (let ((match-data (get-text-property (or pos (point)) 'markdown-heading)))
2722 (when match-data
2723 (set-match-data match-data)
2724 t)))
2726 (defun markdown-pipe-at-bol-p ()
2727 "Return non-nil if the line begins with a pipe symbol.
2728 This may be useful for tables and Pandoc's line_blocks extension."
2729 (char-equal (char-after (point-at-bol)) ?|))
2732 ;;; Markdown Font Lock Matching Functions =====================================
2734 (defun markdown-range-property-any (begin end prop prop-values)
2735 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
2736 Also returns t if PROP is a list containing one of the PROP-VALUES.
2737 Return nil otherwise."
2738 (let (props)
2739 (catch 'found
2740 (dolist (loc (number-sequence begin end))
2741 (when (setq props (get-text-property loc prop))
2742 (cond ((listp props)
2743 ;; props is a list, check for membership
2744 (dolist (val prop-values)
2745 (when (memq val props) (throw 'found loc))))
2747 ;; props is a scalar, check for equality
2748 (dolist (val prop-values)
2749 (when (eq val props) (throw 'found loc))))))))))
2751 (defun markdown-range-properties-exist (begin end props)
2752 (cl-loop
2753 for loc in (number-sequence begin end)
2754 with result = nil
2755 while (not
2756 (setq result
2757 (cl-some (lambda (prop) (get-text-property loc prop)) props)))
2758 finally return result))
2760 (defun markdown-match-inline-generic (regex last &optional faceless)
2761 "Match inline REGEX from the point to LAST.
2762 When FACELESS is non-nil, do not return matches where faces have been applied."
2763 (when (re-search-forward regex last t)
2764 (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
2765 (face (and faceless (text-property-not-all
2766 (match-beginning 0) (match-end 0) 'face nil))))
2767 (cond
2768 ;; In code block: move past it and recursively search again
2769 (bounds
2770 (when (< (goto-char (cl-second bounds)) last)
2771 (markdown-match-inline-generic regex last faceless)))
2772 ;; When faces are found in the match range, skip over the match and
2773 ;; recursively search again.
2774 (face
2775 (when (< (goto-char (match-end 0)) last)
2776 (markdown-match-inline-generic regex last faceless)))
2777 ;; Keep match data and return t when in bounds.
2779 (<= (match-end 0) last))))))
2781 (defun markdown-match-code (last)
2782 "Match inline code fragments from point to LAST."
2783 (unless (bobp)
2784 (backward-char 1))
2785 (when (markdown-search-until-condition
2786 (lambda ()
2787 (and
2788 ;; Advance point in case of failure, but without exceeding last.
2789 (goto-char (min (1+ (match-beginning 1)) last))
2790 (not (markdown-in-comment-p (match-beginning 1)))
2791 (not (markdown-in-comment-p (match-end 1)))
2792 (not (markdown-code-block-at-pos (match-beginning 1)))))
2793 markdown-regex-code last t)
2794 (set-match-data (list (match-beginning 1) (match-end 1)
2795 (match-beginning 2) (match-end 2)
2796 (match-beginning 3) (match-end 3)
2797 (match-beginning 4) (match-end 4)))
2798 (goto-char (min (1+ (match-end 0)) last (point-max)))
2801 (defun markdown--gfm-markup-underscore-p (begin end)
2802 (let ((is-underscore (eql (char-after begin) ?_)))
2803 (if (not is-underscore)
2805 (save-excursion
2806 (save-match-data
2807 (goto-char begin)
2808 (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin))
2809 (progn
2810 (goto-char end)
2811 (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)"))))))))
2813 (defun markdown-match-bold (last)
2814 "Match inline bold from the point to LAST."
2815 (when (markdown-match-inline-generic markdown-regex-bold last)
2816 (let ((is-gfm (derived-mode-p 'gfm-mode))
2817 (begin (match-beginning 2))
2818 (end (match-end 2)))
2819 (if (or (markdown-inline-code-at-pos-p begin)
2820 (markdown-inline-code-at-pos-p end)
2821 (markdown-in-comment-p)
2822 (markdown-range-property-any
2823 begin begin 'face '(markdown-url-face
2824 markdown-plain-url-face))
2825 (markdown-range-property-any
2826 begin end 'face '(markdown-hr-face
2827 markdown-math-face))
2828 (and is-gfm (not (markdown--gfm-markup-underscore-p begin end))))
2829 (progn (goto-char (min (1+ begin) last))
2830 (when (< (point) last)
2831 (markdown-match-bold last)))
2832 (set-match-data (list (match-beginning 2) (match-end 2)
2833 (match-beginning 3) (match-end 3)
2834 (match-beginning 4) (match-end 4)
2835 (match-beginning 5) (match-end 5)))
2836 t))))
2838 (defun markdown-match-italic (last)
2839 "Match inline italics from the point to LAST."
2840 (let* ((is-gfm (derived-mode-p 'gfm-mode))
2841 (regex (if is-gfm
2842 markdown-regex-gfm-italic
2843 markdown-regex-italic)))
2844 (when (and (markdown-match-inline-generic regex last)
2845 (not (markdown--face-p
2846 (match-beginning 1)
2847 '(markdown-html-attr-name-face markdown-html-attr-value-face))))
2848 (let ((begin (match-beginning 1))
2849 (end (match-end 1))
2850 (close-end (match-end 4)))
2851 (if (or (eql (char-before begin) (char-after begin))
2852 (markdown-inline-code-at-pos-p begin)
2853 (markdown-inline-code-at-pos-p (1- end))
2854 (markdown-in-comment-p)
2855 (markdown-range-property-any
2856 begin begin 'face '(markdown-url-face
2857 markdown-plain-url-face))
2858 (markdown-range-property-any
2859 begin end 'face '(markdown-bold-face
2860 markdown-list-face
2861 markdown-hr-face
2862 markdown-math-face))
2863 (and is-gfm
2864 (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case
2865 (not (markdown--gfm-markup-underscore-p begin close-end)))))
2866 (progn (goto-char (min (1+ begin) last))
2867 (when (< (point) last)
2868 (markdown-match-italic last)))
2869 (set-match-data (list (match-beginning 1) (match-end 1)
2870 (match-beginning 2) (match-end 2)
2871 (match-beginning 3) (match-end 3)
2872 (match-beginning 4) (match-end 4)))
2873 t)))))
2875 (defun markdown-match-math-generic (regex last)
2876 "Match REGEX from point to LAST.
2877 REGEX is either `markdown-regex-math-inline-single' for matching
2878 $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
2879 (when (markdown-match-inline-generic regex last)
2880 (let ((begin (match-beginning 1)) (end (match-end 1)))
2881 (prog1
2882 (if (or (markdown-range-property-any
2883 begin end 'face
2884 '(markdown-inline-code-face markdown-bold-face))
2885 (markdown-range-properties-exist
2886 begin end
2887 (markdown-get-fenced-block-middle-properties)))
2888 (markdown-match-math-generic regex last)
2890 (goto-char (1+ (match-end 0)))))))
2892 (defun markdown-match-list-items (last)
2893 "Match list items from point to LAST."
2894 (let* ((first (point))
2895 (pos first)
2896 (prop 'markdown-list-item)
2897 (bounds (car (get-text-property pos prop))))
2898 (while
2899 (and (or (null (setq bounds (car (get-text-property pos prop))))
2900 (< (cl-first bounds) pos))
2901 (< (point) last)
2902 (setq pos (next-single-property-change pos prop nil last))
2903 (goto-char pos)))
2904 (when bounds
2905 (set-match-data (cl-seventh bounds))
2906 ;; Step at least one character beyond point. Otherwise
2907 ;; `font-lock-fontify-keywords-region' infloops.
2908 (goto-char (min (1+ (max (point-at-eol) first))
2909 (point-max)))
2910 t)))
2912 (defun markdown-match-math-single (last)
2913 "Match single quoted $..$ math from point to LAST."
2914 (when markdown-enable-math
2915 (when (and (char-equal (char-after) ?$)
2916 (not (bolp))
2917 (not (char-equal (char-before) ?\\))
2918 (not (char-equal (char-before) ?$)))
2919 (forward-char -1))
2920 (markdown-match-math-generic markdown-regex-math-inline-single last)))
2922 (defun markdown-match-math-double (last)
2923 "Match double quoted $$..$$ math from point to LAST."
2924 (when markdown-enable-math
2925 (when (and (char-equal (char-after) ?$)
2926 (char-equal (char-after (1+ (point))) ?$)
2927 (not (bolp))
2928 (not (char-equal (char-before) ?\\))
2929 (not (char-equal (char-before) ?$)))
2930 (forward-char -1))
2931 (markdown-match-math-generic markdown-regex-math-inline-double last)))
2933 (defun markdown-match-math-display (last)
2934 "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
2935 (when markdown-enable-math
2936 (markdown-match-math-generic markdown-regex-math-display last)))
2938 (defun markdown-match-propertized-text (property last)
2939 "Match text with PROPERTY from point to LAST.
2940 Restore match data previously stored in PROPERTY."
2941 (let ((saved (get-text-property (point) property))
2942 pos)
2943 (unless saved
2944 (setq pos (next-single-property-change (point) property nil last))
2945 (unless (= pos last)
2946 (setq saved (get-text-property pos property))))
2947 (when saved
2948 (set-match-data saved)
2949 ;; Step at least one character beyond point. Otherwise
2950 ;; `font-lock-fontify-keywords-region' infloops.
2951 (goto-char (min (1+ (max (match-end 0) (point)))
2952 (point-max)))
2953 saved)))
2955 (defun markdown-match-pre-blocks (last)
2956 "Match preformatted blocks from point to LAST.
2957 Use data stored in 'markdown-pre text property during syntax
2958 analysis."
2959 (markdown-match-propertized-text 'markdown-pre last))
2961 (defun markdown-match-gfm-code-blocks (last)
2962 "Match GFM quoted code blocks from point to LAST.
2963 Use data stored in 'markdown-gfm-code text property during syntax
2964 analysis."
2965 (markdown-match-propertized-text 'markdown-gfm-code last))
2967 (defun markdown-match-gfm-open-code-blocks (last)
2968 (markdown-match-propertized-text 'markdown-gfm-block-begin last))
2970 (defun markdown-match-gfm-close-code-blocks (last)
2971 (markdown-match-propertized-text 'markdown-gfm-block-end last))
2973 (defun markdown-match-fenced-code-blocks (last)
2974 "Match fenced code blocks from the point to LAST."
2975 (markdown-match-propertized-text 'markdown-fenced-code last))
2977 (defun markdown-match-fenced-start-code-block (last)
2978 (markdown-match-propertized-text 'markdown-tilde-fence-begin last))
2980 (defun markdown-match-fenced-end-code-block (last)
2981 (markdown-match-propertized-text 'markdown-tilde-fence-end last))
2983 (defun markdown-match-blockquotes (last)
2984 "Match blockquotes from point to LAST.
2985 Use data stored in 'markdown-blockquote text property during syntax
2986 analysis."
2987 (markdown-match-propertized-text 'markdown-blockquote last))
2989 (defun markdown-match-hr (last)
2990 "Match horizontal rules comments from the point to LAST."
2991 (markdown-match-propertized-text 'markdown-hr last))
2993 (defun markdown-match-comments (last)
2994 "Match HTML comments from the point to LAST."
2995 (when (and (skip-syntax-forward "^<" last))
2996 (let ((beg (point)))
2997 (when (and (skip-syntax-forward "^>" last) (< (point) last))
2998 (forward-char)
2999 (set-match-data (list beg (point)))
3000 t))))
3002 (defun markdown-match-generic-links (last ref)
3003 "Match inline links from point to LAST.
3004 When REF is non-nil, match reference links instead of standard
3005 links with URLs.
3006 This function should only be used during font-lock, as it
3007 determines syntax based on the presence of faces for previously
3008 processed elements."
3009 ;; Search for the next potential link (not in a code block).
3010 (let ((prohibited-faces '(markdown-pre-face
3011 markdown-code-face
3012 markdown-inline-code-face
3013 markdown-comment-face))
3014 found)
3015 (while
3016 (and (not found) (< (point) last)
3017 (progn
3018 ;; Clear match data to test for a match after functions returns.
3019 (set-match-data nil)
3020 ;; Preliminary regular expression search so we can return
3021 ;; quickly upon failure. This doesn't handle malformed links
3022 ;; or nested square brackets well, so if it passes we back up
3023 ;; continue with a more precise search.
3024 (re-search-forward
3025 (if ref
3026 markdown-regex-link-reference
3027 markdown-regex-link-inline)
3028 last 'limit)))
3029 ;; Keep searching if this is in a code block, inline code, or a
3030 ;; comment, or if it is include syntax. The link text portion
3031 ;; (group 3) may contain inline code or comments, but the
3032 ;; markup, URL, and title should not be part of such elements.
3033 (if (or (markdown-range-property-any
3034 (match-beginning 0) (match-end 2) 'face prohibited-faces)
3035 (markdown-range-property-any
3036 (match-beginning 4) (match-end 0) 'face prohibited-faces)
3037 (and (char-equal (char-after (point-at-bol)) ?<)
3038 (char-equal (char-after (1+ (point-at-bol))) ?<)))
3039 (set-match-data nil)
3040 (setq found t))))
3041 ;; Match opening exclamation point (optional) and left bracket.
3042 (when (match-beginning 2)
3043 (let* ((bang (match-beginning 1))
3044 (first-begin (match-beginning 2))
3045 ;; Find end of block to prevent matching across blocks.
3046 (end-of-block (save-excursion
3047 (progn
3048 (goto-char (match-beginning 2))
3049 (markdown-end-of-text-block)
3050 (point))))
3051 ;; Move over balanced expressions to closing right bracket.
3052 ;; Catch unbalanced expression errors and return nil.
3053 (first-end (condition-case nil
3054 (and (goto-char first-begin)
3055 (scan-sexps (point) 1))
3056 (error nil)))
3057 ;; Continue with point at CONT-POINT upon failure.
3058 (cont-point (min (1+ first-begin) last))
3059 second-begin second-end url-begin url-end
3060 title-begin title-end)
3061 ;; When bracket found, in range, and followed by a left paren/bracket...
3062 (when (and first-end (< first-end end-of-block) (goto-char first-end)
3063 (char-equal (char-after (point)) (if ref ?\[ ?\()))
3064 ;; Scan across balanced expressions for closing parenthesis/bracket.
3065 (setq second-begin (point)
3066 second-end (condition-case nil
3067 (scan-sexps (point) 1)
3068 (error nil)))
3069 ;; Check that closing parenthesis/bracket is in range.
3070 (if (and second-end (<= second-end end-of-block) (<= second-end last))
3071 (progn
3072 ;; Search for (optional) title inside closing parenthesis
3073 (when (and (not ref) (search-forward "\"" second-end t))
3074 (setq title-begin (1- (point))
3075 title-end (and (goto-char second-end)
3076 (search-backward "\"" (1+ title-begin) t))
3077 title-end (and title-end (1+ title-end))))
3078 ;; Store URL/reference range
3079 (setq url-begin (1+ second-begin)
3080 url-end (1- (or title-begin second-end)))
3081 ;; Set match data, move point beyond link, and return
3082 (set-match-data
3083 (list (or bang first-begin) second-end ; 0 - all
3084 bang (and bang (1+ bang)) ; 1 - bang
3085 first-begin (1+ first-begin) ; 2 - markup
3086 (1+ first-begin) (1- first-end) ; 3 - link text
3087 (1- first-end) first-end ; 4 - markup
3088 second-begin (1+ second-begin) ; 5 - markup
3089 url-begin url-end ; 6 - url/reference
3090 title-begin title-end ; 7 - title
3091 (1- second-end) second-end)) ; 8 - markup
3092 ;; Nullify cont-point and leave point at end and
3093 (setq cont-point nil)
3094 (goto-char second-end))
3095 ;; If no closing parenthesis in range, update continuation point
3096 (setq cont-point (min end-of-block second-begin))))
3097 (cond
3098 ;; On failure, continue searching at cont-point
3099 ((and cont-point (< cont-point last))
3100 (goto-char cont-point)
3101 (markdown-match-generic-links last ref))
3102 ;; No more text, return nil
3103 ((and cont-point (= cont-point last))
3104 nil)
3105 ;; Return t if a match occurred
3106 (t t)))))
3108 (defun markdown-match-angle-uris (last)
3109 "Match angle bracket URIs from point to LAST."
3110 (when (markdown-match-inline-generic markdown-regex-angle-uri last)
3111 (goto-char (1+ (match-end 0)))))
3113 (defun markdown-match-plain-uris (last)
3114 "Match plain URIs from point to LAST."
3115 (when (markdown-match-inline-generic markdown-regex-uri last t)
3116 (goto-char (1+ (match-end 0)))))
3118 (defvar markdown-conditional-search-function #'re-search-forward
3119 "Conditional search function used in `markdown-search-until-condition'.
3120 Made into a variable to allow for dynamic let-binding.")
3122 (defun markdown-search-until-condition (condition &rest args)
3123 (let (ret)
3124 (while (and (not ret) (apply markdown-conditional-search-function args))
3125 (setq ret (funcall condition)))
3126 ret))
3128 (defun markdown-metadata-line-p (pos regexp)
3129 (save-excursion
3130 (or (= (line-number-at-pos pos) 1)
3131 (progn
3132 (forward-line -1)
3133 ;; skip multi-line metadata
3134 (while (and (looking-at-p "^\\s-+[[:alpha:]]")
3135 (> (line-number-at-pos (point)) 1))
3136 (forward-line -1))
3137 (looking-at-p regexp)))))
3139 (defun markdown-match-generic-metadata (regexp last)
3140 "Match metadata declarations specified by REGEXP from point to LAST.
3141 These declarations must appear inside a metadata block that begins at
3142 the beginning of the buffer and ends with a blank line (or the end of
3143 the buffer)."
3144 (let* ((first (point))
3145 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
3146 (block-begin (goto-char 1))
3147 (block-end (re-search-forward end-re nil t)))
3148 (if (and block-end (> first block-end))
3149 ;; Don't match declarations if there is no metadata block or if
3150 ;; the point is beyond the block. Move point to point-max to
3151 ;; prevent additional searches and return return nil since nothing
3152 ;; was found.
3153 (progn (goto-char (point-max)) nil)
3154 ;; If a block was found that begins before LAST and ends after
3155 ;; point, search for declarations inside it. If the starting is
3156 ;; before the beginning of the block, start there. Otherwise,
3157 ;; move back to FIRST.
3158 (goto-char (if (< first block-begin) block-begin first))
3159 (if (and (re-search-forward regexp (min last block-end) t)
3160 (markdown-metadata-line-p (point) regexp))
3161 ;; If a metadata declaration is found, set match-data and return t.
3162 (let ((key-beginning (match-beginning 1))
3163 (key-end (match-end 1))
3164 (markup-begin (match-beginning 2))
3165 (markup-end (match-end 2))
3166 (value-beginning (match-beginning 3)))
3167 (set-match-data (list key-beginning (point) ; complete metadata
3168 key-beginning key-end ; key
3169 markup-begin markup-end ; markup
3170 value-beginning (point))) ; value
3172 ;; Otherwise, move the point to last and return nil
3173 (goto-char last)
3174 nil))))
3176 (defun markdown-match-declarative-metadata (last)
3177 "Match declarative metadata from the point to LAST."
3178 (markdown-match-generic-metadata markdown-regex-declarative-metadata last))
3180 (defun markdown-match-pandoc-metadata (last)
3181 "Match Pandoc metadata from the point to LAST."
3182 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last))
3184 (defun markdown-match-yaml-metadata-begin (last)
3185 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last))
3187 (defun markdown-match-yaml-metadata-end (last)
3188 (markdown-match-propertized-text 'markdown-yaml-metadata-end last))
3190 (defun markdown-match-yaml-metadata-key (last)
3191 (markdown-match-propertized-text 'markdown-metadata-key last))
3193 (defun markdown-match-wiki-link (last)
3194 "Match wiki links from point to LAST."
3195 (when (and markdown-enable-wiki-links
3196 (not markdown-wiki-link-fontify-missing)
3197 (markdown-match-inline-generic markdown-regex-wiki-link last))
3198 (let ((begin (match-beginning 1)) (end (match-end 1)))
3199 (if (or (markdown-in-comment-p begin)
3200 (markdown-in-comment-p end)
3201 (markdown-inline-code-at-pos-p begin)
3202 (markdown-inline-code-at-pos-p end)
3203 (markdown-code-block-at-pos begin))
3204 (progn (goto-char (min (1+ begin) last))
3205 (when (< (point) last)
3206 (markdown-match-wiki-link last)))
3207 (set-match-data (list begin end))
3208 t))))
3210 (defun markdown-match-inline-attributes (last)
3211 "Match inline attributes from point to LAST."
3212 ;; #428 re-search-forward markdown-regex-inline-attributes is very slow.
3213 ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes
3214 ;; against matched string.
3215 (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last)
3216 (if (not (string-match-p markdown-regex-inline-attributes (match-string 0)))
3217 (markdown-match-inline-attributes last)
3218 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3219 (markdown-inline-code-at-pos-p (match-end 0))
3220 (markdown-in-comment-p))
3221 t))))
3223 (defun markdown-match-leanpub-sections (last)
3224 "Match Leanpub section markers from point to LAST."
3225 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last)
3226 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3227 (markdown-inline-code-at-pos-p (match-end 0))
3228 (markdown-in-comment-p))
3229 t)))
3231 (defun markdown-match-includes (last)
3232 "Match include statements from point to LAST.
3233 Sets match data for the following seven groups:
3234 Group 1: opening two angle brackets
3235 Group 2: opening title delimiter (optional)
3236 Group 3: title text (optional)
3237 Group 4: closing title delimiter (optional)
3238 Group 5: opening filename delimiter
3239 Group 6: filename
3240 Group 7: closing filename delimiter"
3241 (when (markdown-match-inline-generic markdown-regex-include last)
3242 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
3243 (markdown-in-comment-p (match-end 0))
3244 (markdown-code-block-at-pos (match-beginning 0))))))
3245 (cond
3246 ;; Parentheses and maybe square brackets, but no curly braces:
3247 ;; match optional title in square brackets and file in parentheses.
3248 ((and valid (match-beginning 5)
3249 (not (match-beginning 8)))
3250 (set-match-data (list (match-beginning 1) (match-end 7)
3251 (match-beginning 1) (match-end 1)
3252 (match-beginning 2) (match-end 2)
3253 (match-beginning 3) (match-end 3)
3254 (match-beginning 4) (match-end 4)
3255 (match-beginning 5) (match-end 5)
3256 (match-beginning 6) (match-end 6)
3257 (match-beginning 7) (match-end 7))))
3258 ;; Only square brackets present: match file in square brackets.
3259 ((and valid (match-beginning 2)
3260 (not (match-beginning 5))
3261 (not (match-beginning 7)))
3262 (set-match-data (list (match-beginning 1) (match-end 4)
3263 (match-beginning 1) (match-end 1)
3264 nil nil
3265 nil nil
3266 nil nil
3267 (match-beginning 2) (match-end 2)
3268 (match-beginning 3) (match-end 3)
3269 (match-beginning 4) (match-end 4))))
3270 ;; Only curly braces present: match file in curly braces.
3271 ((and valid (match-beginning 8)
3272 (not (match-beginning 2))
3273 (not (match-beginning 5)))
3274 (set-match-data (list (match-beginning 1) (match-end 10)
3275 (match-beginning 1) (match-end 1)
3276 nil nil
3277 nil nil
3278 nil nil
3279 (match-beginning 8) (match-end 8)
3280 (match-beginning 9) (match-end 9)
3281 (match-beginning 10) (match-end 10))))
3283 ;; Not a valid match, move to next line and search again.
3284 (forward-line)
3285 (when (< (point) last)
3286 (setq valid (markdown-match-includes last)))))
3287 valid)))
3289 (defun markdown-match-html-tag (last)
3290 "Match HTML tags from point to LAST."
3291 (when (and markdown-enable-html
3292 (markdown-match-inline-generic markdown-regex-html-tag last t))
3293 (set-match-data (list (match-beginning 0) (match-end 0)
3294 (match-beginning 1) (match-end 1)
3295 (match-beginning 2) (match-end 2)
3296 (match-beginning 9) (match-end 9)))
3300 ;;; Markdown Font Fontification Functions =====================================
3302 (defun markdown--first-displayable (seq)
3303 "Return the first displayable character or string in SEQ.
3304 SEQ may be an atom or a sequence."
3305 (let ((seq (if (listp seq) seq (list seq))))
3306 (cond ((stringp (car seq))
3307 (cl-find-if
3308 (lambda (str)
3309 (and (mapcar #'char-displayable-p (string-to-list str))))
3310 seq))
3311 ((characterp (car seq))
3312 (cl-find-if #'char-displayable-p seq)))))
3314 (defun markdown--marginalize-string (level)
3315 "Generate atx markup string of given LEVEL for left margin."
3316 (let ((margin-left-space-count
3317 (- markdown-marginalize-headers-margin-width level)))
3318 (concat (make-string margin-left-space-count ? )
3319 (make-string level ?#))))
3321 (defun markdown-marginalize-update-current ()
3322 "Update the window configuration to create a left margin."
3323 (if window-system
3324 (let* ((header-delimiter-font-width
3325 (window-font-width nil 'markdown-header-delimiter-face))
3326 (margin-pixel-width (* markdown-marginalize-headers-margin-width
3327 header-delimiter-font-width))
3328 (margin-char-width (/ margin-pixel-width (default-font-width))))
3329 (set-window-margins nil margin-char-width))
3330 ;; As a fallback, simply set margin based on character count.
3331 (set-window-margins nil markdown-marginalize-headers-margin-width)))
3333 (defun markdown-fontify-headings (last)
3334 "Add text properties to headings from point to LAST."
3335 (when (markdown-match-propertized-text 'markdown-heading last)
3336 (let* ((level (markdown-outline-level))
3337 (heading-face
3338 (intern (format "markdown-header-face-%d" level)))
3339 (heading-props `(face ,heading-face))
3340 (left-markup-props
3341 `(face markdown-header-delimiter-face
3342 ,@(cond
3343 (markdown-hide-markup
3344 `(display ""))
3345 (markdown-marginalize-headers
3346 `(display ((margin left-margin)
3347 ,(markdown--marginalize-string level)))))))
3348 (right-markup-props
3349 `(face markdown-header-delimiter-face
3350 ,@(when markdown-hide-markup `(display ""))))
3351 (rule-props `(face markdown-header-rule-face
3352 ,@(when markdown-hide-markup `(display "")))))
3353 (if (match-end 1)
3354 ;; Setext heading
3355 (progn (add-text-properties
3356 (match-beginning 1) (match-end 1) heading-props)
3357 (if (= level 1)
3358 (add-text-properties
3359 (match-beginning 2) (match-end 2) rule-props)
3360 (add-text-properties
3361 (match-beginning 3) (match-end 3) rule-props)))
3362 ;; atx heading
3363 (add-text-properties
3364 (match-beginning 4) (match-end 4) left-markup-props)
3365 (add-text-properties
3366 (match-beginning 5) (match-end 5) heading-props)
3367 (when (match-end 6)
3368 (add-text-properties
3369 (match-beginning 6) (match-end 6) right-markup-props))))
3372 (defun markdown-fontify-tables (last)
3373 (when (and (re-search-forward "|" last t)
3374 (markdown-table-at-point-p))
3375 (font-lock-append-text-property
3376 (line-beginning-position) (min (1+ (line-end-position)) (point-max))
3377 'face 'markdown-table-face)
3378 (forward-line 1)
3381 (defun markdown-fontify-blockquotes (last)
3382 "Apply font-lock properties to blockquotes from point to LAST."
3383 (when (markdown-match-blockquotes last)
3384 (let ((display-string
3385 (markdown--first-displayable markdown-blockquote-display-char)))
3386 (add-text-properties
3387 (match-beginning 1) (match-end 1)
3388 (if markdown-hide-markup
3389 `(face markdown-blockquote-face display ,display-string)
3390 `(face markdown-markup-face)))
3391 (font-lock-append-text-property
3392 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face)
3393 t)))
3395 (defun markdown-fontify-list-items (last)
3396 "Apply font-lock properties to list markers from point to LAST."
3397 (when (markdown-match-list-items last)
3398 (let* ((indent (length (match-string-no-properties 1)))
3399 (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ...
3400 (bullet (nth (mod level (length markdown-list-item-bullets))
3401 markdown-list-item-bullets)))
3402 (add-text-properties
3403 (match-beginning 2) (match-end 2) '(face markdown-list-face))
3404 (when markdown-hide-markup
3405 (cond
3406 ;; Unordered lists
3407 ((string-match-p "[\\*\\+-]" (match-string 2))
3408 (add-text-properties
3409 (match-beginning 2) (match-end 2) `(display ,bullet)))
3410 ;; Definition lists
3411 ((string-equal ":" (match-string 2))
3412 (let ((display-string
3413 (char-to-string (markdown--first-displayable
3414 markdown-definition-display-char))))
3415 (add-text-properties (match-beginning 2) (match-end 2)
3416 `(display ,display-string)))))))
3419 (defun markdown-fontify-hrs (last)
3420 "Add text properties to horizontal rules from point to LAST."
3421 (when (markdown-match-hr last)
3422 (let ((hr-char (markdown--first-displayable markdown-hr-display-char)))
3423 (add-text-properties
3424 (match-beginning 0) (match-end 0)
3425 `(face markdown-hr-face
3426 font-lock-multiline t
3427 ,@(when (and markdown-hide-markup hr-char)
3428 `(display ,(make-string
3429 (window-body-width) hr-char)))))
3430 t)))
3432 (defun markdown-fontify-sub-superscripts (last)
3433 "Apply text properties to sub- and superscripts from point to LAST."
3434 (when (markdown-search-until-condition
3435 (lambda () (and (not (markdown-code-block-at-point-p))
3436 (not (markdown-inline-code-at-point-p))
3437 (not (markdown-in-comment-p))))
3438 markdown-regex-sub-superscript last t)
3439 (let* ((subscript-p (string= (match-string 2) "~"))
3440 (props
3441 (if subscript-p
3442 (car markdown-sub-superscript-display)
3443 (cdr markdown-sub-superscript-display)))
3444 (mp (list 'face 'markdown-markup-face
3445 'invisible 'markdown-markup)))
3446 (when markdown-hide-markup
3447 (put-text-property (match-beginning 3) (match-end 3)
3448 'display props))
3449 (add-text-properties (match-beginning 2) (match-end 2) mp)
3450 (add-text-properties (match-beginning 4) (match-end 4) mp)
3451 t)))
3454 ;;; Syntax Table ==============================================================
3456 (defvar markdown-mode-syntax-table
3457 (let ((tab (make-syntax-table text-mode-syntax-table)))
3458 (modify-syntax-entry ?\" "." tab)
3459 tab)
3460 "Syntax table for `markdown-mode'.")
3463 ;;; Element Insertion =========================================================
3465 (defun markdown-ensure-blank-line-before ()
3466 "If previous line is not already blank, insert a blank line before point."
3467 (unless (bolp) (insert "\n"))
3468 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n")))
3470 (defun markdown-ensure-blank-line-after ()
3471 "If following line is not already blank, insert a blank line after point.
3472 Return the point where it was originally."
3473 (save-excursion
3474 (unless (eolp) (insert "\n"))
3475 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
3477 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end)
3478 "Insert the strings S1 and S2, wrapping around region or THING.
3479 If a region is specified by the optional BEG and END arguments,
3480 wrap the strings S1 and S2 around that region.
3481 If there is an active region, wrap the strings S1 and S2 around
3482 the region. If there is not an active region but the point is at
3483 THING, wrap that thing (which defaults to word). Otherwise, just
3484 insert S1 and S2 and place the point in between. Return the
3485 bounds of the entire wrapped string, or nil if nothing was wrapped
3486 and S1 and S2 were only inserted."
3487 (let (a b bounds new-point)
3488 (cond
3489 ;; Given region
3490 ((and beg end)
3491 (setq a beg
3492 b end
3493 new-point (+ (point) (length s1))))
3494 ;; Active region
3495 ((use-region-p)
3496 (setq a (region-beginning)
3497 b (region-end)
3498 new-point (+ (point) (length s1))))
3499 ;; Thing (word) at point
3500 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word)))
3501 (setq a (car bounds)
3502 b (cdr bounds)
3503 new-point (+ (point) (length s1))))
3504 ;; No active region and no word
3506 (setq a (point)
3507 b (point))))
3508 (goto-char b)
3509 (insert s2)
3510 (goto-char a)
3511 (insert s1)
3512 (when new-point (goto-char new-point))
3513 (if (= a b)
3515 (setq b (+ b (length s1) (length s2)))
3516 (cons a b))))
3518 (defun markdown-point-after-unwrap (cur prefix suffix)
3519 "Return desired position of point after an unwrapping operation.
3520 CUR gives the position of the point before the operation.
3521 Additionally, two cons cells must be provided. PREFIX gives the
3522 bounds of the prefix string and SUFFIX gives the bounds of the
3523 suffix string."
3524 (cond ((< cur (cdr prefix)) (car prefix))
3525 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix))))
3526 ((<= cur (cdr suffix))
3527 (- cur (+ (- (cdr prefix) (car prefix))
3528 (- cur (car suffix)))))
3529 (t cur)))
3531 (defun markdown-unwrap-thing-at-point (regexp all text)
3532 "Remove prefix and suffix of thing at point and reposition the point.
3533 When the thing at point matches REGEXP, replace the subexpression
3534 ALL with the string in subexpression TEXT. Reposition the point
3535 in an appropriate location accounting for the removal of prefix
3536 and suffix strings. Return new bounds of string from group TEXT.
3537 When REGEXP is nil, assumes match data is already set."
3538 (when (or (null regexp)
3539 (thing-at-point-looking-at regexp))
3540 (let ((cur (point))
3541 (prefix (cons (match-beginning all) (match-beginning text)))
3542 (suffix (cons (match-end text) (match-end all)))
3543 (bounds (cons (match-beginning text) (match-end text))))
3544 ;; Replace the thing at point
3545 (replace-match (match-string text) t t nil all)
3546 ;; Reposition the point
3547 (goto-char (markdown-point-after-unwrap cur prefix suffix))
3548 ;; Adjust bounds
3549 (setq bounds (cons (car prefix)
3550 (- (cdr bounds) (- (cdr prefix) (car prefix))))))))
3552 (defun markdown-unwrap-things-in-region (beg end regexp all text)
3553 "Remove prefix and suffix of all things in region from BEG to END.
3554 When a thing in the region matches REGEXP, replace the
3555 subexpression ALL with the string in subexpression TEXT.
3556 Return a cons cell containing updated bounds for the region."
3557 (save-excursion
3558 (goto-char beg)
3559 (let ((removed 0) len-all len-text)
3560 (while (re-search-forward regexp (- end removed) t)
3561 (setq len-all (length (match-string-no-properties all)))
3562 (setq len-text (length (match-string-no-properties text)))
3563 (setq removed (+ removed (- len-all len-text)))
3564 (replace-match (match-string text) t t nil all))
3565 (cons beg (- end removed)))))
3567 (defun markdown-insert-hr (arg)
3568 "Insert or replace a horizontal rule.
3569 By default, use the first element of `markdown-hr-strings'. When
3570 ARG is non-nil, as when given a prefix, select a different
3571 element as follows. When prefixed with \\[universal-argument],
3572 use the last element of `markdown-hr-strings' instead. When
3573 prefixed with an integer from 1 to the length of
3574 `markdown-hr-strings', use the element in that position instead."
3575 (interactive "*P")
3576 (when (thing-at-point-looking-at markdown-regex-hr)
3577 (delete-region (match-beginning 0) (match-end 0)))
3578 (markdown-ensure-blank-line-before)
3579 (cond ((equal arg '(4))
3580 (insert (car (reverse markdown-hr-strings))))
3581 ((and (integerp arg) (> arg 0)
3582 (<= arg (length markdown-hr-strings)))
3583 (insert (nth (1- arg) markdown-hr-strings)))
3585 (insert (car markdown-hr-strings))))
3586 (markdown-ensure-blank-line-after))
3588 (defun markdown--insert-common (start-delim end-delim regex start-group end-group face
3589 &optional skip-space)
3590 (if (use-region-p)
3591 ;; Active region
3592 (let* ((bounds (markdown-unwrap-things-in-region
3593 (region-beginning) (region-end)
3594 regex start-group end-group))
3595 (beg (car bounds))
3596 (end (cdr bounds)))
3597 (when (and beg skip-space)
3598 (save-excursion
3599 (goto-char beg)
3600 (skip-chars-forward "[ \t]")
3601 (setq beg (point))))
3602 (when (and end skip-space)
3603 (save-excursion
3604 (goto-char end)
3605 (skip-chars-backward "[ \t]")
3606 (setq end (point))))
3607 (markdown-wrap-or-insert start-delim end-delim nil beg end))
3608 (if (markdown--face-p (point) (list face))
3609 (save-excursion
3610 (while (and (markdown--face-p (point) (list face)) (not (bobp)))
3611 (forward-char -1))
3612 (forward-char (- (1- (length start-delim)))) ;; for delimiter
3613 (unless (bolp)
3614 (forward-char -1))
3615 (when (looking-at regex)
3616 (markdown-unwrap-thing-at-point nil start-group end-group)))
3617 (if (thing-at-point-looking-at regex)
3618 (markdown-unwrap-thing-at-point nil start-group end-group)
3619 (markdown-wrap-or-insert start-delim end-delim 'word nil nil)))))
3621 (defun markdown-insert-bold ()
3622 "Insert markup to make a region or word bold.
3623 If there is an active region, make the region bold. If the point
3624 is at a non-bold word, make the word bold. If the point is at a
3625 bold word or phrase, remove the bold markup. Otherwise, simply
3626 insert bold delimiters and place the point in between them."
3627 (interactive)
3628 (let ((delim (if markdown-bold-underscore "__" "**")))
3629 (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t)))
3631 (defun markdown-insert-italic ()
3632 "Insert markup to make a region or word italic.
3633 If there is an active region, make the region italic. If the point
3634 is at a non-italic word, make the word italic. If the point is at an
3635 italic word or phrase, remove the italic markup. Otherwise, simply
3636 insert italic delimiters and place the point in between them."
3637 (interactive)
3638 (let ((delim (if markdown-italic-underscore "_" "*")))
3639 (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t)))
3641 (defun markdown-insert-strike-through ()
3642 "Insert markup to make a region or word strikethrough.
3643 If there is an active region, make the region strikethrough. If the point
3644 is at a non-bold word, make the word strikethrough. If the point is at a
3645 strikethrough word or phrase, remove the strikethrough markup. Otherwise,
3646 simply insert bold delimiters and place the point in between them."
3647 (interactive)
3648 (markdown--insert-common
3649 "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t))
3651 (defun markdown-insert-code ()
3652 "Insert markup to make a region or word an inline code fragment.
3653 If there is an active region, make the region an inline code
3654 fragment. If the point is at a word, make the word an inline
3655 code fragment. Otherwise, simply insert code delimiters and
3656 place the point in between them."
3657 (interactive)
3658 (if (use-region-p)
3659 ;; Active region
3660 (let ((bounds (markdown-unwrap-things-in-region
3661 (region-beginning) (region-end)
3662 markdown-regex-code 1 3)))
3663 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds)))
3664 ;; Code markup removal, code markup for word, or empty markup insertion
3665 (if (markdown-inline-code-at-point)
3666 (markdown-unwrap-thing-at-point nil 0 2)
3667 (markdown-wrap-or-insert "`" "`" 'word nil nil))))
3669 (defun markdown-insert-kbd ()
3670 "Insert markup to wrap region or word in <kbd> tags.
3671 If there is an active region, use the region. If the point is at
3672 a word, use the word. Otherwise, simply insert <kbd> tags and
3673 place the point in between them."
3674 (interactive)
3675 (if (use-region-p)
3676 ;; Active region
3677 (let ((bounds (markdown-unwrap-things-in-region
3678 (region-beginning) (region-end)
3679 markdown-regex-kbd 0 2)))
3680 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds)))
3681 ;; Markup removal, markup for word, or empty markup insertion
3682 (if (thing-at-point-looking-at markdown-regex-kbd)
3683 (markdown-unwrap-thing-at-point nil 0 2)
3684 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil))))
3686 (defun markdown-insert-inline-link (text url &optional title)
3687 "Insert an inline link with TEXT pointing to URL.
3688 Optionally, the user can provide a TITLE."
3689 (let ((cur (point)))
3690 (setq title (and title (concat " \"" title "\"")))
3691 (insert (concat "[" text "](" url title ")"))
3692 (cond ((not text) (goto-char (+ 1 cur)))
3693 ((not url) (goto-char (+ 3 (length text) cur))))))
3695 (defun markdown-insert-inline-image (text url &optional title)
3696 "Insert an inline link with alt TEXT pointing to URL.
3697 Optionally, also provide a TITLE."
3698 (let ((cur (point)))
3699 (setq title (and title (concat " \"" title "\"")))
3700 (insert (concat "![" text "](" url title ")"))
3701 (cond ((not text) (goto-char (+ 2 cur)))
3702 ((not url) (goto-char (+ 4 (length text) cur))))))
3704 (defun markdown-insert-reference-link (text label &optional url title)
3705 "Insert a reference link and, optionally, a reference definition.
3706 The link TEXT will be inserted followed by the optional LABEL.
3707 If a URL is given, also insert a definition for the reference
3708 LABEL according to `markdown-reference-location'. If a TITLE is
3709 given, it will be added to the end of the reference definition
3710 and will be used to populate the title attribute when converted
3711 to XHTML. If URL is nil, insert only the link portion (for
3712 example, when a reference label is already defined)."
3713 (insert (concat "[" text "][" label "]"))
3714 (when url
3715 (markdown-insert-reference-definition
3716 (if (string-equal label "") text label)
3717 url title)))
3719 (defun markdown-insert-reference-image (text label &optional url title)
3720 "Insert a reference image and, optionally, a reference definition.
3721 The alt TEXT will be inserted followed by the optional LABEL.
3722 If a URL is given, also insert a definition for the reference
3723 LABEL according to `markdown-reference-location'. If a TITLE is
3724 given, it will be added to the end of the reference definition
3725 and will be used to populate the title attribute when converted
3726 to XHTML. If URL is nil, insert only the link portion (for
3727 example, when a reference label is already defined)."
3728 (insert (concat "![" text "][" label "]"))
3729 (when url
3730 (markdown-insert-reference-definition
3731 (if (string-equal label "") text label)
3732 url title)))
3734 (defun markdown-insert-reference-definition (label &optional url title)
3735 "Add definition for reference LABEL with URL and TITLE.
3736 LABEL is a Markdown reference label without square brackets.
3737 URL and TITLE are optional. When given, the TITLE will
3738 be used to populate the title attribute when converted to XHTML."
3739 ;; END specifies where to leave the point upon return
3740 (let ((end (point)))
3741 (cl-case markdown-reference-location
3742 (end (goto-char (point-max)))
3743 (immediately (markdown-end-of-text-block))
3744 (subtree (markdown-end-of-subtree))
3745 (header (markdown-end-of-defun)))
3746 ;; Skip backwards over local variables. This logic is similar to the one
3747 ;; used in ‘hack-local-variables’.
3748 (when (and enable-local-variables (eobp))
3749 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move)
3750 (when (let ((case-fold-search t))
3751 (search-forward "Local Variables:" nil :move))
3752 (beginning-of-line 0)
3753 (when (eq (char-before) ?\n) (backward-char))))
3754 (unless (or (markdown-cur-line-blank-p)
3755 (thing-at-point-looking-at markdown-regex-reference-definition))
3756 (insert "\n"))
3757 (insert "\n[" label "]: ")
3758 (if url
3759 (insert url)
3760 ;; When no URL is given, leave point at END following the colon
3761 (setq end (point)))
3762 (when (> (length title) 0)
3763 (insert " \"" title "\""))
3764 (unless (looking-at-p "\n")
3765 (insert "\n"))
3766 (goto-char end)
3767 (when url
3768 (message
3769 (markdown--substitute-command-keys
3770 "Reference [%s] was defined, press \\[markdown-do] to jump there")
3771 label))))
3773 (defcustom markdown-link-make-text-function nil
3774 "Function that automatically generates a link text for a URL.
3776 If non-nil, this function will be called by
3777 `markdown--insert-link-or-image' and the result will be the
3778 default link text. The function should receive exactly one
3779 argument that corresponds to the link URL."
3780 :group 'markdown
3781 :type 'function
3782 :package-version '(markdown-mode . "2.5"))
3784 (defcustom markdown-disable-tooltip-prompt nil
3785 "Disable prompt for tooltip when inserting a link or image.
3787 If non-nil, `markdown-insert-link' and `markdown-insert-link'
3788 will not prompt the user to insert a tooltip text for the given
3789 link or image."
3790 :group 'markdown
3791 :type 'boolean
3792 :safe 'booleanp
3793 :package-version '(markdown-mode . "2.5"))
3795 (defun markdown--insert-link-or-image (image)
3796 "Interactively insert new or update an existing link or image.
3797 When IMAGE is non-nil, insert an image. Otherwise, insert a link.
3798 This is an internal function called by
3799 `markdown-insert-link' and `markdown-insert-image'."
3800 (cl-multiple-value-bind (begin end text uri ref title)
3801 (if (use-region-p)
3802 ;; Use region as either link text or URL as appropriate.
3803 (let ((region (buffer-substring-no-properties
3804 (region-beginning) (region-end))))
3805 (if (string-match markdown-regex-uri region)
3806 ;; Region contains a URL; use it as such.
3807 (list (region-beginning) (region-end)
3808 nil (match-string 0 region) nil nil)
3809 ;; Region doesn't contain a URL, so use it as text.
3810 (list (region-beginning) (region-end)
3811 region nil nil nil)))
3812 ;; Extract and use properties of existing link, if any.
3813 (markdown-link-at-pos (point)))
3814 (let* ((ref (when ref (concat "[" ref "]")))
3815 (defined-refs (mapcar #'car (markdown-get-defined-references)))
3816 (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs))
3817 (used-uris (markdown-get-used-uris))
3818 (uri-or-ref (completing-read
3819 "URL or [reference]: "
3820 (append defined-ref-cands used-uris)
3821 nil nil (or uri ref)))
3822 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref)
3823 (match-string 1 uri-or-ref))
3824 ((string-equal "" uri-or-ref)
3825 "")))
3826 (uri (unless ref uri-or-ref))
3827 (text-prompt (if image
3828 "Alt text: "
3829 (if ref
3830 "Link text: "
3831 "Link text (blank for plain URL): ")))
3832 (text (or text (and markdown-link-make-text-function uri
3833 (funcall markdown-link-make-text-function uri))))
3834 (text (completing-read text-prompt defined-refs nil nil text))
3835 (text (if (= (length text) 0) nil text))
3836 (plainp (and uri (not text)))
3837 (implicitp (string-equal ref ""))
3838 (ref (if implicitp text ref))
3839 (definedp (and ref (markdown-reference-definition ref)))
3840 (ref-url (unless (or uri definedp)
3841 (completing-read "Reference URL: " used-uris)))
3842 (title (unless (or plainp definedp markdown-disable-tooltip-prompt)
3843 (read-string "Title (tooltip text, optional): " title)))
3844 (title (if (= (length title) 0) nil title)))
3845 (when (and image implicitp)
3846 (user-error "Reference required: implicit image references are invalid"))
3847 (when (and begin end)
3848 (delete-region begin end))
3849 (cond
3850 ((and (not image) uri text)
3851 (markdown-insert-inline-link text uri title))
3852 ((and image uri text)
3853 (markdown-insert-inline-image text uri title))
3854 ((and ref text)
3855 (if image
3856 (markdown-insert-reference-image text (unless implicitp ref) nil title)
3857 (markdown-insert-reference-link text (unless implicitp ref) nil title))
3858 (unless definedp
3859 (markdown-insert-reference-definition ref ref-url title)))
3860 ((and (not image) uri)
3861 (markdown-insert-uri uri))))))
3863 (defun markdown-insert-link ()
3864 "Insert new or update an existing link, with interactive prompts.
3865 If the point is at an existing link or URL, update the link text,
3866 URL, reference label, and/or title. Otherwise, insert a new link.
3867 The type of link inserted (inline, reference, or plain URL)
3868 depends on which values are provided:
3870 * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
3871 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
3872 * If only TEXT is given, insert an implicit reference link: [TEXT][].
3873 * If only a URL is given, insert a plain link: <URL>.
3875 In other words, to create an implicit reference link, leave the
3876 URL prompt empty and to create a plain URL link, leave the link
3877 text empty.
3879 If there is an active region, use the text as the default URL, if
3880 it seems to be a URL, or link text value otherwise.
3882 If a given reference is not defined, this function will
3883 additionally prompt for the URL and optional title. In this case,
3884 the reference definition is placed at the location determined by
3885 `markdown-reference-location'. In addition, it is possible to
3886 have the `markdown-link-make-text-function' function, if non-nil,
3887 define the default link text before prompting the user for it.
3889 If `markdown-disable-tooltip-prompt' is non-nil, the user will
3890 not be prompted to add or modify a tooltip text.
3892 Through updating the link, this function can be used to convert a
3893 link of one type (inline, reference, or plain) to another type by
3894 selectively adding or removing information via the prompts."
3895 (interactive)
3896 (markdown--insert-link-or-image nil))
3898 (defun markdown-insert-image ()
3899 "Insert new or update an existing image, with interactive prompts.
3900 If the point is at an existing image, update the alt text, URL,
3901 reference label, and/or title. Otherwise, insert a new image.
3902 The type of image inserted (inline or reference) depends on which
3903 values are provided:
3905 * If a URL and ALT-TEXT are given, insert an inline image:
3906 ![ALT-TEXT](URL).
3907 * If [REF] and ALT-TEXT are given, insert a reference image:
3908 ![ALT-TEXT][REF].
3910 If there is an active region, use the text as the default URL, if
3911 it seems to be a URL, or alt text value otherwise.
3913 If a given reference is not defined, this function will
3914 additionally prompt for the URL and optional title. In this case,
3915 the reference definition is placed at the location determined by
3916 `markdown-reference-location'.
3918 Through updating the image, this function can be used to convert an
3919 image of one type (inline or reference) to another type by
3920 selectively adding or removing information via the prompts."
3921 (interactive)
3922 (markdown--insert-link-or-image t))
3924 (defun markdown-insert-uri (&optional uri)
3925 "Insert markup for an inline URI.
3926 If there is an active region, use it as the URI. If the point is
3927 at a URI, wrap it with angle brackets. If the point is at an
3928 inline URI, remove the angle brackets. Otherwise, simply insert
3929 angle brackets place the point between them."
3930 (interactive)
3931 (if (use-region-p)
3932 ;; Active region
3933 (let ((bounds (markdown-unwrap-things-in-region
3934 (region-beginning) (region-end)
3935 markdown-regex-angle-uri 0 2)))
3936 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds)))
3937 ;; Markup removal, URI at point, new URI, or empty markup insertion
3938 (if (thing-at-point-looking-at markdown-regex-angle-uri)
3939 (markdown-unwrap-thing-at-point nil 0 2)
3940 (if uri
3941 (insert "<" uri ">")
3942 (markdown-wrap-or-insert "<" ">" 'url nil nil)))))
3944 (defun markdown-insert-wiki-link ()
3945 "Insert a wiki link of the form [[WikiLink]].
3946 If there is an active region, use the region as the link text.
3947 If the point is at a word, use the word as the link text. If
3948 there is no active region and the point is not at word, simply
3949 insert link markup."
3950 (interactive)
3951 (if (use-region-p)
3952 ;; Active region
3953 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end))
3954 ;; Markup removal, wiki link at at point, or empty markup insertion
3955 (if (thing-at-point-looking-at markdown-regex-wiki-link)
3956 (if (or markdown-wiki-link-alias-first
3957 (null (match-string 5)))
3958 (markdown-unwrap-thing-at-point nil 1 3)
3959 (markdown-unwrap-thing-at-point nil 1 5))
3960 (markdown-wrap-or-insert "[[" "]]"))))
3962 (defun markdown-remove-header ()
3963 "Remove header markup if point is at a header.
3964 Return bounds of remaining header text if a header was removed
3965 and nil otherwise."
3966 (interactive "*")
3967 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2)
3968 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1)))
3970 (defun markdown-insert-header (&optional level text setext)
3971 "Insert or replace header markup.
3972 The level of the header is specified by LEVEL and header text is
3973 given by TEXT. LEVEL must be an integer from 1 and 6, and the
3974 default value is 1.
3975 When TEXT is nil, the header text is obtained as follows.
3976 If there is an active region, it is used as the header text.
3977 Otherwise, the current line will be used as the header text.
3978 If there is not an active region and the point is at a header,
3979 remove the header markup and replace with level N header.
3980 Otherwise, insert empty header markup and place the point in
3981 between.
3982 The style of the header will be atx (hash marks) unless
3983 SETEXT is non-nil, in which case a setext-style (underlined)
3984 header will be inserted."
3985 (interactive "p\nsHeader text: ")
3986 (setq level (min (max (or level 1) 1) (if setext 2 6)))
3987 ;; Determine header text if not given
3988 (when (null text)
3989 (if (use-region-p)
3990 ;; Active region
3991 (setq text (delete-and-extract-region (region-beginning) (region-end)))
3992 ;; No active region
3993 (markdown-remove-header)
3994 (setq text (delete-and-extract-region
3995 (line-beginning-position) (line-end-position)))
3996 (when (and setext (string-match-p "^[ \t]*$" text))
3997 (setq text (read-string "Header text: "))))
3998 (setq text (markdown-compress-whitespace-string text)))
3999 ;; Insertion with given text
4000 (markdown-ensure-blank-line-before)
4001 (let (hdr)
4002 (cond (setext
4003 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=)))
4004 (insert text "\n" hdr))
4006 (setq hdr (make-string level ?#))
4007 (insert hdr " " text)
4008 (when (null markdown-asymmetric-header) (insert " " hdr)))))
4009 (markdown-ensure-blank-line-after)
4010 ;; Leave point at end of text
4011 (cond (setext
4012 (backward-char (1+ (string-width text))))
4013 ((null markdown-asymmetric-header)
4014 (backward-char (1+ level)))))
4016 (defun markdown-insert-header-dwim (&optional arg setext)
4017 "Insert or replace header markup.
4018 The level and type of the header are determined automatically by
4019 the type and level of the previous header, unless a prefix
4020 argument is given via ARG.
4021 With a numeric prefix valued 1 to 6, insert a header of the given
4022 level, with the type being determined automatically (note that
4023 only level 1 or 2 setext headers are possible).
4025 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
4026 promote the heading by one level.
4027 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
4028 demote the heading by one level.
4029 When SETEXT is non-nil, prefer setext-style headers when
4030 possible (levels one and two).
4032 When there is an active region, use it for the header text. When
4033 the point is at an existing header, change the type and level
4034 according to the rules above.
4035 Otherwise, if the line is not empty, create a header using the
4036 text on the current line as the header text.
4037 Finally, if the point is on a blank line, insert empty header
4038 markup (atx) or prompt for text (setext).
4039 See `markdown-insert-header' for more details about how the
4040 header text is determined."
4041 (interactive "*P")
4042 (let (level)
4043 (save-excursion
4044 (when (or (thing-at-point-looking-at markdown-regex-header)
4045 (re-search-backward markdown-regex-header nil t))
4046 ;; level of current or previous header
4047 (setq level (markdown-outline-level))
4048 ;; match group 1 indicates a setext header
4049 (setq setext (match-end 1))))
4050 ;; check prefix argument
4051 (cond
4052 ((and (equal arg '(4)) level (> level 1)) ;; C-u
4053 (cl-decf level))
4054 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u
4055 (cl-incf level))
4056 (arg ;; numeric prefix
4057 (setq level (prefix-numeric-value arg))))
4058 ;; setext headers must be level one or two
4059 (and level (setq setext (and setext (<= level 2))))
4060 ;; insert the heading
4061 (markdown-insert-header level nil setext)))
4063 (defun markdown-insert-header-setext-dwim (&optional arg)
4064 "Insert or replace header markup, with preference for setext.
4065 See `markdown-insert-header-dwim' for details, including how ARG is handled."
4066 (interactive "*P")
4067 (markdown-insert-header-dwim arg t))
4069 (defun markdown-insert-header-atx-1 ()
4070 "Insert a first level atx-style (hash mark) header.
4071 See `markdown-insert-header'."
4072 (interactive "*")
4073 (markdown-insert-header 1 nil nil))
4075 (defun markdown-insert-header-atx-2 ()
4076 "Insert a level two atx-style (hash mark) header.
4077 See `markdown-insert-header'."
4078 (interactive "*")
4079 (markdown-insert-header 2 nil nil))
4081 (defun markdown-insert-header-atx-3 ()
4082 "Insert a level three atx-style (hash mark) header.
4083 See `markdown-insert-header'."
4084 (interactive "*")
4085 (markdown-insert-header 3 nil nil))
4087 (defun markdown-insert-header-atx-4 ()
4088 "Insert a level four atx-style (hash mark) header.
4089 See `markdown-insert-header'."
4090 (interactive "*")
4091 (markdown-insert-header 4 nil nil))
4093 (defun markdown-insert-header-atx-5 ()
4094 "Insert a level five atx-style (hash mark) header.
4095 See `markdown-insert-header'."
4096 (interactive "*")
4097 (markdown-insert-header 5 nil nil))
4099 (defun markdown-insert-header-atx-6 ()
4100 "Insert a sixth level atx-style (hash mark) header.
4101 See `markdown-insert-header'."
4102 (interactive "*")
4103 (markdown-insert-header 6 nil nil))
4105 (defun markdown-insert-header-setext-1 ()
4106 "Insert a setext-style (underlined) first-level header.
4107 See `markdown-insert-header'."
4108 (interactive "*")
4109 (markdown-insert-header 1 nil t))
4111 (defun markdown-insert-header-setext-2 ()
4112 "Insert a setext-style (underlined) second-level header.
4113 See `markdown-insert-header'."
4114 (interactive "*")
4115 (markdown-insert-header 2 nil t))
4117 (defun markdown-blockquote-indentation (loc)
4118 "Return string containing necessary indentation for a blockquote at LOC.
4119 Also see `markdown-pre-indentation'."
4120 (save-excursion
4121 (goto-char loc)
4122 (let* ((list-level (length (markdown-calculate-list-levels)))
4123 (indent ""))
4124 (dotimes (_ list-level indent)
4125 (setq indent (concat indent " "))))))
4127 (defun markdown-insert-blockquote ()
4128 "Start a blockquote section (or blockquote the region).
4129 If Transient Mark mode is on and a region is active, it is used as
4130 the blockquote text."
4131 (interactive)
4132 (if (use-region-p)
4133 (markdown-blockquote-region (region-beginning) (region-end))
4134 (markdown-ensure-blank-line-before)
4135 (insert (markdown-blockquote-indentation (point)) "> ")
4136 (markdown-ensure-blank-line-after)))
4138 (defun markdown-block-region (beg end prefix)
4139 "Format the region using a block prefix.
4140 Arguments BEG and END specify the beginning and end of the
4141 region. The characters PREFIX will appear at the beginning
4142 of each line."
4143 (save-excursion
4144 (let* ((end-marker (make-marker))
4145 (beg-marker (make-marker))
4146 (prefix-without-trailing-whitespace
4147 (replace-regexp-in-string (rx (+ blank) eos) "" prefix)))
4148 ;; Ensure blank line after and remove extra whitespace
4149 (goto-char end)
4150 (skip-syntax-backward "-")
4151 (set-marker end-marker (point))
4152 (delete-horizontal-space)
4153 (markdown-ensure-blank-line-after)
4154 ;; Ensure blank line before and remove extra whitespace
4155 (goto-char beg)
4156 (skip-syntax-forward "-")
4157 (delete-horizontal-space)
4158 (markdown-ensure-blank-line-before)
4159 (set-marker beg-marker (point))
4160 ;; Insert PREFIX before each line
4161 (goto-char beg-marker)
4162 (while (and (< (line-beginning-position) end-marker)
4163 (not (eobp)))
4164 ;; Don’t insert trailing whitespace.
4165 (insert (if (eolp) prefix-without-trailing-whitespace prefix))
4166 (forward-line)))))
4168 (defun markdown-blockquote-region (beg end)
4169 "Blockquote the region.
4170 Arguments BEG and END specify the beginning and end of the region."
4171 (interactive "*r")
4172 (markdown-block-region
4173 beg end (concat (markdown-blockquote-indentation
4174 (max (point-min) (1- beg))) "> ")))
4176 (defun markdown-pre-indentation (loc)
4177 "Return string containing necessary whitespace for a pre block at LOC.
4178 Also see `markdown-blockquote-indentation'."
4179 (save-excursion
4180 (goto-char loc)
4181 (let* ((list-level (length (markdown-calculate-list-levels)))
4182 indent)
4183 (dotimes (_ (1+ list-level) indent)
4184 (setq indent (concat indent " "))))))
4186 (defun markdown-insert-pre ()
4187 "Start a preformatted section (or apply to the region).
4188 If Transient Mark mode is on and a region is active, it is marked
4189 as preformatted text."
4190 (interactive)
4191 (if (use-region-p)
4192 (markdown-pre-region (region-beginning) (region-end))
4193 (markdown-ensure-blank-line-before)
4194 (insert (markdown-pre-indentation (point)))
4195 (markdown-ensure-blank-line-after)))
4197 (defun markdown-pre-region (beg end)
4198 "Format the region as preformatted text.
4199 Arguments BEG and END specify the beginning and end of the region."
4200 (interactive "*r")
4201 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg)))))
4202 (markdown-block-region beg end indent)))
4204 (defun markdown-electric-backquote (arg)
4205 "Insert a backquote.
4206 The numeric prefix argument ARG says how many times to repeat the insertion.
4207 Call `markdown-insert-gfm-code-block' interactively
4208 if three backquotes inserted at the beginning of line."
4209 (interactive "*P")
4210 (self-insert-command (prefix-numeric-value arg))
4211 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil))
4212 (replace-match "")
4213 (call-interactively #'markdown-insert-gfm-code-block)))
4215 (defconst markdown-gfm-recognized-languages
4216 ;; To reproduce/update, evaluate the let-form in
4217 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
4218 ;; but with appropriate use of a keyboard macro, indenting and filling it
4219 ;; properly is pretty fast.
4220 '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
4221 "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada"
4222 "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer"
4223 "AngelScript" "Ant-Build-System" "ApacheConf" "Apex"
4224 "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly"
4225 "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile"
4226 "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax"
4227 "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump"
4228 "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb"
4229 "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
4230 "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
4231 "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript"
4232 "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language"
4233 "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound"
4234 "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump"
4235 "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch"
4236 "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript"
4237 "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild"
4238 "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm"
4239 "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor"
4240 "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth"
4241 "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS"
4242 "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN"
4243 "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass"
4244 "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config"
4245 "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu"
4246 "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL"
4247 "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML"
4248 "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP"
4249 "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC"
4250 "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7"
4251 "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON"
4252 "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java"
4253 "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison"
4254 "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout"
4255 "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE"
4256 "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
4257 "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
4258 "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript"
4259 "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB"
4260 "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako"
4261 "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki"
4262 "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah"
4263 "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode"
4264 "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL"
4265 "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
4266 "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
4267 "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C"
4268 "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal"
4269 "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript"
4270 "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox"
4271 "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus"
4272 "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn"
4273 "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod"
4274 "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell"
4275 "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer"
4276 "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
4277 "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc"
4278 "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket"
4279 "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol"
4280 "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript"
4281 "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage"
4282 "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
4283 "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass"
4284 "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
4285 "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity"
4286 "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark"
4287 "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift"
4288 "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh"
4289 "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle"
4290 "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
4291 "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL"
4292 "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue"
4293 "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly"
4294 "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok"
4295 "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap"
4296 "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS"
4297 "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL"
4298 "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors"
4299 "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc"
4300 "reStructuredText" "sed" "wdl" "wisp" "xBase")
4301 "Language specifiers recognized by GitHub's syntax highlighting features.")
4303 (defvar-local markdown-gfm-used-languages nil
4304 "Language names used in GFM code blocks.")
4306 (defun markdown-trim-whitespace (str)
4307 (replace-regexp-in-string
4308 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str))
4310 (defun markdown-clean-language-string (str)
4311 (replace-regexp-in-string
4312 "{\\.?\\|}" "" (markdown-trim-whitespace str)))
4314 (defun markdown-validate-language-string (widget)
4315 (let ((str (widget-value widget)))
4316 (unless (string= str (markdown-clean-language-string str))
4317 (widget-put widget :error (format "Invalid language spec: '%s'" str))
4318 widget)))
4320 (defun markdown-gfm-get-corpus ()
4321 "Create corpus of recognized GFM code block languages for the given buffer."
4322 (let ((given-corpus (append markdown-gfm-additional-languages
4323 markdown-gfm-recognized-languages)))
4324 (append
4325 markdown-gfm-used-languages
4326 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus)
4327 given-corpus))))
4329 (defun markdown-gfm-add-used-language (lang)
4330 "Clean LANG and add to list of used languages."
4331 (setq markdown-gfm-used-languages
4332 (cons lang (remove lang markdown-gfm-used-languages))))
4334 (defcustom markdown-spaces-after-code-fence 1
4335 "Number of space characters to insert after a code fence.
4336 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
4337 opening code fence and an info string."
4338 :group 'markdown
4339 :type 'integer
4340 :safe #'natnump
4341 :package-version '(markdown-mode . "2.3"))
4343 (defcustom markdown-code-block-braces nil
4344 "When non-nil, automatically insert braces for GFM code blocks."
4345 :group 'markdown
4346 :type 'boolean)
4348 (defun markdown-insert-gfm-code-block (&optional lang edit)
4349 "Insert GFM code block for language LANG.
4350 If LANG is nil, the language will be queried from user. If a
4351 region is active, wrap this region with the markup instead. If
4352 the region boundaries are not on empty lines, these are added
4353 automatically in order to have the correct markup. When EDIT is
4354 non-nil (e.g., when \\[universal-argument] is given), edit the
4355 code block in an indirect buffer after insertion."
4356 (interactive
4357 (list (let ((completion-ignore-case nil))
4358 (condition-case nil
4359 (markdown-clean-language-string
4360 (completing-read
4361 "Programming language: "
4362 (markdown-gfm-get-corpus)
4363 nil 'confirm (car markdown-gfm-used-languages)
4364 'markdown-gfm-language-history))
4365 (quit "")))
4366 current-prefix-arg))
4367 (unless (string= lang "") (markdown-gfm-add-used-language lang))
4368 (when (and (> (length lang) 0)
4369 (not markdown-code-block-braces))
4370 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s)
4371 lang)))
4372 (let ((gfm-open-brace (if markdown-code-block-braces "{" ""))
4373 (gfm-close-brace (if markdown-code-block-braces "}" "")))
4374 (if (use-region-p)
4375 (let* ((b (region-beginning)) (e (region-end)) end
4376 (indent (progn (goto-char b) (current-indentation))))
4377 (goto-char e)
4378 ;; if we're on a blank line, don't newline, otherwise the ```
4379 ;; should go on its own line
4380 (unless (looking-back "\n" nil)
4381 (newline))
4382 (indent-to indent)
4383 (insert "```")
4384 (markdown-ensure-blank-line-after)
4385 (setq end (point))
4386 (goto-char b)
4387 ;; if we're on a blank line, insert the quotes here, otherwise
4388 ;; add a new line first
4389 (unless (looking-at-p "\n")
4390 (newline)
4391 (forward-line -1))
4392 (markdown-ensure-blank-line-before)
4393 (indent-to indent)
4394 (insert "```" gfm-open-brace lang gfm-close-brace)
4395 (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end))
4396 (let ((indent (current-indentation))
4397 start-bol)
4398 (delete-horizontal-space :backward-only)
4399 (markdown-ensure-blank-line-before)
4400 (indent-to indent)
4401 (setq start-bol (point-at-bol))
4402 (insert "```" gfm-open-brace lang gfm-close-brace "\n")
4403 (indent-to indent)
4404 (unless edit (insert ?\n))
4405 (indent-to indent)
4406 (insert "```")
4407 (markdown-ensure-blank-line-after)
4408 (markdown-syntax-propertize-fenced-block-constructs start-bol (point)))
4409 (end-of-line 0)
4410 (when edit (markdown-edit-code-block)))))
4412 (defun markdown-code-block-lang (&optional pos-prop)
4413 "Return the language name for a GFM or tilde fenced code block.
4414 The beginning of the block may be described by POS-PROP,
4415 a cons of (pos . prop) giving the position and property
4416 at the beginning of the block."
4417 (or pos-prop
4418 (setq pos-prop
4419 (markdown-max-of-seq
4420 #'car
4421 (cl-remove-if
4422 #'null
4423 (cl-mapcar
4424 #'markdown-find-previous-prop
4425 (markdown-get-fenced-block-begin-properties))))))
4426 (when pos-prop
4427 (goto-char (car pos-prop))
4428 (set-match-data (get-text-property (point) (cdr pos-prop)))
4429 ;; Note: Hard-coded group number assumes tilde
4430 ;; and GFM fenced code regexp groups agree.
4431 (let ((begin (match-beginning 3))
4432 (end (match-end 3)))
4433 (when (and begin end)
4434 ;; Fix language strings beginning with periods, like ".ruby".
4435 (when (eq (char-after begin) ?.)
4436 (setq begin (1+ begin)))
4437 (buffer-substring-no-properties begin end)))))
4439 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer)
4440 (with-current-buffer (or buffer (current-buffer))
4441 (save-excursion
4442 (goto-char (point-min))
4443 (cl-loop
4444 with prop = 'markdown-gfm-block-begin
4445 for pos-prop = (markdown-find-next-prop prop)
4446 while pos-prop
4447 for lang = (markdown-code-block-lang pos-prop)
4448 do (progn (when lang (markdown-gfm-add-used-language lang))
4449 (goto-char (next-single-property-change (point) prop)))))))
4451 (defun markdown-insert-foldable-block ()
4452 "Insert details disclosure element to make content foldable.
4453 If a region is active, wrap this region with the disclosure
4454 element. More detais here 'https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details'."
4455 (interactive)
4456 (let ((details-open-tag "<details>")
4457 (details-close-tag "</details>")
4458 (summary-open-tag "<summary>")
4459 (summary-close-tag " </summary>"))
4460 (if (use-region-p)
4461 (let* ((b (region-beginning))
4462 (e (region-end))
4463 (indent (progn (goto-char b) (current-indentation))))
4464 (goto-char e)
4465 ;; if we're on a blank line, don't newline, otherwise the tags
4466 ;; should go on its own line
4467 (unless (looking-back "\n" nil)
4468 (newline))
4469 (indent-to indent)
4470 (insert details-close-tag)
4471 (markdown-ensure-blank-line-after)
4472 (goto-char b)
4473 ;; if we're on a blank line, insert the quotes here, otherwise
4474 ;; add a new line first
4475 (unless (looking-at-p "\n")
4476 (newline)
4477 (forward-line -1))
4478 (markdown-ensure-blank-line-before)
4479 (indent-to indent)
4480 (insert details-open-tag "\n")
4481 (insert summary-open-tag summary-close-tag)
4482 (search-backward summary-close-tag))
4483 (let ((indent (current-indentation)))
4484 (delete-horizontal-space :backward-only)
4485 (markdown-ensure-blank-line-before)
4486 (indent-to indent)
4487 (insert details-open-tag "\n")
4488 (insert summary-open-tag summary-close-tag "\n")
4489 (insert details-close-tag)
4490 (indent-to indent)
4491 (markdown-ensure-blank-line-after)
4492 (search-backward summary-close-tag)))))
4495 ;;; Footnotes =================================================================
4497 (defun markdown-footnote-counter-inc ()
4498 "Increment `markdown-footnote-counter' and return the new value."
4499 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet.
4500 (save-excursion
4501 (goto-char (point-min))
4502 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:")
4503 (point-max) t)
4504 (let ((fn (string-to-number (match-string 1))))
4505 (when (> fn markdown-footnote-counter)
4506 (setq markdown-footnote-counter fn))))))
4507 (cl-incf markdown-footnote-counter))
4509 (defun markdown-insert-footnote ()
4510 "Insert footnote with a new number and move point to footnote definition."
4511 (interactive)
4512 (let ((fn (markdown-footnote-counter-inc)))
4513 (insert (format "[^%d]" fn))
4514 (markdown-footnote-text-find-new-location)
4515 (markdown-ensure-blank-line-before)
4516 (unless (markdown-cur-line-blank-p)
4517 (insert "\n"))
4518 (insert (format "[^%d]: " fn))
4519 (markdown-ensure-blank-line-after)))
4521 (defun markdown-footnote-text-find-new-location ()
4522 "Position the point at the proper location for a new footnote text."
4523 (cond
4524 ((eq markdown-footnote-location 'end) (goto-char (point-max)))
4525 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block))
4526 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree))
4527 ((eq markdown-footnote-location 'header) (markdown-end-of-defun))))
4529 (defun markdown-footnote-kill ()
4530 "Kill the footnote at point.
4531 The footnote text is killed (and added to the kill ring), the
4532 footnote marker is deleted. Point has to be either at the
4533 footnote marker or in the footnote text."
4534 (interactive)
4535 (let ((marker-pos nil)
4536 (skip-deleting-marker nil)
4537 (starting-footnote-text-positions
4538 (markdown-footnote-text-positions)))
4539 (when starting-footnote-text-positions
4540 ;; We're starting in footnote text, so mark our return position and jump
4541 ;; to the marker if possible.
4542 (let ((marker-pos (markdown-footnote-find-marker
4543 (cl-first starting-footnote-text-positions))))
4544 (if marker-pos
4545 (goto-char (1- marker-pos))
4546 ;; If there isn't a marker, we still want to kill the text.
4547 (setq skip-deleting-marker t))))
4548 ;; Either we didn't start in the text, or we started in the text and jumped
4549 ;; to the marker. We want to assume we're at the marker now and error if
4550 ;; we're not.
4551 (unless skip-deleting-marker
4552 (let ((marker (markdown-footnote-delete-marker)))
4553 (unless marker
4554 (error "Not at a footnote"))
4555 ;; Even if we knew the text position before, it changed when we deleted
4556 ;; the label.
4557 (setq marker-pos (cl-second marker))
4558 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker))))
4559 (unless new-text-pos
4560 (error "No text for footnote `%s'" (cl-first marker)))
4561 (goto-char new-text-pos))))
4562 (let ((pos (markdown-footnote-kill-text)))
4563 (goto-char (if starting-footnote-text-positions
4565 marker-pos)))))
4567 (defun markdown-footnote-delete-marker ()
4568 "Delete a footnote marker at point.
4569 Returns a list (ID START) containing the footnote ID and the
4570 start position of the marker before deletion. If no footnote
4571 marker was deleted, this function returns NIL."
4572 (let ((marker (markdown-footnote-marker-positions)))
4573 (when marker
4574 (delete-region (cl-second marker) (cl-third marker))
4575 (butlast marker))))
4577 (defun markdown-footnote-kill-text ()
4578 "Kill footnote text at point.
4579 Returns the start position of the footnote text before deletion,
4580 or NIL if point was not inside a footnote text.
4582 The killed text is placed in the kill ring (without the footnote
4583 number)."
4584 (let ((fn (markdown-footnote-text-positions)))
4585 (when fn
4586 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn))))
4587 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text)
4588 (kill-new (match-string 1 text))
4589 (when (and (markdown-cur-line-blank-p)
4590 (markdown-prev-line-blank-p)
4591 (not (bobp)))
4592 (delete-region (1- (point)) (point)))
4593 (cl-second fn)))))
4595 (defun markdown-footnote-goto-text ()
4596 "Jump to the text of the footnote at point."
4597 (interactive)
4598 (let ((fn (car (markdown-footnote-marker-positions))))
4599 (unless fn
4600 (user-error "Not at a footnote marker"))
4601 (let ((new-pos (markdown-footnote-find-text fn)))
4602 (unless new-pos
4603 (error "No definition found for footnote `%s'" fn))
4604 (goto-char new-pos))))
4606 (defun markdown-footnote-return ()
4607 "Return from a footnote to its footnote number in the main text."
4608 (interactive)
4609 (let ((fn (save-excursion
4610 (car (markdown-footnote-text-positions)))))
4611 (unless fn
4612 (user-error "Not in a footnote"))
4613 (let ((new-pos (markdown-footnote-find-marker fn)))
4614 (unless new-pos
4615 (error "Footnote marker `%s' not found" fn))
4616 (goto-char new-pos))))
4618 (defun markdown-footnote-find-marker (id)
4619 "Find the location of the footnote marker with ID.
4620 The actual buffer position returned is the position directly
4621 following the marker's closing bracket. If no marker is found,
4622 NIL is returned."
4623 (save-excursion
4624 (goto-char (point-min))
4625 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t)
4626 (skip-chars-backward "^]")
4627 (point))))
4629 (defun markdown-footnote-find-text (id)
4630 "Find the location of the text of footnote ID.
4631 The actual buffer position returned is the position of the first
4632 character of the text, after the footnote's identifier. If no
4633 footnote text is found, NIL is returned."
4634 (save-excursion
4635 (goto-char (point-min))
4636 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t)
4637 (skip-chars-forward "[ \t]")
4638 (point))))
4640 (defun markdown-footnote-marker-positions ()
4641 "Return the position and ID of the footnote marker point is on.
4642 The return value is a list (ID START END). If point is not on a
4643 footnote, NIL is returned."
4644 ;; first make sure we're at a footnote marker
4645 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position))
4646 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]")))
4647 (save-excursion
4648 ;; move point between [ and ^:
4649 (if (looking-at-p "\\[")
4650 (forward-char 1)
4651 (skip-chars-backward "^["))
4652 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]"))
4653 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
4655 (defun markdown-footnote-text-positions ()
4656 "Return the start and end positions of the footnote text point is in.
4657 The exact return value is a list of three elements: (ID START END).
4658 The start position is the position of the opening bracket
4659 of the footnote id. The end position is directly after the
4660 newline that ends the footnote. If point is not in a footnote,
4661 NIL is returned instead."
4662 (save-excursion
4663 (let (result)
4664 (move-beginning-of-line 1)
4665 ;; Try to find the label. If we haven't found the label and we're at a blank
4666 ;; or indented line, back up if possible.
4667 (while (and
4668 (not (and (looking-at markdown-regex-footnote-definition)
4669 (setq result (list (match-string 1) (point)))))
4670 (and (not (bobp))
4671 (or (markdown-cur-line-blank-p)
4672 (>= (current-indentation) 4))))
4673 (forward-line -1))
4674 (when result
4675 ;; Advance if there is a next line that is either blank or indented.
4676 ;; (Need to check if we're on the last line, because
4677 ;; markdown-next-line-blank-p returns true for last line in buffer.)
4678 (while (and (/= (line-end-position) (point-max))
4679 (or (markdown-next-line-blank-p)
4680 (>= (markdown-next-line-indent) 4)))
4681 (forward-line))
4682 ;; Move back while the current line is blank.
4683 (while (markdown-cur-line-blank-p)
4684 (forward-line -1))
4685 ;; Advance to capture this line and a single trailing newline (if there
4686 ;; is one).
4687 (forward-line)
4688 (append result (list (point)))))))
4690 (defun markdown-get-defined-footnotes ()
4691 "Return a list of all defined footnotes.
4692 Result is an alist of pairs (MARKER . LINE), where MARKER is the
4693 footnote marker, a string, and LINE is the line number containing
4694 the footnote definition.
4696 For example, suppose the following footnotes are defined at positions
4697 448 and 475:
4699 \[^1]: First footnote here.
4700 \[^marker]: Second footnote.
4702 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
4703 (save-excursion
4704 (goto-char (point-min))
4705 (let (footnotes)
4706 (while (markdown-search-until-condition
4707 (lambda () (and (not (markdown-code-block-at-point-p))
4708 (not (markdown-inline-code-at-point-p))
4709 (not (markdown-in-comment-p))))
4710 markdown-regex-footnote-definition nil t)
4711 (let ((marker (match-string-no-properties 1))
4712 (pos (match-beginning 0)))
4713 (unless (zerop (length marker))
4714 (cl-pushnew (cons marker pos) footnotes :test #'equal))))
4715 (reverse footnotes))))
4718 ;;; Element Removal ===========================================================
4720 (defun markdown-kill-thing-at-point ()
4721 "Kill thing at point and add important text, without markup, to kill ring.
4722 Possible things to kill include (roughly in order of precedence):
4723 inline code, headers, horizontal rules, links (add link text to
4724 kill ring), images (add alt text to kill ring), angle uri, email
4725 addresses, bold, italics, reference definition (add URI to kill
4726 ring), footnote markers and text (kill both marker and text, add
4727 text to kill ring), and list items."
4728 (interactive "*")
4729 (let (val)
4730 (cond
4731 ;; Inline code
4732 ((markdown-inline-code-at-point)
4733 (kill-new (match-string 2))
4734 (delete-region (match-beginning 0) (match-end 0)))
4735 ;; ATX header
4736 ((thing-at-point-looking-at markdown-regex-header-atx)
4737 (kill-new (match-string 2))
4738 (delete-region (match-beginning 0) (match-end 0)))
4739 ;; Setext header
4740 ((thing-at-point-looking-at markdown-regex-header-setext)
4741 (kill-new (match-string 1))
4742 (delete-region (match-beginning 0) (match-end 0)))
4743 ;; Horizontal rule
4744 ((thing-at-point-looking-at markdown-regex-hr)
4745 (kill-new (match-string 0))
4746 (delete-region (match-beginning 0) (match-end 0)))
4747 ;; Inline link or image (add link or alt text to kill ring)
4748 ((thing-at-point-looking-at markdown-regex-link-inline)
4749 (kill-new (match-string 3))
4750 (delete-region (match-beginning 0) (match-end 0)))
4751 ;; Reference link or image (add link or alt text to kill ring)
4752 ((thing-at-point-looking-at markdown-regex-link-reference)
4753 (kill-new (match-string 3))
4754 (delete-region (match-beginning 0) (match-end 0)))
4755 ;; Angle URI (add URL to kill ring)
4756 ((thing-at-point-looking-at markdown-regex-angle-uri)
4757 (kill-new (match-string 2))
4758 (delete-region (match-beginning 0) (match-end 0)))
4759 ;; Email address in angle brackets (add email address to kill ring)
4760 ((thing-at-point-looking-at markdown-regex-email)
4761 (kill-new (match-string 1))
4762 (delete-region (match-beginning 0) (match-end 0)))
4763 ;; Wiki link (add alias text to kill ring)
4764 ((and markdown-enable-wiki-links
4765 (thing-at-point-looking-at markdown-regex-wiki-link))
4766 (kill-new (markdown-wiki-link-alias))
4767 (delete-region (match-beginning 1) (match-end 1)))
4768 ;; Bold
4769 ((thing-at-point-looking-at markdown-regex-bold)
4770 (kill-new (match-string 4))
4771 (delete-region (match-beginning 2) (match-end 2)))
4772 ;; Italics
4773 ((thing-at-point-looking-at markdown-regex-italic)
4774 (kill-new (match-string 3))
4775 (delete-region (match-beginning 1) (match-end 1)))
4776 ;; Strikethrough
4777 ((thing-at-point-looking-at markdown-regex-strike-through)
4778 (kill-new (match-string 4))
4779 (delete-region (match-beginning 2) (match-end 2)))
4780 ;; Footnote marker (add footnote text to kill ring)
4781 ((thing-at-point-looking-at markdown-regex-footnote)
4782 (markdown-footnote-kill))
4783 ;; Footnote text (add footnote text to kill ring)
4784 ((setq val (markdown-footnote-text-positions))
4785 (markdown-footnote-kill))
4786 ;; Reference definition (add URL to kill ring)
4787 ((thing-at-point-looking-at markdown-regex-reference-definition)
4788 (kill-new (match-string 5))
4789 (delete-region (match-beginning 0) (match-end 0)))
4790 ;; List item
4791 ((setq val (markdown-cur-list-item-bounds))
4792 (kill-new (delete-and-extract-region (cl-first val) (cl-second val))))
4794 (user-error "Nothing found at point to kill")))))
4796 (defun markdown-kill-outline ()
4797 "Kill visible heading and add it to `kill-ring'."
4798 (interactive)
4799 (save-excursion
4800 (markdown-outline-previous)
4801 (kill-region (point) (progn (markdown-outline-next) (point)))))
4803 (defun markdown-kill-block ()
4804 "Kill visible code block, list item, or blockquote and add it to `kill-ring'."
4805 (interactive)
4806 (save-excursion
4807 (markdown-backward-block)
4808 (kill-region (point) (progn (markdown-forward-block) (point)))))
4811 ;;; Indentation ===============================================================
4813 (defun markdown-indent-find-next-position (cur-pos positions)
4814 "Return the position after the index of CUR-POS in POSITIONS.
4815 Positions are calculated by `markdown-calc-indents'."
4816 (while (and positions
4817 (not (equal cur-pos (car positions))))
4818 (setq positions (cdr positions)))
4819 (or (cadr positions) 0))
4821 (defun markdown-outdent-find-next-position (cur-pos positions)
4822 "Return the maximal element that precedes CUR-POS from POSITIONS.
4823 Positions are calculated by `markdown-calc-indents'."
4824 (let ((result 0))
4825 (dolist (i positions)
4826 (when (< i cur-pos)
4827 (setq result (max result i))))
4828 result))
4830 (defun markdown-indent-line ()
4831 "Indent the current line using some heuristics.
4832 If the _previous_ command was either `markdown-enter-key' or
4833 `markdown-cycle', then we should cycle to the next
4834 reasonable indentation position. Otherwise, we could have been
4835 called directly by `markdown-enter-key', by an initial call of
4836 `markdown-cycle', or indirectly by `auto-fill-mode'. In
4837 these cases, indent to the default position.
4838 Positions are calculated by `markdown-calc-indents'."
4839 (interactive)
4840 (let ((positions (markdown-calc-indents))
4841 (point-pos (current-column))
4842 (_ (back-to-indentation))
4843 (cur-pos (current-column)))
4844 (if (not (equal this-command 'markdown-cycle))
4845 (indent-line-to (car positions))
4846 (setq positions (sort (delete-dups positions) '<))
4847 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions))
4848 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0)))
4849 (indent-line-to next-pos)
4850 (move-to-column new-point-pos)))))
4852 (defun markdown-calc-indents ()
4853 "Return a list of indentation columns to cycle through.
4854 The first element in the returned list should be considered the
4855 default indentation level. This function does not worry about
4856 duplicate positions, which are handled up by calling functions."
4857 (let (pos prev-line-pos positions)
4859 ;; Indentation of previous line
4860 (setq prev-line-pos (markdown-prev-line-indent))
4861 (setq positions (cons prev-line-pos positions))
4863 ;; Indentation of previous non-list-marker text
4864 (when (setq pos (save-excursion
4865 (forward-line -1)
4866 (when (looking-at markdown-regex-list)
4867 (- (match-end 3) (match-beginning 0)))))
4868 (setq positions (cons pos positions)))
4870 ;; Indentation required for a pre block in current context
4871 (setq pos (length (markdown-pre-indentation (point))))
4872 (setq positions (cons pos positions))
4874 ;; Indentation of the previous line + tab-width
4875 (if prev-line-pos
4876 (setq positions (cons (+ prev-line-pos tab-width) positions))
4877 (setq positions (cons tab-width positions)))
4879 ;; Indentation of the previous line - tab-width
4880 (if (and prev-line-pos (> prev-line-pos tab-width))
4881 (setq positions (cons (- prev-line-pos tab-width) positions)))
4883 ;; Indentation of all preceding list markers (when in a list)
4884 (when (setq pos (markdown-calculate-list-levels))
4885 (setq positions (append pos positions)))
4887 ;; First column
4888 (setq positions (cons 0 positions))
4890 ;; Return reversed list
4891 (reverse positions)))
4893 (defun markdown-enter-key ()
4894 "Handle RET depending on the context.
4895 If the point is at a table, move to the next row. Otherwise,
4896 indent according to value of `markdown-indent-on-enter'.
4897 When it is nil, simply call `newline'. Otherwise, indent the next line
4898 following RET using `markdown-indent-line'. Furthermore, when it
4899 is set to 'indent-and-new-item and the point is in a list item,
4900 start a new item with the same indentation. If the point is in an
4901 empty list item, remove it (so that pressing RET twice when in a
4902 list simply adds a blank line)."
4903 (interactive)
4904 (cond
4905 ;; Table
4906 ((markdown-table-at-point-p)
4907 (call-interactively #'markdown-table-next-row))
4908 ;; Indent non-table text
4909 (markdown-indent-on-enter
4910 (let (bounds)
4911 (if (and (memq markdown-indent-on-enter '(indent-and-new-item))
4912 (setq bounds (markdown-cur-list-item-bounds)))
4913 (let ((beg (cl-first bounds))
4914 (end (cl-second bounds))
4915 (length (cl-fourth bounds)))
4916 ;; Point is in a list item
4917 (if (= (- end beg) length)
4918 ;; Delete blank list
4919 (progn
4920 (delete-region beg end)
4921 (newline)
4922 (markdown-indent-line))
4923 (call-interactively #'markdown-insert-list-item)))
4924 ;; Point is not in a list
4925 (newline)
4926 (markdown-indent-line))))
4927 ;; Insert a raw newline
4928 (t (newline))))
4930 (defun markdown-outdent-or-delete (arg)
4931 "Handle BACKSPACE by cycling through indentation points.
4932 When BACKSPACE is pressed, if there is only whitespace
4933 before the current point, then outdent the line one level.
4934 Otherwise, do normal delete by repeating
4935 `backward-delete-char-untabify' ARG times."
4936 (interactive "*p")
4937 (if (use-region-p)
4938 (backward-delete-char-untabify arg)
4939 (let ((cur-pos (current-column))
4940 (start-of-indention (save-excursion
4941 (back-to-indentation)
4942 (current-column)))
4943 (positions (markdown-calc-indents)))
4944 (if (and (> cur-pos 0) (= cur-pos start-of-indention))
4945 (indent-line-to (markdown-outdent-find-next-position cur-pos positions))
4946 (backward-delete-char-untabify arg)))))
4948 (defun markdown-find-leftmost-column (beg end)
4949 "Find the leftmost column in the region from BEG to END."
4950 (let ((mincol 1000))
4951 (save-excursion
4952 (goto-char beg)
4953 (while (< (point) end)
4954 (back-to-indentation)
4955 (unless (looking-at-p "[ \t]*$")
4956 (setq mincol (min mincol (current-column))))
4957 (forward-line 1)
4959 mincol))
4961 (defun markdown-indent-region (beg end arg)
4962 "Indent the region from BEG to END using some heuristics.
4963 When ARG is non-nil, outdent the region instead.
4964 See `markdown-indent-line' and `markdown-indent-line'."
4965 (interactive "*r\nP")
4966 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
4967 (leftmostcol (markdown-find-leftmost-column beg end))
4968 (next-pos (if arg
4969 (markdown-outdent-find-next-position leftmostcol positions)
4970 (markdown-indent-find-next-position leftmostcol positions))))
4971 (indent-rigidly beg end (- next-pos leftmostcol))
4972 (setq deactivate-mark nil)))
4974 (defun markdown-outdent-region (beg end)
4975 "Call `markdown-indent-region' on region from BEG to END with prefix."
4976 (interactive "*r")
4977 (markdown-indent-region beg end t))
4979 (defun markdown--indent-region (start end)
4980 (let ((deactivate-mark nil))
4981 (save-excursion
4982 (goto-char end)
4983 (setq end (point-marker))
4984 (goto-char start)
4985 (when (bolp)
4986 (forward-line 1))
4987 (while (< (point) end)
4988 (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp)))
4989 (indent-according-to-mode))
4990 (forward-line 1))
4991 (move-marker end nil))))
4994 ;;; Markup Completion =========================================================
4996 (defconst markdown-complete-alist
4997 '((markdown-regex-header-atx . markdown-complete-atx)
4998 (markdown-regex-header-setext . markdown-complete-setext)
4999 (markdown-regex-hr . markdown-complete-hr))
5000 "Association list of form (regexp . function) for markup completion.")
5002 (defun markdown-incomplete-atx-p ()
5003 "Return t if ATX header markup is incomplete and nil otherwise.
5004 Assumes match data is available for `markdown-regex-header-atx'.
5005 Checks that the number of trailing hash marks equals the number of leading
5006 hash marks, that there is only a single space before and after the text,
5007 and that there is no extraneous whitespace in the text."
5009 ;; Number of starting and ending hash marks differs
5010 (not (= (length (match-string 1)) (length (match-string 3))))
5011 ;; When the header text is not empty...
5012 (and (> (length (match-string 2)) 0)
5013 ;; ...if there are extra leading, trailing, or interior spaces
5014 (or (not (= (match-beginning 2) (1+ (match-end 1))))
5015 (not (= (match-beginning 3) (1+ (match-end 2))))
5016 (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
5017 ;; When the header text is empty...
5018 (and (= (length (match-string 2)) 0)
5019 ;; ...if there are too many or too few spaces
5020 (not (= (match-beginning 3) (+ (match-end 1) 2))))))
5022 (defun markdown-complete-atx ()
5023 "Complete and normalize ATX headers.
5024 Add or remove hash marks to the end of the header to match the
5025 beginning. Ensure that there is only a single space between hash
5026 marks and header text. Removes extraneous whitespace from header text.
5027 Assumes match data is available for `markdown-regex-header-atx'.
5028 Return nil if markup was complete and non-nil if markup was completed."
5029 (when (markdown-incomplete-atx-p)
5030 (let* ((new-marker (make-marker))
5031 (new-marker (set-marker new-marker (match-end 2))))
5032 ;; Hash marks and spacing at end
5033 (goto-char (match-end 2))
5034 (delete-region (match-end 2) (match-end 3))
5035 (insert " " (match-string 1))
5036 ;; Remove extraneous whitespace from title
5037 (replace-match (markdown-compress-whitespace-string (match-string 2))
5038 t t nil 2)
5039 ;; Spacing at beginning
5040 (goto-char (match-end 1))
5041 (delete-region (match-end 1) (match-beginning 2))
5042 (insert " ")
5043 ;; Leave point at end of text
5044 (goto-char new-marker))))
5046 (defun markdown-incomplete-setext-p ()
5047 "Return t if setext header markup is incomplete and nil otherwise.
5048 Assumes match data is available for `markdown-regex-header-setext'.
5049 Checks that length of underline matches text and that there is no
5050 extraneous whitespace in the text."
5051 (or (not (= (length (match-string 1)) (length (match-string 2))))
5052 (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
5054 (defun markdown-complete-setext ()
5055 "Complete and normalize setext headers.
5056 Add or remove underline characters to match length of header
5057 text. Removes extraneous whitespace from header text. Assumes
5058 match data is available for `markdown-regex-header-setext'.
5059 Return nil if markup was complete and non-nil if markup was completed."
5060 (when (markdown-incomplete-setext-p)
5061 (let* ((text (markdown-compress-whitespace-string (match-string 1)))
5062 (char (char-after (match-beginning 2)))
5063 (level (if (char-equal char ?-) 2 1)))
5064 (goto-char (match-beginning 0))
5065 (delete-region (match-beginning 0) (match-end 0))
5066 (markdown-insert-header level text t)
5067 t)))
5069 (defun markdown-incomplete-hr-p ()
5070 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
5071 Assumes match data is available for `markdown-regex-hr'."
5072 (not (member (match-string 0) markdown-hr-strings)))
5074 (defun markdown-complete-hr ()
5075 "Complete horizontal rules.
5076 If horizontal rule string is a member of `markdown-hr-strings',
5077 do nothing. Otherwise, replace with the car of
5078 `markdown-hr-strings'.
5079 Assumes match data is available for `markdown-regex-hr'.
5080 Return nil if markup was complete and non-nil if markup was completed."
5081 (when (markdown-incomplete-hr-p)
5082 (replace-match (car markdown-hr-strings))
5085 (defun markdown-complete ()
5086 "Complete markup of object near point or in region when active.
5087 Handle all objects in `markdown-complete-alist', in order.
5088 See `markdown-complete-at-point' and `markdown-complete-region'."
5089 (interactive "*")
5090 (if (use-region-p)
5091 (markdown-complete-region (region-beginning) (region-end))
5092 (markdown-complete-at-point)))
5094 (defun markdown-complete-at-point ()
5095 "Complete markup of object near point.
5096 Handle all elements of `markdown-complete-alist' in order."
5097 (interactive "*")
5098 (let ((list markdown-complete-alist) found changed)
5099 (while list
5100 (let ((regexp (eval (caar list)))
5101 (function (cdar list)))
5102 (setq list (cdr list))
5103 (when (thing-at-point-looking-at regexp)
5104 (setq found t)
5105 (setq changed (funcall function))
5106 (setq list nil))))
5107 (if found
5108 (or changed (user-error "Markup at point is complete"))
5109 (user-error "Nothing to complete at point"))))
5111 (defun markdown-complete-region (beg end)
5112 "Complete markup of objects in region from BEG to END.
5113 Handle all objects in `markdown-complete-alist', in order. Each
5114 match is checked to ensure that a previous regexp does not also
5115 match."
5116 (interactive "*r")
5117 (let ((end-marker (set-marker (make-marker) end))
5118 previous)
5119 (dolist (element markdown-complete-alist)
5120 (let ((regexp (eval (car element)))
5121 (function (cdr element)))
5122 (goto-char beg)
5123 (while (re-search-forward regexp end-marker 'limit)
5124 (when (match-string 0)
5125 ;; Make sure this is not a match for any of the preceding regexps.
5126 ;; This prevents mistaking an HR for a Setext subheading.
5127 (let (match)
5128 (save-match-data
5129 (dolist (prev-regexp previous)
5130 (or match (setq match (looking-back prev-regexp nil)))))
5131 (unless match
5132 (save-excursion (funcall function))))))
5133 (cl-pushnew regexp previous :test #'equal)))
5134 previous))
5136 (defun markdown-complete-buffer ()
5137 "Complete markup for all objects in the current buffer."
5138 (interactive "*")
5139 (markdown-complete-region (point-min) (point-max)))
5142 ;;; Markup Cycling ============================================================
5144 (defun markdown-cycle-atx (arg &optional remove)
5145 "Cycle ATX header markup.
5146 Promote header (decrease level) when ARG is 1 and demote
5147 header (increase level) if arg is -1. When REMOVE is non-nil,
5148 remove the header when the level reaches zero and stop cycling
5149 when it reaches six. Otherwise, perform a proper cycling through
5150 levels one through six. Assumes match data is available for
5151 `markdown-regex-header-atx'."
5152 (let* ((old-level (length (match-string 1)))
5153 (new-level (+ old-level arg))
5154 (text (match-string 2)))
5155 (when (not remove)
5156 (setq new-level (% new-level 6))
5157 (setq new-level (cond ((= new-level 0) 6)
5158 ((< new-level 0) (+ new-level 6))
5159 (t new-level))))
5160 (cond
5161 ((= new-level 0)
5162 (markdown-unwrap-thing-at-point nil 0 2))
5163 ((<= new-level 6)
5164 (goto-char (match-beginning 0))
5165 (delete-region (match-beginning 0) (match-end 0))
5166 (markdown-insert-header new-level text nil)))))
5168 (defun markdown-cycle-setext (arg &optional remove)
5169 "Cycle setext header markup.
5170 Promote header (increase level) when ARG is 1 and demote
5171 header (decrease level or remove) if arg is -1. When demoting a
5172 level-two setext header, replace with a level-three atx header.
5173 When REMOVE is non-nil, remove the header when the level reaches
5174 zero. Otherwise, cycle back to a level six atx header. Assumes
5175 match data is available for `markdown-regex-header-setext'."
5176 (let* ((char (char-after (match-beginning 2)))
5177 (old-level (if (char-equal char ?=) 1 2))
5178 (new-level (+ old-level arg)))
5179 (when (and (not remove) (= new-level 0))
5180 (setq new-level 6))
5181 (cond
5182 ((= new-level 0)
5183 (markdown-unwrap-thing-at-point nil 0 1))
5184 ((<= new-level 2)
5185 (markdown-insert-header new-level nil t))
5186 ((<= new-level 6)
5187 (markdown-insert-header new-level nil nil)))))
5189 (defun markdown-cycle-hr (arg &optional remove)
5190 "Cycle string used for horizontal rule from `markdown-hr-strings'.
5191 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
5192 backwards (promote). When REMOVE is non-nil, remove the hr instead
5193 of cycling when the end of the list is reached.
5194 Assumes match data is available for `markdown-regex-hr'."
5195 (let* ((strings (if (= arg -1)
5196 (reverse markdown-hr-strings)
5197 markdown-hr-strings))
5198 (tail (member (match-string 0) strings))
5199 (new (or (cadr tail)
5200 (if remove
5201 (if (= arg 1)
5203 (car tail))
5204 (car strings)))))
5205 (replace-match new)))
5207 (defun markdown-cycle-bold ()
5208 "Cycle bold markup between underscores and asterisks.
5209 Assumes match data is available for `markdown-regex-bold'."
5210 (save-excursion
5211 (let* ((old-delim (match-string 3))
5212 (new-delim (if (string-equal old-delim "**") "__" "**")))
5213 (replace-match new-delim t t nil 3)
5214 (replace-match new-delim t t nil 5))))
5216 (defun markdown-cycle-italic ()
5217 "Cycle italic markup between underscores and asterisks.
5218 Assumes match data is available for `markdown-regex-italic'."
5219 (save-excursion
5220 (let* ((old-delim (match-string 2))
5221 (new-delim (if (string-equal old-delim "*") "_" "*")))
5222 (replace-match new-delim t t nil 2)
5223 (replace-match new-delim t t nil 4))))
5226 ;;; Keymap ====================================================================
5228 (defun markdown--style-map-prompt ()
5229 "Return a formatted prompt for Markdown markup insertion."
5230 (when markdown-enable-prefix-prompts
5231 (concat
5232 "Markdown: "
5233 (propertize "bold" 'face 'markdown-bold-face) ", "
5234 (propertize "italic" 'face 'markdown-italic-face) ", "
5235 (propertize "code" 'face 'markdown-inline-code-face) ", "
5236 (propertize "C = GFM code" 'face 'markdown-code-face) ", "
5237 (propertize "pre" 'face 'markdown-pre-face) ", "
5238 (propertize "footnote" 'face 'markdown-footnote-text-face) ", "
5239 (propertize "F = foldable" 'face 'markdown-bold-face) ", "
5240 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", "
5241 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", "
5242 (propertize "- = hr" 'face 'markdown-hr-face) ", "
5243 "C-h = more")))
5245 (defun markdown--command-map-prompt ()
5246 "Return prompt for Markdown buffer-wide commands."
5247 (when markdown-enable-prefix-prompts
5248 (concat
5249 "Command: "
5250 (propertize "m" 'face 'markdown-bold-face) "arkdown, "
5251 (propertize "p" 'face 'markdown-bold-face) "review, "
5252 (propertize "o" 'face 'markdown-bold-face) "pen, "
5253 (propertize "e" 'face 'markdown-bold-face) "xport, "
5254 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, "
5255 (propertize "c" 'face 'markdown-bold-face) "heck refs, "
5256 (propertize "u" 'face 'markdown-bold-face) "nused refs, "
5257 "C-h = more")))
5259 (defvar markdown-mode-style-map
5260 (let ((map (make-keymap (markdown--style-map-prompt))))
5261 (define-key map (kbd "1") 'markdown-insert-header-atx-1)
5262 (define-key map (kbd "2") 'markdown-insert-header-atx-2)
5263 (define-key map (kbd "3") 'markdown-insert-header-atx-3)
5264 (define-key map (kbd "4") 'markdown-insert-header-atx-4)
5265 (define-key map (kbd "5") 'markdown-insert-header-atx-5)
5266 (define-key map (kbd "6") 'markdown-insert-header-atx-6)
5267 (define-key map (kbd "!") 'markdown-insert-header-setext-1)
5268 (define-key map (kbd "@") 'markdown-insert-header-setext-2)
5269 (define-key map (kbd "b") 'markdown-insert-bold)
5270 (define-key map (kbd "c") 'markdown-insert-code)
5271 (define-key map (kbd "C") 'markdown-insert-gfm-code-block)
5272 (define-key map (kbd "f") 'markdown-insert-footnote)
5273 (define-key map (kbd "F") 'markdown-insert-foldable-block)
5274 (define-key map (kbd "h") 'markdown-insert-header-dwim)
5275 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim)
5276 (define-key map (kbd "i") 'markdown-insert-italic)
5277 (define-key map (kbd "k") 'markdown-insert-kbd)
5278 (define-key map (kbd "l") 'markdown-insert-link)
5279 (define-key map (kbd "p") 'markdown-insert-pre)
5280 (define-key map (kbd "P") 'markdown-pre-region)
5281 (define-key map (kbd "q") 'markdown-insert-blockquote)
5282 (define-key map (kbd "s") 'markdown-insert-strike-through)
5283 (define-key map (kbd "t") 'markdown-insert-table)
5284 (define-key map (kbd "Q") 'markdown-blockquote-region)
5285 (define-key map (kbd "w") 'markdown-insert-wiki-link)
5286 (define-key map (kbd "-") 'markdown-insert-hr)
5287 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox)
5288 ;; Deprecated keys that may be removed in a future version
5289 (define-key map (kbd "e") 'markdown-insert-italic)
5290 map)
5291 "Keymap for Markdown text styling commands.")
5293 (defvar markdown-mode-command-map
5294 (let ((map (make-keymap (markdown--command-map-prompt))))
5295 (define-key map (kbd "m") 'markdown-other-window)
5296 (define-key map (kbd "p") 'markdown-preview)
5297 (define-key map (kbd "e") 'markdown-export)
5298 (define-key map (kbd "v") 'markdown-export-and-preview)
5299 (define-key map (kbd "o") 'markdown-open)
5300 (define-key map (kbd "l") 'markdown-live-preview-mode)
5301 (define-key map (kbd "w") 'markdown-kill-ring-save)
5302 (define-key map (kbd "c") 'markdown-check-refs)
5303 (define-key map (kbd "u") 'markdown-unused-refs)
5304 (define-key map (kbd "n") 'markdown-cleanup-list-numbers)
5305 (define-key map (kbd "]") 'markdown-complete-buffer)
5306 (define-key map (kbd "^") 'markdown-table-sort-lines)
5307 (define-key map (kbd "|") 'markdown-table-convert-region)
5308 (define-key map (kbd "t") 'markdown-table-transpose)
5309 map)
5310 "Keymap for Markdown buffer-wide commands.")
5312 (defvar markdown-mode-map
5313 (let ((map (make-keymap)))
5314 ;; Markup insertion & removal
5315 (define-key map (kbd "C-c C-s") markdown-mode-style-map)
5316 (define-key map (kbd "C-c C-l") 'markdown-insert-link)
5317 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point)
5318 ;; Promotion, demotion, and cycling
5319 (define-key map (kbd "C-c C--") 'markdown-promote)
5320 (define-key map (kbd "C-c C-=") 'markdown-demote)
5321 (define-key map (kbd "C-c C-]") 'markdown-complete)
5322 ;; Following and doing things
5323 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point)
5324 (define-key map (kbd "C-c C-d") 'markdown-do)
5325 (define-key map (kbd "C-c '") 'markdown-edit-code-block)
5326 ;; Indentation
5327 (define-key map (kbd "C-m") 'markdown-enter-key)
5328 (define-key map (kbd "DEL") 'markdown-outdent-or-delete)
5329 (define-key map (kbd "C-c >") 'markdown-indent-region)
5330 (define-key map (kbd "C-c <") 'markdown-outdent-region)
5331 ;; Visibility cycling
5332 (define-key map (kbd "TAB") 'markdown-cycle)
5333 (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
5334 (define-key map (kbd "<S-tab>") 'markdown-shifttab)
5335 (define-key map (kbd "<backtab>") 'markdown-shifttab)
5336 ;; Heading and list navigation
5337 (define-key map (kbd "C-c C-n") 'markdown-outline-next)
5338 (define-key map (kbd "C-c C-p") 'markdown-outline-previous)
5339 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level)
5340 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level)
5341 (define-key map (kbd "C-c C-u") 'markdown-outline-up)
5342 ;; Buffer-wide commands
5343 (define-key map (kbd "C-c C-c") markdown-mode-command-map)
5344 ;; Subtree, list, and table editing
5345 (define-key map (kbd "C-c <up>") 'markdown-move-up)
5346 (define-key map (kbd "C-c <down>") 'markdown-move-down)
5347 (define-key map (kbd "C-c <left>") 'markdown-promote)
5348 (define-key map (kbd "C-c <right>") 'markdown-demote)
5349 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row)
5350 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row)
5351 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column)
5352 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column)
5353 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree)
5354 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree)
5355 (define-key map (kbd "M-RET") 'markdown-insert-list-item)
5356 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item)
5357 ;; Paragraphs (Markdown context aware)
5358 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph)
5359 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph)
5360 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph)
5361 ;; Blocks (one or more paragraphs)
5362 (define-key map (kbd "C-M-{") 'markdown-backward-block)
5363 (define-key map (kbd "C-M-}") 'markdown-forward-block)
5364 (define-key map (kbd "C-c M-h") 'markdown-mark-block)
5365 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block)
5366 ;; Pages (top-level sections)
5367 (define-key map [remap backward-page] 'markdown-backward-page)
5368 (define-key map [remap forward-page] 'markdown-forward-page)
5369 (define-key map [remap mark-page] 'markdown-mark-page)
5370 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page)
5371 ;; Link Movement
5372 (define-key map (kbd "M-n") 'markdown-next-link)
5373 (define-key map (kbd "M-p") 'markdown-previous-link)
5374 ;; Toggling functionality
5375 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math)
5376 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively)
5377 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images)
5378 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding)
5379 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding)
5380 ;; Alternative keys (in case of problems with the arrow keys)
5381 (define-key map (kbd "C-c C-x u") 'markdown-move-up)
5382 (define-key map (kbd "C-c C-x d") 'markdown-move-down)
5383 (define-key map (kbd "C-c C-x l") 'markdown-promote)
5384 (define-key map (kbd "C-c C-x r") 'markdown-demote)
5385 ;; Deprecated keys that may be removed in a future version
5386 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l
5387 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l
5388 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l
5389 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l
5390 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote)
5391 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link)
5392 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1)
5393 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2)
5394 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3)
5395 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4)
5396 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5)
5397 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6)
5398 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1)
5399 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2)
5400 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim)
5401 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim)
5402 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2)
5403 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1)
5404 (define-key map (kbd "C-c C-i") 'markdown-insert-image)
5405 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j
5406 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d
5407 (define-key map (kbd "C-c -") 'markdown-insert-hr)
5408 map)
5409 "Keymap for Markdown major mode.")
5411 (defvar markdown-mode-mouse-map
5412 (when markdown-mouse-follow-link
5413 (let ((map (make-sparse-keymap)))
5414 (define-key map [follow-link] 'mouse-face)
5415 (define-key map [mouse-2] #'markdown-follow-thing-at-point)
5416 map))
5417 "Keymap for following links with mouse.")
5419 (defvar gfm-mode-map
5420 (let ((map (make-sparse-keymap)))
5421 (set-keymap-parent map markdown-mode-map)
5422 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through)
5423 (define-key map "`" 'markdown-electric-backquote)
5424 map)
5425 "Keymap for `gfm-mode'.
5426 See also `markdown-mode-map'.")
5429 ;;; Menu ======================================================================
5431 (easy-menu-define markdown-mode-menu markdown-mode-map
5432 "Menu for Markdown mode."
5433 '("Markdown"
5434 "---"
5435 ("Movement"
5436 ["Jump" markdown-do]
5437 ["Follow Link" markdown-follow-thing-at-point]
5438 ["Next Link" markdown-next-link]
5439 ["Previous Link" markdown-previous-link]
5440 "---"
5441 ["Next Heading or List Item" markdown-outline-next]
5442 ["Previous Heading or List Item" markdown-outline-previous]
5443 ["Next at Same Level" markdown-outline-next-same-level]
5444 ["Previous at Same Level" markdown-outline-previous-same-level]
5445 ["Up to Parent" markdown-outline-up]
5446 "---"
5447 ["Forward Paragraph" markdown-forward-paragraph]
5448 ["Backward Paragraph" markdown-backward-paragraph]
5449 ["Forward Block" markdown-forward-block]
5450 ["Backward Block" markdown-backward-block])
5451 ("Show & Hide"
5452 ["Cycle Heading Visibility" markdown-cycle
5453 :enable (markdown-on-heading-p)]
5454 ["Cycle Heading Visibility (Global)" markdown-shifttab]
5455 "---"
5456 ["Narrow to Region" narrow-to-region]
5457 ["Narrow to Block" markdown-narrow-to-block]
5458 ["Narrow to Section" narrow-to-defun]
5459 ["Narrow to Subtree" markdown-narrow-to-subtree]
5460 ["Widen" widen (buffer-narrowed-p)]
5461 "---"
5462 ["Toggle Markup Hiding" markdown-toggle-markup-hiding
5463 :keys "C-c C-x C-m"
5464 :style radio
5465 :selected markdown-hide-markup])
5466 "---"
5467 ("Headings & Structure"
5468 ["Automatic Heading" markdown-insert-header-dwim
5469 :keys "C-c C-s h"]
5470 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
5471 :keys "C-c C-s H"]
5472 ("Specific Heading (atx)"
5473 ["First Level atx" markdown-insert-header-atx-1
5474 :keys "C-c C-s 1"]
5475 ["Second Level atx" markdown-insert-header-atx-2
5476 :keys "C-c C-s 2"]
5477 ["Third Level atx" markdown-insert-header-atx-3
5478 :keys "C-c C-s 3"]
5479 ["Fourth Level atx" markdown-insert-header-atx-4
5480 :keys "C-c C-s 4"]
5481 ["Fifth Level atx" markdown-insert-header-atx-5
5482 :keys "C-c C-s 5"]
5483 ["Sixth Level atx" markdown-insert-header-atx-6
5484 :keys "C-c C-s 6"])
5485 ("Specific Heading (Setext)"
5486 ["First Level Setext" markdown-insert-header-setext-1
5487 :keys "C-c C-s !"]
5488 ["Second Level Setext" markdown-insert-header-setext-2
5489 :keys "C-c C-s @"])
5490 ["Horizontal Rule" markdown-insert-hr
5491 :keys "C-c C-s -"]
5492 "---"
5493 ["Move Subtree Up" markdown-move-up
5494 :keys "C-c <up>"]
5495 ["Move Subtree Down" markdown-move-down
5496 :keys "C-c <down>"]
5497 ["Promote Subtree" markdown-promote
5498 :keys "C-c <left>"]
5499 ["Demote Subtree" markdown-demote
5500 :keys "C-c <right>"])
5501 ("Region & Mark"
5502 ["Indent Region" markdown-indent-region]
5503 ["Outdent Region" markdown-outdent-region]
5504 "--"
5505 ["Mark Paragraph" mark-paragraph]
5506 ["Mark Block" markdown-mark-block]
5507 ["Mark Section" mark-defun]
5508 ["Mark Subtree" markdown-mark-subtree])
5509 ("Tables"
5510 ["Move Row Up" markdown-move-up
5511 :enable (markdown-table-at-point-p)
5512 :keys "C-c <up>"]
5513 ["Move Row Down" markdown-move-down
5514 :enable (markdown-table-at-point-p)
5515 :keys "C-c <down>"]
5516 ["Move Column Left" markdown-demote
5517 :enable (markdown-table-at-point-p)
5518 :keys "C-c <left>"]
5519 ["Move Column Right" markdown-promote
5520 :enable (markdown-table-at-point-p)
5521 :keys "C-c <right>"]
5522 ["Delete Row" markdown-table-delete-row
5523 :enable (markdown-table-at-point-p)]
5524 ["Insert Row" markdown-table-insert-row
5525 :enable (markdown-table-at-point-p)]
5526 ["Delete Column" markdown-table-delete-column
5527 :enable (markdown-table-at-point-p)]
5528 ["Insert Column" markdown-table-insert-column
5529 :enable (markdown-table-at-point-p)]
5530 ["Insert Table" markdown-insert-table]
5531 "--"
5532 ["Convert Region to Table" markdown-table-convert-region]
5533 ["Sort Table Lines" markdown-table-sort-lines
5534 :enable (markdown-table-at-point-p)]
5535 ["Transpose Table" markdown-table-transpose
5536 :enable (markdown-table-at-point-p)])
5537 ("Lists"
5538 ["Insert List Item" markdown-insert-list-item]
5539 ["Move Subtree Up" markdown-move-up
5540 :keys "C-c <up>"]
5541 ["Move Subtree Down" markdown-move-down
5542 :keys "C-c <down>"]
5543 ["Indent Subtree" markdown-demote
5544 :keys "C-c <right>"]
5545 ["Outdent Subtree" markdown-promote
5546 :keys "C-c <left>"]
5547 ["Renumber List" markdown-cleanup-list-numbers]
5548 ["Insert Task List Item" markdown-insert-gfm-checkbox
5549 :keys "C-c C-x ["]
5550 ["Toggle Task List Item" markdown-toggle-gfm-checkbox
5551 :enable (markdown-gfm-task-list-item-at-point)
5552 :keys "C-c C-d"])
5553 ("Links & Images"
5554 ["Insert Link" markdown-insert-link]
5555 ["Insert Image" markdown-insert-image]
5556 ["Insert Footnote" markdown-insert-footnote
5557 :keys "C-c C-s f"]
5558 ["Insert Wiki Link" markdown-insert-wiki-link
5559 :keys "C-c C-s w"]
5560 "---"
5561 ["Check References" markdown-check-refs]
5562 ["Find Unused References" markdown-unused-refs]
5563 ["Toggle URL Hiding" markdown-toggle-url-hiding
5564 :style radio
5565 :selected markdown-hide-urls]
5566 ["Toggle Inline Images" markdown-toggle-inline-images
5567 :keys "C-c C-x C-i"
5568 :style radio
5569 :selected markdown-inline-image-overlays]
5570 ["Toggle Wiki Links" markdown-toggle-wiki-links
5571 :style radio
5572 :selected markdown-enable-wiki-links])
5573 ("Styles"
5574 ["Bold" markdown-insert-bold]
5575 ["Italic" markdown-insert-italic]
5576 ["Code" markdown-insert-code]
5577 ["Strikethrough" markdown-insert-strike-through]
5578 ["Keyboard" markdown-insert-kbd]
5579 "---"
5580 ["Blockquote" markdown-insert-blockquote]
5581 ["Preformatted" markdown-insert-pre]
5582 ["GFM Code Block" markdown-insert-gfm-code-block]
5583 ["Edit Code Block" markdown-edit-code-block
5584 :enable (markdown-code-block-at-point-p)]
5585 ["Foldable Block" markdown-insert-foldable-block]
5586 "---"
5587 ["Blockquote Region" markdown-blockquote-region]
5588 ["Preformatted Region" markdown-pre-region]
5589 "---"
5590 ["Fontify Code Blocks Natively"
5591 markdown-toggle-fontify-code-blocks-natively
5592 :style radio
5593 :selected markdown-fontify-code-blocks-natively]
5594 ["LaTeX Math Support" markdown-toggle-math
5595 :style radio
5596 :selected markdown-enable-math])
5597 "---"
5598 ("Preview & Export"
5599 ["Compile" markdown-other-window]
5600 ["Preview" markdown-preview]
5601 ["Export" markdown-export]
5602 ["Export & View" markdown-export-and-preview]
5603 ["Open" markdown-open]
5604 ["Live Export" markdown-live-preview-mode
5605 :style radio
5606 :selected markdown-live-preview-mode]
5607 ["Kill ring save" markdown-kill-ring-save])
5608 ("Markup Completion and Cycling"
5609 ["Complete Markup" markdown-complete]
5610 ["Promote Element" markdown-promote
5611 :keys "C-c C--"]
5612 ["Demote Element" markdown-demote
5613 :keys "C-c C-="])
5614 "---"
5615 ["Kill Element" markdown-kill-thing-at-point]
5616 "---"
5617 ("Documentation"
5618 ["Version" markdown-show-version]
5619 ["Homepage" markdown-mode-info]
5620 ["Describe Mode" (describe-function 'markdown-mode)]
5621 ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
5624 ;;; imenu =====================================================================
5626 (defun markdown-imenu-create-nested-index ()
5627 "Create and return a nested imenu index alist for the current buffer.
5628 See `imenu-create-index-function' and `imenu--index-alist' for details."
5629 (let* ((root '(nil . nil))
5630 (min-level 9999)
5631 hashes headers)
5632 (save-excursion
5633 ;; Headings
5634 (goto-char (point-min))
5635 (while (re-search-forward markdown-regex-header (point-max) t)
5636 (unless (or (markdown-code-block-at-point-p)
5637 (and (match-beginning 3)
5638 (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end)))
5639 (cond
5640 ((match-string-no-properties 2) ;; level 1 setext
5641 (setq min-level 1)
5642 (push (list :heading (match-string-no-properties 1)
5643 :point (match-beginning 1)
5644 :level 1) headers))
5645 ((match-string-no-properties 3) ;; level 2 setext
5646 (setq min-level (min min-level 2))
5647 (push (list :heading (match-string-no-properties 1)
5648 :point (match-beginning 1)
5649 :level (- 2 (1- min-level))) headers))
5650 ((setq hashes (markdown-trim-whitespace
5651 (match-string-no-properties 4)))
5652 (setq min-level (min min-level (length hashes)))
5653 (push (list :heading (match-string-no-properties 5)
5654 :point (match-beginning 4)
5655 :level (- (length hashes) (1- min-level))) headers)))))
5656 (cl-loop with cur-level = 0
5657 with cur-alist = nil
5658 with empty-heading = "-"
5659 with self-heading = "."
5660 for header in (reverse headers)
5661 for level = (plist-get header :level)
5663 (let ((alist (list (cons (plist-get header :heading) (plist-get header :point)))))
5664 (cond
5665 ((= cur-level level) ; new sibling
5666 (setcdr cur-alist alist)
5667 (setq cur-alist alist))
5668 ((< cur-level level) ; first child
5669 (dotimes (_ (- level cur-level 1))
5670 (setq alist (list (cons empty-heading alist))))
5671 (if cur-alist
5672 (let* ((parent (car cur-alist))
5673 (self-pos (cdr parent)))
5674 (setcdr parent (cons (cons self-heading self-pos) alist)))
5675 (setcdr root alist)) ; primogenitor
5676 (setq cur-alist alist)
5677 (setq cur-level level))
5678 (t ; new sibling of an ancestor
5679 (let ((sibling-alist (last (cdr root))))
5680 (dotimes (_ (1- level))
5681 (setq sibling-alist (last (cdar sibling-alist))))
5682 (setcdr sibling-alist alist)
5683 (setq cur-alist alist))
5684 (setq cur-level level)))))
5685 ;; Footnotes
5686 (let ((fn (markdown-get-defined-footnotes)))
5687 (if (or (zerop (length fn))
5688 (null markdown-add-footnotes-to-imenu))
5689 (cdr root)
5690 (nconc (cdr root) (list (cons "Footnotes" fn))))))))
5692 (defun markdown-imenu-create-flat-index ()
5693 "Create and return a flat imenu index alist for the current buffer.
5694 See `imenu-create-index-function' and `imenu--index-alist' for details."
5695 (let* ((empty-heading "-") index heading pos)
5696 (save-excursion
5697 ;; Headings
5698 (goto-char (point-min))
5699 (while (re-search-forward markdown-regex-header (point-max) t)
5700 (when (and (not (markdown-code-block-at-point-p (point-at-bol)))
5701 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin)))
5702 (cond
5703 ((setq heading (match-string-no-properties 1))
5704 (setq pos (match-beginning 1)))
5705 ((setq heading (match-string-no-properties 5))
5706 (setq pos (match-beginning 4))))
5707 (or (> (length heading) 0)
5708 (setq heading empty-heading))
5709 (setq index (append index (list (cons heading pos))))))
5710 ;; Footnotes
5711 (when markdown-add-footnotes-to-imenu
5712 (nconc index (markdown-get-defined-footnotes)))
5713 index)))
5716 ;;; References ================================================================
5718 (defun markdown-reference-goto-definition ()
5719 "Jump to the definition of the reference at point or create it."
5720 (interactive)
5721 (when (thing-at-point-looking-at markdown-regex-link-reference)
5722 (let* ((text (match-string-no-properties 3))
5723 (reference (match-string-no-properties 6))
5724 (target (downcase (if (string= reference "") text reference)))
5725 (loc (cadr (save-match-data (markdown-reference-definition target)))))
5726 (if loc
5727 (goto-char loc)
5728 (goto-char (match-beginning 0))
5729 (markdown-insert-reference-definition target)))))
5731 (defun markdown-reference-find-links (reference)
5732 "Return a list of all links for REFERENCE.
5733 REFERENCE should not include the surrounding square brackets.
5734 Elements of the list have the form (text start line), where
5735 text is the link text, start is the location at the beginning of
5736 the link, and line is the line number on which the link appears."
5737 (let* ((ref-quote (regexp-quote reference))
5738 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
5739 ref-quote ref-quote))
5740 links)
5741 (save-excursion
5742 (goto-char (point-min))
5743 (while (re-search-forward regexp nil t)
5744 (let* ((text (or (match-string-no-properties 1)
5745 (match-string-no-properties 2)))
5746 (start (match-beginning 0))
5747 (line (markdown-line-number-at-pos)))
5748 (cl-pushnew (list text start line) links :test #'equal))))
5749 links))
5751 (defmacro markdown-for-all-refs (f)
5752 `(let ((result))
5753 (save-excursion
5754 (goto-char (point-min))
5755 (while
5756 (re-search-forward markdown-regex-link-reference nil t)
5757 (let* ((text (match-string-no-properties 3))
5758 (reference (match-string-no-properties 6))
5759 (target (downcase (if (string= reference "") text reference))))
5760 (,f text target result))))
5761 (reverse result)))
5763 (defmacro markdown-collect-always (_ target result)
5764 `(cl-pushnew ,target ,result :test #'equal))
5766 (defmacro markdown-collect-undefined (text target result)
5767 `(unless (markdown-reference-definition target)
5768 (let ((entry (assoc ,target ,result)))
5769 (if (not entry)
5770 (cl-pushnew
5771 (cons ,target (list (cons ,text (markdown-line-number-at-pos))))
5772 ,result :test #'equal)
5773 (setcdr entry
5774 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos)))))))))
5776 (defun markdown-get-all-refs ()
5777 "Return a list of all Markdown references."
5778 (markdown-for-all-refs markdown-collect-always))
5780 (defun markdown-get-undefined-refs ()
5781 "Return a list of undefined Markdown references.
5782 Result is an alist of pairs (reference . occurrences), where
5783 occurrences is itself another alist of pairs (label . line-number).
5784 For example, an alist corresponding to [Nice editor][Emacs] at line 12,
5785 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
5786 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
5787 (markdown-for-all-refs markdown-collect-undefined))
5789 (defun markdown-get-unused-refs ()
5790 (cl-sort
5791 (cl-set-difference
5792 (markdown-get-defined-references) (markdown-get-all-refs)
5793 :test (lambda (e1 e2) (equal (car e1) e2)))
5794 #'< :key #'cdr))
5796 (defmacro defun-markdown-buffer (name docstring)
5797 "Define a function to name and return a buffer.
5799 By convention, NAME must be a name of a string constant with
5800 %buffer% placeholder used to name the buffer, and will also be
5801 used as a name of the function defined.
5803 DOCSTRING will be used as the first part of the docstring."
5804 `(defun ,name (&optional buffer-name)
5805 ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.")
5806 (or buffer-name (setq buffer-name (buffer-name)))
5807 (let ((refbuf (get-buffer-create (replace-regexp-in-string
5808 "%buffer%" buffer-name
5809 ,name))))
5810 (with-current-buffer refbuf
5811 (when view-mode
5812 (View-exit-and-edit))
5813 (use-local-map button-buffer-map)
5814 (erase-buffer))
5815 refbuf)))
5817 (defconst markdown-reference-check-buffer
5818 "*Undefined references for %buffer%*"
5819 "Pattern for name of buffer for listing undefined references.
5820 The string %buffer% will be replaced by the corresponding
5821 `markdown-mode' buffer name.")
5823 (defun-markdown-buffer
5824 markdown-reference-check-buffer
5825 "Name and return buffer for reference checking.")
5827 (defconst markdown-unused-references-buffer
5828 "*Unused references for %buffer%*"
5829 "Pattern for name of buffer for listing unused references.
5830 The string %buffer% will be replaced by the corresponding
5831 `markdown-mode' buffer name.")
5833 (defun-markdown-buffer
5834 markdown-unused-references-buffer
5835 "Name and return buffer for unused reference checking.")
5837 (defconst markdown-reference-links-buffer
5838 "*Reference links for %buffer%*"
5839 "Pattern for name of buffer for listing references.
5840 The string %buffer% will be replaced by the corresponding buffer name.")
5842 (defun-markdown-buffer
5843 markdown-reference-links-buffer
5844 "Name, setup, and return a buffer for listing links.")
5846 ;; Add an empty Markdown reference definition to buffer
5847 ;; specified in the 'target-buffer property. The reference name is
5848 ;; the button's label.
5849 (define-button-type 'markdown-undefined-reference-button
5850 'help-echo "mouse-1, RET: create definition for undefined reference"
5851 'follow-link t
5852 'face 'bold
5853 'action (lambda (b)
5854 (let ((buffer (button-get b 'target-buffer))
5855 (line (button-get b 'target-line))
5856 (label (button-label b)))
5857 (switch-to-buffer-other-window buffer)
5858 (goto-char (point-min))
5859 (forward-line line)
5860 (markdown-insert-reference-definition label)
5861 (markdown-check-refs t))))
5863 ;; Jump to line in buffer specified by 'target-buffer property.
5864 ;; Line number is button's 'target-line property.
5865 (define-button-type 'markdown-goto-line-button
5866 'help-echo "mouse-1, RET: go to line"
5867 'follow-link t
5868 'face 'italic
5869 'action (lambda (b)
5870 (switch-to-buffer-other-window (button-get b 'target-buffer))
5871 ;; use call-interactively to silence compiler
5872 (let ((current-prefix-arg (button-get b 'target-line)))
5873 (call-interactively 'goto-line))))
5875 ;; Kill a line in buffer specified by 'target-buffer property.
5876 ;; Line number is button's 'target-line property.
5877 (define-button-type 'markdown-kill-line-button
5878 'help-echo "mouse-1, RET: kill line"
5879 'follow-link t
5880 'face 'italic
5881 'action (lambda (b)
5882 (switch-to-buffer-other-window (button-get b 'target-buffer))
5883 ;; use call-interactively to silence compiler
5884 (let ((current-prefix-arg (button-get b 'target-line)))
5885 (call-interactively 'goto-line))
5886 (kill-line 1)
5887 (markdown-unused-refs t)))
5889 ;; Jumps to a particular link at location given by 'target-char
5890 ;; property in buffer given by 'target-buffer property.
5891 (define-button-type 'markdown-location-button
5892 'help-echo "mouse-1, RET: jump to location of link"
5893 'follow-link t
5894 'face 'bold
5895 'action (lambda (b)
5896 (let ((target (button-get b 'target-buffer))
5897 (loc (button-get b 'target-char)))
5898 (kill-buffer-and-window)
5899 (switch-to-buffer target)
5900 (goto-char loc))))
5902 (defun markdown-insert-undefined-reference-button (reference oldbuf)
5903 "Insert a button for creating REFERENCE in buffer OLDBUF.
5904 REFERENCE should be a list of the form (reference . occurrences),
5905 as returned by `markdown-get-undefined-refs'."
5906 (let ((label (car reference)))
5907 ;; Create a reference button
5908 (insert-button label
5909 :type 'markdown-undefined-reference-button
5910 'target-buffer oldbuf
5911 'target-line (cdr (car (cdr reference))))
5912 (insert " (")
5913 (dolist (occurrence (cdr reference))
5914 (let ((line (cdr occurrence)))
5915 ;; Create a line number button
5916 (insert-button (number-to-string line)
5917 :type 'markdown-goto-line-button
5918 'target-buffer oldbuf
5919 'target-line line)
5920 (insert " ")))
5921 (delete-char -1)
5922 (insert ")")
5923 (newline)))
5925 (defun markdown-insert-unused-reference-button (reference oldbuf)
5926 "Insert a button for creating REFERENCE in buffer OLDBUF.
5927 REFERENCE must be a pair of (ref . line-number)."
5928 (let ((label (car reference))
5929 (line (cdr reference)))
5930 ;; Create a reference button
5931 (insert-button label
5932 :type 'markdown-goto-line-button
5933 'face 'bold
5934 'target-buffer oldbuf
5935 'target-line line)
5936 (insert (format " (%d) [" line))
5937 (insert-button "X"
5938 :type 'markdown-kill-line-button
5939 'face 'bold
5940 'target-buffer oldbuf
5941 'target-line line)
5942 (insert "]")
5943 (newline)))
5945 (defun markdown-insert-link-button (link oldbuf)
5946 "Insert a button for jumping to LINK in buffer OLDBUF.
5947 LINK should be a list of the form (text char line) containing
5948 the link text, location, and line number."
5949 (let ((label (cl-first link))
5950 (char (cl-second link))
5951 (line (cl-third link)))
5952 ;; Create a reference button
5953 (insert-button label
5954 :type 'markdown-location-button
5955 'target-buffer oldbuf
5956 'target-char char)
5957 (insert (format " (line %d)\n" line))))
5959 (defun markdown-reference-goto-link (&optional reference)
5960 "Jump to the location of the first use of REFERENCE."
5961 (interactive)
5962 (unless reference
5963 (if (thing-at-point-looking-at markdown-regex-reference-definition)
5964 (setq reference (match-string-no-properties 2))
5965 (user-error "No reference definition at point")))
5966 (let ((links (markdown-reference-find-links reference)))
5967 (cond ((= (length links) 1)
5968 (goto-char (cadr (car links))))
5969 ((> (length links) 1)
5970 (let ((oldbuf (current-buffer))
5971 (linkbuf (markdown-reference-links-buffer)))
5972 (with-current-buffer linkbuf
5973 (insert "Links using reference " reference ":\n\n")
5974 (dolist (link (reverse links))
5975 (markdown-insert-link-button link oldbuf)))
5976 (view-buffer-other-window linkbuf)
5977 (goto-char (point-min))
5978 (forward-line 2)))
5980 (error "No links for reference %s" reference)))))
5982 (defmacro defun-markdown-ref-checker
5983 (name docstring checker-function buffer-function none-message buffer-header insert-reference)
5984 "Define a function NAME acting on result of CHECKER-FUNCTION.
5986 DOCSTRING is used as a docstring for the defined function.
5988 BUFFER-FUNCTION should name and return an auxiliary buffer to put
5989 results in.
5991 NONE-MESSAGE is used when CHECKER-FUNCTION returns no results.
5993 BUFFER-HEADER is put into the auxiliary buffer first, followed by
5994 calling INSERT-REFERENCE for each element in the list returned by
5995 CHECKER-FUNCTION."
5996 `(defun ,name (&optional silent)
5997 ,(concat
5998 docstring
5999 "\n\nIf SILENT is non-nil, do not message anything when no
6000 such references found.")
6001 (interactive "P")
6002 (unless (derived-mode-p 'markdown-mode)
6003 (user-error "Not available in current mode"))
6004 (let ((oldbuf (current-buffer))
6005 (refs (,checker-function))
6006 (refbuf (,buffer-function)))
6007 (if (null refs)
6008 (progn
6009 (when (not silent)
6010 (message ,none-message))
6011 (kill-buffer refbuf))
6012 (with-current-buffer refbuf
6013 (insert ,buffer-header)
6014 (dolist (ref refs)
6015 (,insert-reference ref oldbuf))
6016 (view-buffer-other-window refbuf)
6017 (goto-char (point-min))
6018 (forward-line 2))))))
6020 (defun-markdown-ref-checker
6021 markdown-check-refs
6022 "Show all undefined Markdown references in current `markdown-mode' buffer.
6024 Links which have empty reference definitions are considered to be
6025 defined."
6026 markdown-get-undefined-refs
6027 markdown-reference-check-buffer
6028 "No undefined references found"
6029 "The following references are undefined:\n\n"
6030 markdown-insert-undefined-reference-button)
6033 (defun-markdown-ref-checker
6034 markdown-unused-refs
6035 "Show all unused Markdown references in current `markdown-mode' buffer."
6036 markdown-get-unused-refs
6037 markdown-unused-references-buffer
6038 "No unused references found"
6039 "The following references are unused:\n\n"
6040 markdown-insert-unused-reference-button)
6044 ;;; Lists =====================================================================
6046 (defun markdown-insert-list-item (&optional arg)
6047 "Insert a new list item.
6048 If the point is inside unordered list, insert a bullet mark. If
6049 the point is inside ordered list, insert the next number followed
6050 by a period. Use the previous list item to determine the amount
6051 of whitespace to place before and after list markers.
6053 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
6054 decrease the indentation by one level.
6056 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
6057 increase the indentation by one level."
6058 (interactive "p")
6059 (let (bounds cur-indent marker indent new-indent new-loc)
6060 (save-match-data
6061 ;; Look for a list item on current or previous non-blank line
6062 (save-excursion
6063 (while (and (not (setq bounds (markdown-cur-list-item-bounds)))
6064 (not (bobp))
6065 (markdown-cur-line-blank-p))
6066 (forward-line -1)))
6067 (when bounds
6068 (cond ((save-excursion
6069 (skip-chars-backward " \t")
6070 (looking-at-p markdown-regex-list))
6071 (beginning-of-line)
6072 (insert "\n")
6073 (forward-line -1))
6074 ((not (markdown-cur-line-blank-p))
6075 (newline)))
6076 (setq new-loc (point)))
6077 ;; Look ahead for a list item on next non-blank line
6078 (unless bounds
6079 (save-excursion
6080 (while (and (null bounds)
6081 (not (eobp))
6082 (markdown-cur-line-blank-p))
6083 (forward-line)
6084 (setq bounds (markdown-cur-list-item-bounds))))
6085 (when bounds
6086 (setq new-loc (point))
6087 (unless (markdown-cur-line-blank-p)
6088 (newline))))
6089 (if (not bounds)
6090 ;; When not in a list, start a new unordered one
6091 (progn
6092 (unless (markdown-cur-line-blank-p)
6093 (insert "\n"))
6094 (insert markdown-unordered-list-item-prefix))
6095 ;; Compute indentation and marker for new list item
6096 (setq cur-indent (nth 2 bounds))
6097 (setq marker (nth 4 bounds))
6098 ;; If current item is a GFM checkbox, insert new unchecked checkbox.
6099 (when (nth 5 bounds)
6100 (setq marker
6101 (concat marker
6102 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds)))))
6103 (cond
6104 ;; Dedent: decrement indentation, find previous marker.
6105 ((= arg 4)
6106 (setq indent (max (- cur-indent markdown-list-indent-width) 0))
6107 (let ((prev-bounds
6108 (save-excursion
6109 (goto-char (nth 0 bounds))
6110 (when (markdown-up-list)
6111 (markdown-cur-list-item-bounds)))))
6112 (when prev-bounds
6113 (setq marker (nth 4 prev-bounds)))))
6114 ;; Indent: increment indentation by 4, use same marker.
6115 ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width)))
6116 ;; Same level: keep current indentation and marker.
6117 (t (setq indent cur-indent)))
6118 (setq new-indent (make-string indent 32))
6119 (goto-char new-loc)
6120 (cond
6121 ;; Ordered list
6122 ((string-match-p "[0-9]" marker)
6123 (if (= arg 16) ;; starting a new column indented one more level
6124 (insert (concat new-indent "1. "))
6125 ;; Don't use previous match-data
6126 (set-match-data nil)
6127 ;; travel up to the last item and pick the correct number. If
6128 ;; the argument was nil, "new-indent = cur-indent" is the same,
6129 ;; so we don't need special treatment. Neat.
6130 (save-excursion
6131 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)")))
6132 (>= (forward-line -1) 0))))
6133 (let* ((old-prefix (match-string 1))
6134 (old-spacing (match-string 2))
6135 (new-prefix (if (and old-prefix markdown-ordered-list-enumeration)
6136 (int-to-string (1+ (string-to-number old-prefix)))
6137 "1"))
6138 (space-adjust (- (length old-prefix) (length new-prefix)))
6139 (new-spacing (if (and (match-string 2)
6140 (not (string-match-p "\t" old-spacing))
6141 (< space-adjust 0)
6142 (> space-adjust (- 1 (length (match-string 2)))))
6143 (substring (match-string 2) 0 space-adjust)
6144 (or old-spacing ". "))))
6145 (insert (concat new-indent new-prefix new-spacing)))))
6146 ;; Unordered list, GFM task list, or ordered list with hash mark
6147 ((string-match-p "[\\*\\+-]\\|#\\." marker)
6148 (insert new-indent marker))))
6149 ;; Propertize the newly inserted list item now
6150 (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol)))))
6152 (defun markdown-move-list-item-up ()
6153 "Move the current list item up in the list when possible.
6154 In nested lists, move child items with the parent item."
6155 (interactive)
6156 (let (cur prev old)
6157 (when (setq cur (markdown-cur-list-item-bounds))
6158 (setq old (point))
6159 (goto-char (nth 0 cur))
6160 (if (markdown-prev-list-item (nth 3 cur))
6161 (progn
6162 (setq prev (markdown-cur-list-item-bounds))
6163 (condition-case nil
6164 (progn
6165 (transpose-regions (nth 0 prev) (nth 1 prev)
6166 (nth 0 cur) (nth 1 cur) t)
6167 (goto-char (+ (nth 0 prev) (- old (nth 0 cur)))))
6168 ;; Catch error in case regions overlap.
6169 (error (goto-char old))))
6170 (goto-char old)))))
6172 (defun markdown-move-list-item-down ()
6173 "Move the current list item down in the list when possible.
6174 In nested lists, move child items with the parent item."
6175 (interactive)
6176 (let (cur next old)
6177 (when (setq cur (markdown-cur-list-item-bounds))
6178 (setq old (point))
6179 (if (markdown-next-list-item (nth 3 cur))
6180 (progn
6181 (setq next (markdown-cur-list-item-bounds))
6182 (condition-case nil
6183 (progn
6184 (transpose-regions (nth 0 cur) (nth 1 cur)
6185 (nth 0 next) (nth 1 next) nil)
6186 (goto-char (+ old (- (nth 1 next) (nth 1 cur)))))
6187 ;; Catch error in case regions overlap.
6188 (error (goto-char old))))
6189 (goto-char old)))))
6191 (defun markdown-demote-list-item (&optional bounds)
6192 "Indent (or demote) the current list item.
6193 Optionally, BOUNDS of the current list item may be provided if available.
6194 In nested lists, demote child items as well."
6195 (interactive)
6196 (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
6197 (save-excursion
6198 (let* ((item-start (set-marker (make-marker) (nth 0 bounds)))
6199 (item-end (set-marker (make-marker) (nth 1 bounds)))
6200 (list-start (progn (markdown-beginning-of-list)
6201 (set-marker (make-marker) (point))))
6202 (list-end (progn (markdown-end-of-list)
6203 (set-marker (make-marker) (point)))))
6204 (goto-char item-start)
6205 (while (< (point) item-end)
6206 (unless (markdown-cur-line-blank-p)
6207 (insert (make-string markdown-list-indent-width ? )))
6208 (forward-line))
6209 (markdown-syntax-propertize-list-items list-start list-end)))))
6211 (defun markdown-promote-list-item (&optional bounds)
6212 "Unindent (or promote) the current list item.
6213 Optionally, BOUNDS of the current list item may be provided if available.
6214 In nested lists, demote child items as well."
6215 (interactive)
6216 (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
6217 (save-excursion
6218 (save-match-data
6219 (let ((item-start (set-marker (make-marker) (nth 0 bounds)))
6220 (item-end (set-marker (make-marker) (nth 1 bounds)))
6221 (list-start (progn (markdown-beginning-of-list)
6222 (set-marker (make-marker) (point))))
6223 (list-end (progn (markdown-end-of-list)
6224 (set-marker (make-marker) (point))))
6225 num regexp)
6226 (goto-char item-start)
6227 (when (looking-at (format "^[ ]\\{1,%d\\}"
6228 markdown-list-indent-width))
6229 (setq num (- (match-end 0) (match-beginning 0)))
6230 (setq regexp (format "^[ ]\\{1,%d\\}" num))
6231 (while (and (< (point) item-end)
6232 (re-search-forward regexp item-end t))
6233 (replace-match "" nil nil)
6234 (forward-line))
6235 (markdown-syntax-propertize-list-items list-start list-end)))))))
6237 (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item)
6238 "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM.
6239 PREV-ITEM is width of previous-indentation and list number
6241 Assume that the previously found match was for a numbered item in
6242 a list."
6243 (let ((cpfx pfx)
6244 (cur-item nil)
6245 (idx 0)
6246 (continue t)
6247 (step t)
6248 (sep nil))
6249 (while (and continue (not (eobp)))
6250 (setq step t)
6251 (cond
6252 ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ")
6253 (setq cpfx (match-string-no-properties 2))
6254 (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker
6255 (cond
6256 ((or (= (length cpfx) (length pfx))
6257 (= (length cur-item) (length prev-item)))
6258 (save-excursion
6259 (replace-match
6260 (if (not markdown-ordered-list-enumeration)
6261 (concat pfx "1. ")
6262 (cl-incf idx)
6263 (concat pfx (number-to-string idx) ". "))))
6264 (setq sep nil))
6265 ;; indented a level
6266 ((< (length pfx) (length cpfx))
6267 (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item))
6268 (setq step nil))
6269 ;; exit the loop
6271 (setq step nil)
6272 (setq continue nil))))
6274 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
6275 (setq cpfx (match-string-no-properties 1))
6276 (cond
6277 ;; reset if separated before
6278 ((string= cpfx pfx) (when sep (setq idx 0)))
6279 ((string< cpfx pfx)
6280 (setq step nil)
6281 (setq continue nil))))
6282 (t (setq sep t)))
6284 (when step
6285 (beginning-of-line)
6286 (setq continue (= (forward-line) 0))))
6287 sep))
6289 (defun markdown-cleanup-list-numbers ()
6290 "Update the numbering of ordered lists."
6291 (interactive)
6292 (save-excursion
6293 (goto-char (point-min))
6294 (markdown-cleanup-list-numbers-level "")))
6297 ;;; Movement ==================================================================
6299 (defun markdown-beginning-of-defun (&optional arg)
6300 "`beginning-of-defun-function' for Markdown.
6301 This is used to find the beginning of the defun and should behave
6302 like ‘beginning-of-defun’, returning non-nil if it found the
6303 beginning of a defun. It moves the point backward, right before a
6304 heading which defines a defun. When ARG is non-nil, repeat that
6305 many times. When ARG is negative, move forward to the ARG-th
6306 following section."
6307 (or arg (setq arg 1))
6308 (when (< arg 0) (end-of-line))
6309 ;; Adjust position for setext headings.
6310 (when (and (thing-at-point-looking-at markdown-regex-header-setext)
6311 (not (= (point) (match-beginning 0)))
6312 (not (markdown-code-block-at-point-p)))
6313 (goto-char (match-end 0)))
6314 (let (found)
6315 ;; Move backward with positive argument.
6316 (while (and (not (bobp)) (> arg 0))
6317 (setq found nil)
6318 (while (and (not found)
6319 (not (bobp))
6320 (re-search-backward markdown-regex-header nil 'move))
6321 (when (not (markdown-code-block-at-pos (match-beginning 0))))
6322 (setq found (match-beginning 0)))
6323 (setq arg (1- arg)))
6324 ;; Move forward with negative argument.
6325 (while (and (not (eobp)) (< arg 0))
6326 (setq found nil)
6327 (while (and (not found)
6328 (not (eobp))
6329 (re-search-forward markdown-regex-header nil 'move))
6330 (when (not (markdown-code-block-at-pos (match-beginning 0))))
6331 (setq found (match-beginning 0)))
6332 (setq arg (1+ arg)))
6333 (when found
6334 (beginning-of-line)
6335 t)))
6337 (defun markdown-end-of-defun ()
6338 "`end-of-defun-function’ for Markdown.
6339 This is used to find the end of the defun at point.
6340 It is called with no argument, right after calling ‘beginning-of-defun-raw’,
6341 so it can assume that point is at the beginning of the defun body.
6342 It should move point to the first position after the defun."
6343 (or (eobp) (forward-char 1))
6344 (let (found)
6345 (while (and (not found)
6346 (not (eobp))
6347 (re-search-forward markdown-regex-header nil 'move))
6348 (when (not (markdown-code-block-at-pos (match-beginning 0)))
6349 (setq found (match-beginning 0))))
6350 (when found
6351 (goto-char found)
6352 (skip-syntax-backward "-"))))
6354 (defun markdown-beginning-of-text-block ()
6355 "Move backward to previous beginning of a plain text block.
6356 This function simply looks for blank lines without considering
6357 the surrounding context in light of Markdown syntax. For that, see
6358 `markdown-backward-block'."
6359 (interactive)
6360 (let ((start (point)))
6361 (if (re-search-backward markdown-regex-block-separator nil t)
6362 (goto-char (match-end 0))
6363 (goto-char (point-min)))
6364 (when (and (= start (point)) (not (bobp)))
6365 (forward-line -1)
6366 (if (re-search-backward markdown-regex-block-separator nil t)
6367 (goto-char (match-end 0))
6368 (goto-char (point-min))))))
6370 (defun markdown-end-of-text-block ()
6371 "Move forward to next beginning of a plain text block.
6372 This function simply looks for blank lines without considering
6373 the surrounding context in light of Markdown syntax. For that, see
6374 `markdown-forward-block'."
6375 (interactive)
6376 (beginning-of-line)
6377 (skip-chars-forward " \t\n")
6378 (when (= (point) (point-min))
6379 (forward-char))
6380 (if (re-search-forward markdown-regex-block-separator nil t)
6381 (goto-char (match-end 0))
6382 (goto-char (point-max)))
6383 (skip-chars-backward " \t\n")
6384 (forward-line))
6386 (defun markdown-backward-paragraph (&optional arg)
6387 "Move the point to the start of the current paragraph.
6388 With argument ARG, do it ARG times; a negative argument ARG = -N
6389 means move forward N blocks."
6390 (interactive "^p")
6391 (or arg (setq arg 1))
6392 (if (< arg 0)
6393 (markdown-forward-paragraph (- arg))
6394 (dotimes (_ arg)
6395 ;; Skip over whitespace in between paragraphs when moving backward.
6396 (skip-chars-backward " \t\n")
6397 (beginning-of-line)
6398 ;; Skip over code block endings.
6399 (when (markdown-range-properties-exist
6400 (point-at-bol) (point-at-eol)
6401 '(markdown-gfm-block-end
6402 markdown-tilde-fence-end))
6403 (forward-line -1))
6404 ;; Skip over blank lines inside blockquotes.
6405 (while (and (not (eobp))
6406 (looking-at markdown-regex-blockquote)
6407 (= (length (match-string 3)) 0))
6408 (forward-line -1))
6409 ;; Proceed forward based on the type of block of paragraph.
6410 (let (bounds skip)
6411 (cond
6412 ;; Blockquotes
6413 ((looking-at markdown-regex-blockquote)
6414 (while (and (not (bobp))
6415 (looking-at markdown-regex-blockquote)
6416 (> (length (match-string 3)) 0)) ;; not blank
6417 (forward-line -1))
6418 (forward-line))
6419 ;; List items
6420 ((setq bounds (markdown-cur-list-item-bounds))
6421 (goto-char (nth 0 bounds)))
6422 ;; Other
6424 (while (and (not (bobp))
6425 (not skip)
6426 (not (markdown-cur-line-blank-p))
6427 (not (looking-at markdown-regex-blockquote))
6428 (not (markdown-range-properties-exist
6429 (point-at-bol) (point-at-eol)
6430 '(markdown-gfm-block-end
6431 markdown-tilde-fence-end))))
6432 (setq skip (markdown-range-properties-exist
6433 (point-at-bol) (point-at-eol)
6434 '(markdown-gfm-block-begin
6435 markdown-tilde-fence-begin)))
6436 (forward-line -1))
6437 (unless (bobp)
6438 (forward-line 1))))))))
6440 (defun markdown-forward-paragraph (&optional arg)
6441 "Move forward to the next end of a paragraph.
6442 With argument ARG, do it ARG times; a negative argument ARG = -N
6443 means move backward N blocks."
6444 (interactive "^p")
6445 (or arg (setq arg 1))
6446 (if (< arg 0)
6447 (markdown-backward-paragraph (- arg))
6448 (dotimes (_ arg)
6449 ;; Skip whitespace in between paragraphs.
6450 (when (markdown-cur-line-blank-p)
6451 (skip-syntax-forward "-")
6452 (beginning-of-line))
6453 ;; Proceed forward based on the type of block.
6454 (let (bounds skip)
6455 (cond
6456 ;; Blockquotes
6457 ((looking-at markdown-regex-blockquote)
6458 ;; Skip over blank lines inside blockquotes.
6459 (while (and (not (eobp))
6460 (looking-at markdown-regex-blockquote)
6461 (= (length (match-string 3)) 0))
6462 (forward-line))
6463 ;; Move to end of quoted text block
6464 (while (and (not (eobp))
6465 (looking-at markdown-regex-blockquote)
6466 (> (length (match-string 3)) 0)) ;; not blank
6467 (forward-line)))
6468 ;; List items
6469 ((and (markdown-cur-list-item-bounds)
6470 (setq bounds (markdown-next-list-item-bounds)))
6471 (goto-char (nth 0 bounds)))
6472 ;; Other
6474 (forward-line)
6475 (while (and (not (eobp))
6476 (not skip)
6477 (not (markdown-cur-line-blank-p))
6478 (not (looking-at markdown-regex-blockquote))
6479 (not (markdown-range-properties-exist
6480 (point-at-bol) (point-at-eol)
6481 '(markdown-gfm-block-begin
6482 markdown-tilde-fence-begin))))
6483 (setq skip (markdown-range-properties-exist
6484 (point-at-bol) (point-at-eol)
6485 '(markdown-gfm-block-end
6486 markdown-tilde-fence-end)))
6487 (forward-line))))))))
6489 (defun markdown-backward-block (&optional arg)
6490 "Move the point to the start of the current Markdown block.
6491 Moves across complete code blocks, list items, and blockquotes,
6492 but otherwise stops at blank lines, headers, and horizontal
6493 rules. With argument ARG, do it ARG times; a negative argument
6494 ARG = -N means move forward N blocks."
6495 (interactive "^p")
6496 (or arg (setq arg 1))
6497 (if (< arg 0)
6498 (markdown-forward-block (- arg))
6499 (dotimes (_ arg)
6500 ;; Skip over whitespace in between blocks when moving backward,
6501 ;; unless at a block boundary with no whitespace.
6502 (skip-syntax-backward "-")
6503 (beginning-of-line)
6504 ;; Proceed forward based on the type of block.
6505 (cond
6506 ;; Code blocks
6507 ((and (markdown-code-block-at-pos (point)) ;; this line
6508 (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line
6509 (forward-line -1)
6510 (while (and (markdown-code-block-at-point-p) (not (bobp)))
6511 (forward-line -1))
6512 (forward-line))
6513 ;; Headings
6514 ((markdown-heading-at-point)
6515 (goto-char (match-beginning 0)))
6516 ;; Horizontal rules
6517 ((looking-at markdown-regex-hr))
6518 ;; Blockquotes
6519 ((looking-at markdown-regex-blockquote)
6520 (forward-line -1)
6521 (while (and (looking-at markdown-regex-blockquote)
6522 (not (bobp)))
6523 (forward-line -1))
6524 (forward-line))
6525 ;; List items
6526 ((markdown-cur-list-item-bounds)
6527 (markdown-beginning-of-list))
6528 ;; Other
6530 ;; Move forward in case it is a one line regular paragraph.
6531 (unless (markdown-next-line-blank-p)
6532 (forward-line))
6533 (unless (markdown-prev-line-blank-p)
6534 (markdown-backward-paragraph)))))))
6536 (defun markdown-forward-block (&optional arg)
6537 "Move forward to the next end of a Markdown block.
6538 Moves across complete code blocks, list items, and blockquotes,
6539 but otherwise stops at blank lines, headers, and horizontal
6540 rules. With argument ARG, do it ARG times; a negative argument
6541 ARG = -N means move backward N blocks."
6542 (interactive "^p")
6543 (or arg (setq arg 1))
6544 (if (< arg 0)
6545 (markdown-backward-block (- arg))
6546 (dotimes (_ arg)
6547 ;; Skip over whitespace in between blocks when moving forward.
6548 (if (markdown-cur-line-blank-p)
6549 (skip-syntax-forward "-")
6550 (beginning-of-line))
6551 ;; Proceed forward based on the type of block.
6552 (cond
6553 ;; Code blocks
6554 ((markdown-code-block-at-point-p)
6555 (forward-line)
6556 (while (and (markdown-code-block-at-point-p) (not (eobp)))
6557 (forward-line)))
6558 ;; Headings
6559 ((looking-at markdown-regex-header)
6560 (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
6561 (forward-line))
6562 ;; Horizontal rules
6563 ((looking-at markdown-regex-hr)
6564 (forward-line))
6565 ;; Blockquotes
6566 ((looking-at markdown-regex-blockquote)
6567 (forward-line)
6568 (while (and (looking-at markdown-regex-blockquote) (not (eobp)))
6569 (forward-line)))
6570 ;; List items
6571 ((markdown-cur-list-item-bounds)
6572 (markdown-end-of-list)
6573 (forward-line))
6574 ;; Other
6575 (t (markdown-forward-paragraph))))
6576 (skip-syntax-backward "-")
6577 (unless (eobp)
6578 (forward-char 1))))
6580 (defun markdown-backward-page (&optional count)
6581 "Move backward to boundary of the current toplevel section.
6582 With COUNT, repeat, or go forward if negative."
6583 (interactive "p")
6584 (or count (setq count 1))
6585 (if (< count 0)
6586 (markdown-forward-page (- count))
6587 (skip-syntax-backward "-")
6588 (or (markdown-back-to-heading-over-code-block t t)
6589 (goto-char (point-min)))
6590 (when (looking-at markdown-regex-header)
6591 (let ((level (markdown-outline-level)))
6592 (when (> level 1) (markdown-up-heading level))
6593 (when (> count 1)
6594 (condition-case nil
6595 (markdown-backward-same-level (1- count))
6596 (error (goto-char (point-min)))))))))
6598 (defun markdown-forward-page (&optional count)
6599 "Move forward to boundary of the current toplevel section.
6600 With COUNT, repeat, or go backward if negative."
6601 (interactive "p")
6602 (or count (setq count 1))
6603 (if (< count 0)
6604 (markdown-backward-page (- count))
6605 (if (markdown-back-to-heading-over-code-block t t)
6606 (let ((level (markdown-outline-level)))
6607 (when (> level 1) (markdown-up-heading level))
6608 (condition-case nil
6609 (markdown-forward-same-level count)
6610 (error (goto-char (point-max)))))
6611 (markdown-next-visible-heading 1))))
6613 (defun markdown-next-link ()
6614 "Jump to next inline, reference, or wiki link.
6615 If successful, return point. Otherwise, return nil.
6616 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
6617 (interactive)
6618 (let ((opoint (point)))
6619 (when (or (markdown-link-p) (markdown-wiki-link-p))
6620 ;; At a link already, move past it.
6621 (goto-char (+ (match-end 0) 1)))
6622 ;; Search for the next wiki link and move to the beginning.
6623 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t)
6624 (markdown-code-block-at-point-p)
6625 (< (point) (point-max))))
6626 (if (and (not (eq (point) opoint))
6627 (or (markdown-link-p) (markdown-wiki-link-p)))
6628 ;; Group 1 will move past non-escape character in wiki link regexp.
6629 ;; Go to beginning of group zero for all other link types.
6630 (goto-char (or (match-beginning 1) (match-beginning 0)))
6631 (goto-char opoint)
6632 nil)))
6634 (defun markdown-previous-link ()
6635 "Jump to previous wiki link.
6636 If successful, return point. Otherwise, return nil.
6637 See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
6638 (interactive)
6639 (let ((opoint (point)))
6640 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t)
6641 (markdown-code-block-at-point-p)
6642 (> (point) (point-min))))
6643 (if (and (not (eq (point) opoint))
6644 (or (markdown-link-p) (markdown-wiki-link-p)))
6645 (goto-char (or (match-beginning 1) (match-beginning 0)))
6646 (goto-char opoint)
6647 nil)))
6650 ;;; Outline ===================================================================
6652 (defun markdown-move-heading-common (move-fn &optional arg adjust)
6653 "Wrapper for `outline-mode' functions to skip false positives.
6654 MOVE-FN is a function and ARG is its argument. For example,
6655 headings inside preformatted code blocks may match
6656 `outline-regexp' but should not be considered as headings.
6657 When ADJUST is non-nil, adjust the point for interactive calls
6658 to avoid leaving the point at invisible markup. This adjustment
6659 generally should only be done for interactive calls, since other
6660 functions may expect the point to be at the beginning of the
6661 regular expression."
6662 (let ((prev -1) (start (point)))
6663 (if arg (funcall move-fn arg) (funcall move-fn))
6664 (while (and (/= prev (point)) (markdown-code-block-at-point-p))
6665 (setq prev (point))
6666 (if arg (funcall move-fn arg) (funcall move-fn)))
6667 ;; Adjust point for setext headings and invisible text.
6668 (save-match-data
6669 (when (and adjust (thing-at-point-looking-at markdown-regex-header))
6670 (if markdown-hide-markup
6671 ;; Move to beginning of heading text if markup is hidden.
6672 (goto-char (or (match-beginning 1) (match-beginning 5)))
6673 ;; Move to beginning of markup otherwise.
6674 (goto-char (or (match-beginning 1) (match-beginning 4))))))
6675 (if (= (point) start) nil (point))))
6677 (defun markdown-next-visible-heading (arg)
6678 "Move to the next visible heading line of any level.
6679 With argument, repeats or can move backward if negative. ARG is
6680 passed to `outline-next-visible-heading'."
6681 (interactive "p")
6682 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust))
6684 (defun markdown-previous-visible-heading (arg)
6685 "Move to the previous visible heading line of any level.
6686 With argument, repeats or can move backward if negative. ARG is
6687 passed to `outline-previous-visible-heading'."
6688 (interactive "p")
6689 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust))
6691 (defun markdown-next-heading ()
6692 "Move to the next heading line of any level."
6693 (markdown-move-heading-common #'outline-next-heading))
6695 (defun markdown-previous-heading ()
6696 "Move to the previous heading line of any level."
6697 (markdown-move-heading-common #'outline-previous-heading))
6699 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error)
6700 "Move back to the beginning of the previous heading.
6701 Returns t if the point is at a heading, the location if a heading
6702 was found, and nil otherwise.
6703 Only visible heading lines are considered, unless INVISIBLE-OK is
6704 non-nil. Throw an error if there is no previous heading unless
6705 NO-ERROR is non-nil.
6706 Leaves match data intact for `markdown-regex-header'."
6707 (beginning-of-line)
6708 (or (and (markdown-heading-at-point)
6709 (not (markdown-code-block-at-point-p)))
6710 (let (found)
6711 (save-excursion
6712 (while (and (not found)
6713 (re-search-backward markdown-regex-header nil t))
6714 (when (and (or invisible-ok (not (outline-invisible-p)))
6715 (not (markdown-code-block-at-point-p)))
6716 (setq found (point))))
6717 (if (not found)
6718 (unless no-error (user-error "Before first heading"))
6719 (setq found (point))))
6720 (when found (goto-char found)))))
6722 (defun markdown-forward-same-level (arg)
6723 "Move forward to the ARG'th heading at same level as this one.
6724 Stop at the first and last headings of a superior heading."
6725 (interactive "p")
6726 (markdown-back-to-heading-over-code-block)
6727 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust))
6729 (defun markdown-backward-same-level (arg)
6730 "Move backward to the ARG'th heading at same level as this one.
6731 Stop at the first and last headings of a superior heading."
6732 (interactive "p")
6733 (markdown-back-to-heading-over-code-block)
6734 (while (> arg 0)
6735 (let ((point-to-move-to
6736 (save-excursion
6737 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust))))
6738 (if point-to-move-to
6739 (progn
6740 (goto-char point-to-move-to)
6741 (setq arg (1- arg)))
6742 (user-error "No previous same-level heading")))))
6744 (defun markdown-up-heading (arg &optional interactive)
6745 "Move to the visible heading line of which the present line is a subheading.
6746 With argument, move up ARG levels. When called interactively (or
6747 INTERACTIVE is non-nil), also push the mark."
6748 (interactive "p\np")
6749 (and interactive (not (eq last-command 'markdown-up-heading))
6750 (push-mark))
6751 (markdown-move-heading-common #'outline-up-heading arg 'adjust))
6753 (defun markdown-back-to-heading (&optional invisible-ok)
6754 "Move to previous heading line, or beg of this line if it's a heading.
6755 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
6756 (interactive)
6757 (markdown-move-heading-common #'outline-back-to-heading invisible-ok))
6759 (defalias 'markdown-end-of-heading 'outline-end-of-heading)
6761 (defun markdown-on-heading-p ()
6762 "Return non-nil if point is on a heading line."
6763 (get-text-property (point-at-bol) 'markdown-heading))
6765 (defun markdown-end-of-subtree (&optional invisible-OK)
6766 "Move to the end of the current subtree.
6767 Only visible heading lines are considered, unless INVISIBLE-OK is
6768 non-nil.
6769 Derived from `org-end-of-subtree'."
6770 (markdown-back-to-heading invisible-OK)
6771 (let ((first t)
6772 (level (markdown-outline-level)))
6773 (while (and (not (eobp))
6774 (or first (> (markdown-outline-level) level)))
6775 (setq first nil)
6776 (markdown-next-heading))
6777 (if (memq (preceding-char) '(?\n ?\^M))
6778 (progn
6779 ;; Go to end of line before heading
6780 (forward-char -1)
6781 (if (memq (preceding-char) '(?\n ?\^M))
6782 ;; leave blank line before heading
6783 (forward-char -1)))))
6784 (point))
6786 (defun markdown-outline-fix-visibility ()
6787 "Hide any false positive headings that should not be shown.
6788 For example, headings inside preformatted code blocks may match
6789 `outline-regexp' but should not be shown as headings when cycling.
6790 Also, the ending --- line in metadata blocks appears to be a
6791 setext header, but should not be folded."
6792 (save-excursion
6793 (goto-char (point-min))
6794 ;; Unhide any false positives in metadata blocks
6795 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin)
6796 (let ((body (progn (forward-line)
6797 (markdown-text-property-at-point
6798 'markdown-yaml-metadata-section))))
6799 (when body
6800 (let ((end (progn (goto-char (cl-second body))
6801 (markdown-text-property-at-point
6802 'markdown-yaml-metadata-end))))
6803 (outline-flag-region (point-min) (1+ (cl-second end)) nil)))))
6804 ;; Hide any false positives in code blocks
6805 (unless (outline-on-heading-p)
6806 (outline-next-visible-heading 1))
6807 (while (< (point) (point-max))
6808 (when (markdown-code-block-at-point-p)
6809 (outline-flag-region (1- (point-at-bol)) (point-at-eol) t))
6810 (outline-next-visible-heading 1))))
6812 (defvar markdown-cycle-global-status 1)
6813 (defvar markdown-cycle-subtree-status nil)
6815 (defun markdown-next-preface ()
6816 (let (finish)
6817 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
6818 nil 'move))
6819 (unless (markdown-code-block-at-point-p)
6820 (goto-char (match-beginning 0))
6821 (setq finish t))))
6822 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
6823 (forward-char -1)))
6825 (defun markdown-show-entry ()
6826 (save-excursion
6827 (outline-back-to-heading t)
6828 (outline-flag-region (1- (point))
6829 (progn
6830 (markdown-next-preface)
6831 (if (= 1 (- (point-max) (point)))
6832 (point-max)
6833 (point)))
6834 nil)))
6836 ;; This function was originally derived from `org-cycle' from org.el.
6837 (defun markdown-cycle (&optional arg)
6838 "Visibility cycling for Markdown mode.
6839 This function is called with a `\\[universal-argument]' or if ARG is t, perform
6840 global visibility cycling. If the point is at an atx-style header, cycle
6841 visibility of the corresponding subtree. Otherwise, indent the current line
6842 or insert a tab, as appropriate, by calling `indent-for-tab-command'."
6843 (interactive "P")
6844 (cond
6846 ;; Global cycling
6847 (arg
6848 (cond
6849 ;; Move from overview to contents
6850 ((and (eq last-command this-command)
6851 (eq markdown-cycle-global-status 2))
6852 (outline-hide-sublevels 1)
6853 (message "CONTENTS")
6854 (setq markdown-cycle-global-status 3)
6855 (markdown-outline-fix-visibility))
6856 ;; Move from contents to all
6857 ((and (eq last-command this-command)
6858 (eq markdown-cycle-global-status 3))
6859 (outline-show-all)
6860 (message "SHOW ALL")
6861 (setq markdown-cycle-global-status 1))
6862 ;; Defaults to overview
6864 (outline-hide-body)
6865 (message "OVERVIEW")
6866 (setq markdown-cycle-global-status 2)
6867 (markdown-outline-fix-visibility))))
6869 ;; At a heading: rotate between three different views
6870 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
6871 (markdown-back-to-heading)
6872 (let ((goal-column 0) eoh eol eos)
6873 ;; Determine boundaries
6874 (save-excursion
6875 (markdown-back-to-heading)
6876 (save-excursion
6877 (beginning-of-line 2)
6878 (while (and (not (eobp)) ;; this is like `next-line'
6879 (get-char-property (1- (point)) 'invisible))
6880 (beginning-of-line 2)) (setq eol (point)))
6881 (markdown-end-of-heading) (setq eoh (point))
6882 (markdown-end-of-subtree t)
6883 (skip-chars-forward " \t\n")
6884 (beginning-of-line 1) ; in case this is an item
6885 (setq eos (1- (point))))
6886 ;; Find out what to do next and set `this-command'
6887 (cond
6888 ;; Nothing is hidden behind this heading
6889 ((= eos eoh)
6890 (message "EMPTY ENTRY")
6891 (setq markdown-cycle-subtree-status nil))
6892 ;; Entire subtree is hidden in one line: open it
6893 ((>= eol eos)
6894 (markdown-show-entry)
6895 (outline-show-children)
6896 (message "CHILDREN")
6897 (setq markdown-cycle-subtree-status 'children))
6898 ;; We just showed the children, now show everything.
6899 ((and (eq last-command this-command)
6900 (eq markdown-cycle-subtree-status 'children))
6901 (outline-show-subtree)
6902 (message "SUBTREE")
6903 (setq markdown-cycle-subtree-status 'subtree))
6904 ;; Default action: hide the subtree.
6906 (outline-hide-subtree)
6907 (message "FOLDED")
6908 (setq markdown-cycle-subtree-status 'folded)))))
6910 ;; In a table, move forward by one cell
6911 ((markdown-table-at-point-p)
6912 (call-interactively #'markdown-table-forward-cell))
6914 ;; Otherwise, indent as appropriate
6916 (indent-for-tab-command))))
6918 (defun markdown-shifttab ()
6919 "Handle S-TAB keybinding based on context.
6920 When in a table, move backward one cell.
6921 Otherwise, cycle global heading visibility by calling
6922 `markdown-cycle' with argument t."
6923 (interactive)
6924 (cond ((markdown-table-at-point-p)
6925 (call-interactively #'markdown-table-backward-cell))
6926 (t (markdown-cycle t))))
6928 (defun markdown-outline-level ()
6929 "Return the depth to which a statement is nested in the outline."
6930 (cond
6931 ((and (match-beginning 0)
6932 (markdown-code-block-at-pos (match-beginning 0)))
6933 7) ;; Only 6 header levels are defined.
6934 ((match-end 2) 1)
6935 ((match-end 3) 2)
6936 ((match-end 4)
6937 (length (markdown-trim-whitespace (match-string-no-properties 4))))))
6939 (defun markdown-promote-subtree (&optional arg)
6940 "Promote the current subtree of ATX headings.
6941 Note that Markdown does not support heading levels higher than
6942 six and therefore level-six headings will not be promoted
6943 further. If ARG is non-nil promote the heading, otherwise
6944 demote."
6945 (interactive "*P")
6946 (save-excursion
6947 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx)
6948 (re-search-backward markdown-regex-header-atx nil t))
6949 (not (markdown-code-block-at-point-p)))
6950 (let ((level (length (match-string 1)))
6951 (promote-or-demote (if arg 1 -1))
6952 (remove 't))
6953 (markdown-cycle-atx promote-or-demote remove)
6954 (catch 'end-of-subtree
6955 (while (and (markdown-next-heading)
6956 (looking-at markdown-regex-header-atx))
6957 ;; Exit if this not a higher level heading; promote otherwise.
6958 (if (and (looking-at markdown-regex-header-atx)
6959 (<= (length (match-string-no-properties 1)) level))
6960 (throw 'end-of-subtree nil)
6961 (markdown-cycle-atx promote-or-demote remove))))))))
6963 (defun markdown-demote-subtree ()
6964 "Demote the current subtree of ATX headings."
6965 (interactive)
6966 (markdown-promote-subtree t))
6968 (defun markdown-move-subtree-up ()
6969 "Move the current subtree of ATX headings up."
6970 (interactive)
6971 (outline-move-subtree-up 1))
6973 (defun markdown-move-subtree-down ()
6974 "Move the current subtree of ATX headings down."
6975 (interactive)
6976 (outline-move-subtree-down 1))
6978 (defun markdown-outline-next ()
6979 "Move to next list item, when in a list, or next visible heading."
6980 (interactive)
6981 (let ((bounds (markdown-next-list-item-bounds)))
6982 (if bounds
6983 (goto-char (nth 0 bounds))
6984 (markdown-next-visible-heading 1))))
6986 (defun markdown-outline-previous ()
6987 "Move to previous list item, when in a list, or previous visible heading."
6988 (interactive)
6989 (let ((bounds (markdown-prev-list-item-bounds)))
6990 (if bounds
6991 (goto-char (nth 0 bounds))
6992 (markdown-previous-visible-heading 1))))
6994 (defun markdown-outline-next-same-level ()
6995 "Move to next list item or heading of same level."
6996 (interactive)
6997 (let ((bounds (markdown-cur-list-item-bounds)))
6998 (if bounds
6999 (markdown-next-list-item (nth 3 bounds))
7000 (markdown-forward-same-level 1))))
7002 (defun markdown-outline-previous-same-level ()
7003 "Move to previous list item or heading of same level."
7004 (interactive)
7005 (let ((bounds (markdown-cur-list-item-bounds)))
7006 (if bounds
7007 (markdown-prev-list-item (nth 3 bounds))
7008 (markdown-backward-same-level 1))))
7010 (defun markdown-outline-up ()
7011 "Move to previous list item, when in a list, or previous heading."
7012 (interactive)
7013 (unless (markdown-up-list)
7014 (markdown-up-heading 1)))
7017 ;;; Marking and Narrowing =====================================================
7019 (defun markdown-mark-paragraph ()
7020 "Put mark at end of this block, point at beginning.
7021 The block marked is the one that contains point or follows point.
7023 Interactively, if this command is repeated or (in Transient Mark
7024 mode) if the mark is active, it marks the next block after the
7025 ones already marked."
7026 (interactive)
7027 (if (or (and (eq last-command this-command) (mark t))
7028 (and transient-mark-mode mark-active))
7029 (set-mark
7030 (save-excursion
7031 (goto-char (mark))
7032 (markdown-forward-paragraph)
7033 (point)))
7034 (let ((beginning-of-defun-function 'markdown-backward-paragraph)
7035 (end-of-defun-function 'markdown-forward-paragraph))
7036 (mark-defun))))
7038 (defun markdown-mark-block ()
7039 "Put mark at end of this block, point at beginning.
7040 The block marked is the one that contains point or follows point.
7042 Interactively, if this command is repeated or (in Transient Mark
7043 mode) if the mark is active, it marks the next block after the
7044 ones already marked."
7045 (interactive)
7046 (if (or (and (eq last-command this-command) (mark t))
7047 (and transient-mark-mode mark-active))
7048 (set-mark
7049 (save-excursion
7050 (goto-char (mark))
7051 (markdown-forward-block)
7052 (point)))
7053 (let ((beginning-of-defun-function 'markdown-backward-block)
7054 (end-of-defun-function 'markdown-forward-block))
7055 (mark-defun))))
7057 (defun markdown-narrow-to-block ()
7058 "Make text outside current block invisible.
7059 The current block is the one that contains point or follows point."
7060 (interactive)
7061 (let ((beginning-of-defun-function 'markdown-backward-block)
7062 (end-of-defun-function 'markdown-forward-block))
7063 (narrow-to-defun)))
7065 (defun markdown-mark-text-block ()
7066 "Put mark at end of this plain text block, point at beginning.
7067 The block marked is the one that contains point or follows point.
7069 Interactively, if this command is repeated or (in Transient Mark
7070 mode) if the mark is active, it marks the next block after the
7071 ones already marked."
7072 (interactive)
7073 (if (or (and (eq last-command this-command) (mark t))
7074 (and transient-mark-mode mark-active))
7075 (set-mark
7076 (save-excursion
7077 (goto-char (mark))
7078 (markdown-end-of-text-block)
7079 (point)))
7080 (let ((beginning-of-defun-function 'markdown-beginning-of-text-block)
7081 (end-of-defun-function 'markdown-end-of-text-block))
7082 (mark-defun))))
7084 (defun markdown-mark-page ()
7085 "Put mark at end of this top level section, point at beginning.
7086 The top level section marked is the one that contains point or
7087 follows point.
7089 Interactively, if this command is repeated or (in Transient Mark
7090 mode) if the mark is active, it marks the next page after the
7091 ones already marked."
7092 (interactive)
7093 (if (or (and (eq last-command this-command) (mark t))
7094 (and transient-mark-mode mark-active))
7095 (set-mark
7096 (save-excursion
7097 (goto-char (mark))
7098 (markdown-forward-page)
7099 (point)))
7100 (let ((beginning-of-defun-function 'markdown-backward-page)
7101 (end-of-defun-function 'markdown-forward-page))
7102 (mark-defun))))
7104 (defun markdown-narrow-to-page ()
7105 "Make text outside current top level section invisible.
7106 The current section is the one that contains point or follows point."
7107 (interactive)
7108 (let ((beginning-of-defun-function 'markdown-backward-page)
7109 (end-of-defun-function 'markdown-forward-page))
7110 (narrow-to-defun)))
7112 (defun markdown-mark-subtree ()
7113 "Mark the current subtree.
7114 This puts point at the start of the current subtree, and mark at the end."
7115 (interactive)
7116 (let ((beg))
7117 (if (markdown-heading-at-point)
7118 (beginning-of-line)
7119 (markdown-previous-visible-heading 1))
7120 (setq beg (point))
7121 (markdown-end-of-subtree)
7122 (push-mark (point) nil t)
7123 (goto-char beg)))
7125 (defun markdown-narrow-to-subtree ()
7126 "Narrow buffer to the current subtree."
7127 (interactive)
7128 (save-excursion
7129 (save-match-data
7130 (narrow-to-region
7131 (progn (markdown-back-to-heading-over-code-block t) (point))
7132 (progn (markdown-end-of-subtree)
7133 (if (and (markdown-heading-at-point) (not (eobp)))
7134 (backward-char 1))
7135 (point))))))
7138 ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
7140 (defun markdown-move-up ()
7141 "Move thing at point up.
7142 When in a list item, call `markdown-move-list-item-up'.
7143 When in a table, call `markdown-table-move-row-up'.
7144 Otherwise, move the current heading subtree up with
7145 `markdown-move-subtree-up'."
7146 (interactive)
7147 (cond
7148 ((markdown-list-item-at-point-p)
7149 (call-interactively #'markdown-move-list-item-up))
7150 ((markdown-table-at-point-p)
7151 (call-interactively #'markdown-table-move-row-up))
7153 (call-interactively #'markdown-move-subtree-up))))
7155 (defun markdown-move-down ()
7156 "Move thing at point down.
7157 When in a list item, call `markdown-move-list-item-down'.
7158 Otherwise, move the current heading subtree up with
7159 `markdown-move-subtree-down'."
7160 (interactive)
7161 (cond
7162 ((markdown-list-item-at-point-p)
7163 (call-interactively #'markdown-move-list-item-down))
7164 ((markdown-table-at-point-p)
7165 (call-interactively #'markdown-table-move-row-down))
7167 (call-interactively #'markdown-move-subtree-down))))
7169 (defun markdown-promote ()
7170 "Promote or move element at point to the left.
7171 Depending on the context, this function will promote a heading or
7172 list item at the point, move a table column to the left, or cycle
7173 markup."
7174 (interactive)
7175 (let (bounds)
7176 (cond
7177 ;; Promote atx heading subtree
7178 ((thing-at-point-looking-at markdown-regex-header-atx)
7179 (markdown-promote-subtree))
7180 ;; Promote setext heading
7181 ((thing-at-point-looking-at markdown-regex-header-setext)
7182 (markdown-cycle-setext -1))
7183 ;; Promote horizontal rule
7184 ((thing-at-point-looking-at markdown-regex-hr)
7185 (markdown-cycle-hr -1))
7186 ;; Promote list item
7187 ((setq bounds (markdown-cur-list-item-bounds))
7188 (markdown-promote-list-item bounds))
7189 ;; Move table column to the left
7190 ((markdown-table-at-point-p)
7191 (call-interactively #'markdown-table-move-column-left))
7192 ;; Promote bold
7193 ((thing-at-point-looking-at markdown-regex-bold)
7194 (markdown-cycle-bold))
7195 ;; Promote italic
7196 ((thing-at-point-looking-at markdown-regex-italic)
7197 (markdown-cycle-italic))
7199 (user-error "Nothing to promote at point")))))
7201 (defun markdown-demote ()
7202 "Demote or move element at point to the right.
7203 Depending on the context, this function will demote a heading or
7204 list item at the point, move a table column to the right, or cycle
7205 or remove markup."
7206 (interactive)
7207 (let (bounds)
7208 (cond
7209 ;; Demote atx heading subtree
7210 ((thing-at-point-looking-at markdown-regex-header-atx)
7211 (markdown-demote-subtree))
7212 ;; Demote setext heading
7213 ((thing-at-point-looking-at markdown-regex-header-setext)
7214 (markdown-cycle-setext 1))
7215 ;; Demote horizontal rule
7216 ((thing-at-point-looking-at markdown-regex-hr)
7217 (markdown-cycle-hr 1))
7218 ;; Demote list item
7219 ((setq bounds (markdown-cur-list-item-bounds))
7220 (markdown-demote-list-item bounds))
7221 ;; Move table column to the right
7222 ((markdown-table-at-point-p)
7223 (call-interactively #'markdown-table-move-column-right))
7224 ;; Demote bold
7225 ((thing-at-point-looking-at markdown-regex-bold)
7226 (markdown-cycle-bold))
7227 ;; Demote italic
7228 ((thing-at-point-looking-at markdown-regex-italic)
7229 (markdown-cycle-italic))
7231 (user-error "Nothing to demote at point")))))
7234 ;;; Commands ==================================================================
7236 (defun markdown (&optional output-buffer-name)
7237 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
7238 The output buffer name defaults to `markdown-output-buffer-name'.
7239 Return the name of the output buffer used."
7240 (interactive)
7241 (save-window-excursion
7242 (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command))
7243 ((listp markdown-command) markdown-command)))
7244 (command (car-safe commands))
7245 (command-args (cdr-safe commands))
7246 begin-region end-region)
7247 (if (use-region-p)
7248 (setq begin-region (region-beginning)
7249 end-region (region-end))
7250 (setq begin-region (point-min)
7251 end-region (point-max)))
7253 (unless output-buffer-name
7254 (setq output-buffer-name markdown-output-buffer-name))
7255 (when (and (stringp command) (not (executable-find command)))
7256 (user-error "Markdown command %s is not found" command))
7257 (let ((exit-code
7258 (cond
7259 ;; Handle case when `markdown-command' does not read from stdin
7260 ((and (stringp command) markdown-command-needs-filename)
7261 (if (not buffer-file-name)
7262 (user-error "Must be visiting a file")
7263 ;; Don’t use ‘shell-command’ because it’s not guaranteed to
7264 ;; return the exit code of the process.
7265 (let ((command (if (listp markdown-command)
7266 (string-join markdown-command " ")
7267 markdown-command)))
7268 (shell-command-on-region
7269 ;; Pass an empty region so that stdin is empty.
7270 (point) (point)
7271 (concat command " "
7272 (shell-quote-argument buffer-file-name))
7273 output-buffer-name))))
7274 ;; Pass region to `markdown-command' via stdin
7276 (let ((buf (get-buffer-create output-buffer-name)))
7277 (with-current-buffer buf
7278 (setq buffer-read-only nil)
7279 (erase-buffer))
7280 (if (stringp command)
7281 (if (not (null command-args))
7282 (apply #'call-process-region begin-region end-region command nil buf nil command-args)
7283 (call-process-region begin-region end-region command nil buf))
7284 (funcall markdown-command begin-region end-region buf)
7285 ;; If the ‘markdown-command’ function didn’t signal an
7286 ;; error, assume it succeeded by binding ‘exit-code’ to 0.
7287 0))))))
7288 ;; The exit code can be a signal description string, so don’t use ‘=’
7289 ;; or ‘zerop’.
7290 (unless (eq exit-code 0)
7291 (user-error "%s failed with exit code %s"
7292 markdown-command exit-code))))
7293 output-buffer-name))
7295 (defun markdown-standalone (&optional output-buffer-name)
7296 "Special function to provide standalone HTML output.
7297 Insert the output in the buffer named OUTPUT-BUFFER-NAME."
7298 (interactive)
7299 (setq output-buffer-name (markdown output-buffer-name))
7300 (with-current-buffer output-buffer-name
7301 (set-buffer output-buffer-name)
7302 (unless (markdown-output-standalone-p)
7303 (markdown-add-xhtml-header-and-footer output-buffer-name))
7304 (goto-char (point-min))
7305 (html-mode))
7306 output-buffer-name)
7308 (defun markdown-other-window (&optional output-buffer-name)
7309 "Run `markdown-command' on current buffer and display in other window.
7310 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7311 that name."
7312 (interactive)
7313 (markdown-display-buffer-other-window
7314 (markdown-standalone output-buffer-name)))
7316 (defun markdown-output-standalone-p ()
7317 "Determine whether `markdown-command' output is standalone XHTML.
7318 Standalone XHTML output is identified by an occurrence of
7319 `markdown-xhtml-standalone-regexp' in the first five lines of output."
7320 (save-excursion
7321 (goto-char (point-min))
7322 (save-match-data
7323 (re-search-forward
7324 markdown-xhtml-standalone-regexp
7325 (save-excursion (goto-char (point-min)) (forward-line 4) (point))
7326 t))))
7328 (defun markdown-stylesheet-link-string (stylesheet-path)
7329 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
7330 (or (and (string-prefix-p "~" stylesheet-path)
7331 (expand-file-name stylesheet-path))
7332 stylesheet-path)
7333 "\" />"))
7335 (defun markdown-add-xhtml-header-and-footer (title)
7336 "Wrap XHTML header and footer with given TITLE around current buffer."
7337 (goto-char (point-min))
7338 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
7339 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
7340 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
7341 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
7342 "<head>\n<title>")
7343 (insert title)
7344 (insert "</title>\n")
7345 (unless (= (length markdown-content-type) 0)
7346 (insert
7347 (format
7348 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
7349 markdown-content-type
7350 (or (and markdown-coding-system
7351 (coding-system-get markdown-coding-system
7352 'mime-charset))
7353 (coding-system-get buffer-file-coding-system
7354 'mime-charset)
7355 "utf-8"))))
7356 (if (> (length markdown-css-paths) 0)
7357 (insert (mapconcat #'markdown-stylesheet-link-string
7358 markdown-css-paths "\n")))
7359 (when (> (length markdown-xhtml-header-content) 0)
7360 (insert markdown-xhtml-header-content))
7361 (insert "\n</head>\n\n"
7362 "<body>\n\n")
7363 (when (> (length markdown-xhtml-body-preamble) 0)
7364 (insert markdown-xhtml-body-preamble "\n"))
7365 (goto-char (point-max))
7366 (when (> (length markdown-xhtml-body-epilogue) 0)
7367 (insert "\n" markdown-xhtml-body-epilogue))
7368 (insert "\n"
7369 "</body>\n"
7370 "</html>\n"))
7372 (defun markdown-preview (&optional output-buffer-name)
7373 "Run `markdown-command' on the current buffer and view output in browser.
7374 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7375 that name."
7376 (interactive)
7377 (browse-url-of-buffer
7378 (markdown-standalone (or output-buffer-name markdown-output-buffer-name))))
7380 (defun markdown-export-file-name (&optional extension)
7381 "Attempt to generate a filename for Markdown output.
7382 The file extension will be EXTENSION if given, or .html by default.
7383 If the current buffer is visiting a file, we construct a new
7384 output filename based on that filename. Otherwise, return nil."
7385 (when (buffer-file-name)
7386 (unless extension
7387 (setq extension ".html"))
7388 (let ((candidate
7389 (concat
7390 (cond
7391 ((buffer-file-name)
7392 (file-name-sans-extension (buffer-file-name)))
7393 (t (buffer-name)))
7394 extension)))
7395 (cond
7396 ((equal candidate (buffer-file-name))
7397 (concat candidate extension))
7399 candidate)))))
7401 (defun markdown-export (&optional output-file)
7402 "Run Markdown on the current buffer, save to file, and return the filename.
7403 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
7404 generated by `markdown-export-file-name', which will be constructed using the
7405 current filename, but with the extension removed and replaced with .html."
7406 (interactive)
7407 (unless output-file
7408 (setq output-file (markdown-export-file-name ".html")))
7409 (when output-file
7410 (let* ((init-buf (current-buffer))
7411 (init-point (point))
7412 (init-buf-string (buffer-string))
7413 (output-buffer (find-file-noselect output-file))
7414 (output-buffer-name (buffer-name output-buffer)))
7415 (run-hooks 'markdown-before-export-hook)
7416 (markdown-standalone output-buffer-name)
7417 (with-current-buffer output-buffer
7418 (run-hooks 'markdown-after-export-hook)
7419 (save-buffer)
7420 (when markdown-export-kill-buffer (kill-buffer)))
7421 ;; if modified, restore initial buffer
7422 (when (buffer-modified-p init-buf)
7423 (erase-buffer)
7424 (insert init-buf-string)
7425 (save-buffer)
7426 (goto-char init-point))
7427 output-file)))
7429 (defun markdown-export-and-preview ()
7430 "Export to XHTML using `markdown-export' and browse the resulting file."
7431 (interactive)
7432 (browse-url-of-file (markdown-export)))
7434 (defvar-local markdown-live-preview-buffer nil
7435 "Buffer used to preview markdown output in `markdown-live-preview-export'.")
7437 (defvar-local markdown-live-preview-source-buffer nil
7438 "Source buffer from which current buffer was generated.
7439 This is the inverse of `markdown-live-preview-buffer'.")
7441 (defvar markdown-live-preview-currently-exporting nil)
7443 (defun markdown-live-preview-get-filename ()
7444 "Standardize the filename exported by `markdown-live-preview-export'."
7445 (markdown-export-file-name ".html"))
7447 (defun markdown-live-preview-window-eww (file)
7448 "Preview FILE with eww.
7449 To be used with `markdown-live-preview-window-function'."
7450 (eww-open-file file)
7451 (get-buffer "*eww*"))
7453 (defun markdown-visual-lines-between-points (beg end)
7454 (save-excursion
7455 (goto-char beg)
7456 (cl-loop with count = 0
7457 while (progn (end-of-visual-line)
7458 (and (< (point) end) (line-move-visual 1 t)))
7459 do (cl-incf count)
7460 finally return count)))
7462 (defun markdown-live-preview-window-serialize (buf)
7463 "Get window point and scroll data for all windows displaying BUF."
7464 (when (buffer-live-p buf)
7465 (with-current-buffer buf
7466 (mapcar
7467 (lambda (win)
7468 (with-selected-window win
7469 (let* ((start (window-start))
7470 (pt (window-point))
7471 (pt-or-sym (cond ((= pt (point-min)) 'min)
7472 ((= pt (point-max)) 'max)
7473 (t pt)))
7474 (diff (markdown-visual-lines-between-points
7475 start pt)))
7476 (list win pt-or-sym diff))))
7477 (get-buffer-window-list buf)))))
7479 (defun markdown-get-point-back-lines (pt num-lines)
7480 (save-excursion
7481 (goto-char pt)
7482 (line-move-visual (- num-lines) t)
7483 ;; in testing, can occasionally overshoot the number of lines to traverse
7484 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt)))
7485 (when (> actual-num-lines num-lines)
7486 (line-move-visual (- actual-num-lines num-lines) t)))
7487 (point)))
7489 (defun markdown-live-preview-window-deserialize (window-posns)
7490 "Apply window point and scroll data from WINDOW-POSNS.
7491 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
7492 (cl-destructuring-bind (win pt-or-sym diff) window-posns
7493 (when (window-live-p win)
7494 (with-current-buffer markdown-live-preview-buffer
7495 (set-window-buffer win (current-buffer))
7496 (cl-destructuring-bind (actual-pt actual-diff)
7497 (cl-case pt-or-sym
7498 (min (list (point-min) 0))
7499 (max (list (point-max) diff))
7500 (t (list pt-or-sym diff)))
7501 (set-window-start
7502 win (markdown-get-point-back-lines actual-pt actual-diff))
7503 (set-window-point win actual-pt))))))
7505 (defun markdown-live-preview-export ()
7506 "Export to XHTML using `markdown-export'.
7507 Browse the resulting file within Emacs using
7508 `markdown-live-preview-window-function' Return the buffer
7509 displaying the rendered output."
7510 (interactive)
7511 (let ((filename (markdown-live-preview-get-filename)))
7512 (when filename
7513 (let* ((markdown-live-preview-currently-exporting t)
7514 (cur-buf (current-buffer))
7515 (export-file (markdown-export filename))
7516 ;; get positions in all windows currently displaying output buffer
7517 (window-data
7518 (markdown-live-preview-window-serialize
7519 markdown-live-preview-buffer)))
7520 (save-window-excursion
7521 (let ((output-buffer
7522 (funcall markdown-live-preview-window-function export-file)))
7523 (with-current-buffer output-buffer
7524 (setq markdown-live-preview-source-buffer cur-buf)
7525 (add-hook 'kill-buffer-hook
7526 #'markdown-live-preview-remove-on-kill t t))
7527 (with-current-buffer cur-buf
7528 (setq markdown-live-preview-buffer output-buffer))))
7529 (with-current-buffer cur-buf
7530 ;; reset all windows displaying output buffer to where they were,
7531 ;; now with the new output
7532 (mapc #'markdown-live-preview-window-deserialize window-data)
7533 ;; delete html editing buffer
7534 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf)))
7535 (when (and export-file (file-exists-p export-file)
7536 (eq markdown-live-preview-delete-export
7537 'delete-on-export))
7538 (delete-file export-file))
7539 markdown-live-preview-buffer)))))
7541 (defun markdown-live-preview-remove ()
7542 (when (buffer-live-p markdown-live-preview-buffer)
7543 (kill-buffer markdown-live-preview-buffer))
7544 (setq markdown-live-preview-buffer nil)
7545 ;; if set to 'delete-on-export, the output has already been deleted
7546 (when (eq markdown-live-preview-delete-export 'delete-on-destroy)
7547 (let ((outfile-name (markdown-live-preview-get-filename)))
7548 (when (and outfile-name (file-exists-p outfile-name))
7549 (delete-file outfile-name)))))
7551 (defun markdown-get-other-window ()
7552 "Find another window to display preview or output content."
7553 (cond
7554 ((memq markdown-split-window-direction '(vertical below))
7555 (or (window-in-direction 'below) (split-window-vertically)))
7556 ((memq markdown-split-window-direction '(horizontal right))
7557 (or (window-in-direction 'right) (split-window-horizontally)))
7558 (t (split-window-sensibly (get-buffer-window)))))
7560 (defun markdown-display-buffer-other-window (buf)
7561 "Display preview or output buffer BUF in another window."
7562 (if (and display-buffer-alist (eq markdown-split-window-direction 'any))
7563 (display-buffer buf)
7564 (let ((cur-buf (current-buffer))
7565 (window (markdown-get-other-window)))
7566 (set-window-buffer window buf)
7567 (set-buffer cur-buf))))
7569 (defun markdown-live-preview-if-markdown ()
7570 (when (and (derived-mode-p 'markdown-mode)
7571 markdown-live-preview-mode)
7572 (unless markdown-live-preview-currently-exporting
7573 (if (buffer-live-p markdown-live-preview-buffer)
7574 (markdown-live-preview-export)
7575 (markdown-display-buffer-other-window
7576 (markdown-live-preview-export))))))
7578 (defun markdown-live-preview-remove-on-kill ()
7579 (cond ((and (derived-mode-p 'markdown-mode)
7580 markdown-live-preview-mode)
7581 (markdown-live-preview-remove))
7582 (markdown-live-preview-source-buffer
7583 (with-current-buffer markdown-live-preview-source-buffer
7584 (setq markdown-live-preview-buffer nil))
7585 (setq markdown-live-preview-source-buffer nil))))
7587 (defun markdown-live-preview-switch-to-output ()
7588 "Switch to output buffer."
7589 (interactive)
7590 "Turn on `markdown-live-preview-mode' if not already on, and switch to its
7591 output buffer in another window."
7592 (if markdown-live-preview-mode
7593 (markdown-display-buffer-other-window (markdown-live-preview-export)))
7594 (markdown-live-preview-mode))
7596 (defun markdown-live-preview-re-export ()
7597 "Re export source buffer."
7598 (interactive)
7599 "If the current buffer is a buffer displaying the exported version of a
7600 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
7601 update this buffer's contents."
7602 (when markdown-live-preview-source-buffer
7603 (with-current-buffer markdown-live-preview-source-buffer
7604 (markdown-live-preview-export))))
7606 (defun markdown-open ()
7607 "Open file for the current buffer with `markdown-open-command'."
7608 (interactive)
7609 (unless markdown-open-command
7610 (user-error "Variable `markdown-open-command' must be set"))
7611 (if (stringp markdown-open-command)
7612 (if (not buffer-file-name)
7613 (user-error "Must be visiting a file")
7614 (save-buffer)
7615 (let ((exit-code (call-process markdown-open-command nil nil nil
7616 buffer-file-name)))
7617 ;; The exit code can be a signal description string, so don’t use ‘=’
7618 ;; or ‘zerop’.
7619 (unless (eq exit-code 0)
7620 (user-error "%s failed with exit code %s"
7621 markdown-open-command exit-code))))
7622 (funcall markdown-open-command))
7623 nil)
7625 (defun markdown-kill-ring-save ()
7626 "Run Markdown on file and store output in the kill ring."
7627 (interactive)
7628 (save-window-excursion
7629 (markdown)
7630 (with-current-buffer markdown-output-buffer-name
7631 (kill-ring-save (point-min) (point-max)))))
7634 ;;; Links =====================================================================
7636 (defun markdown-backward-to-link-start ()
7637 "Backward link start position if current position is in link title."
7638 ;; Issue #305
7639 (when (eq (get-text-property (point) 'face) 'markdown-link-face)
7640 (skip-chars-backward "^[")
7641 (forward-char -1)))
7643 (defun markdown-link-p ()
7644 "Return non-nil when `point' is at a non-wiki link.
7645 See `markdown-wiki-link-p' for more information."
7646 (save-excursion
7647 (let ((case-fold-search nil))
7648 (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p)))
7649 (markdown-backward-to-link-start)
7650 (or (thing-at-point-looking-at markdown-regex-link-inline)
7651 (thing-at-point-looking-at markdown-regex-link-reference)
7652 (thing-at-point-looking-at markdown-regex-uri)
7653 (thing-at-point-looking-at markdown-regex-angle-uri))))))
7655 (defun markdown-link-at-pos (pos)
7656 "Return properties of link or image at position POS.
7657 Value is a list of elements describing the link:
7658 0. beginning position
7659 1. end position
7660 2. link text
7661 3. URL
7662 4. reference label
7663 5. title text
7664 6. bang (nil or \"!\")"
7665 (save-excursion
7666 (goto-char pos)
7667 (markdown-backward-to-link-start)
7668 (let (begin end text url reference title bang)
7669 (cond
7670 ;; Inline image or link at point.
7671 ((thing-at-point-looking-at markdown-regex-link-inline)
7672 (setq bang (match-string-no-properties 1)
7673 begin (match-beginning 0)
7674 end (match-end 0)
7675 text (match-string-no-properties 3)
7676 url (match-string-no-properties 6))
7677 (if (match-end 7)
7678 (setq title (substring (match-string-no-properties 7) 1 -1))
7679 ;; #408 URL contains close parenthesis case
7680 (goto-char (match-beginning 5))
7681 (let ((paren-end (scan-sexps (point) 1)))
7682 (when (and paren-end (< end paren-end))
7683 (setq url (buffer-substring (match-beginning 6) (1- paren-end)))))))
7684 ;; Reference link at point.
7685 ((or (thing-at-point-looking-at markdown-regex-link-inline)
7686 (thing-at-point-looking-at markdown-regex-link-reference))
7687 (setq bang (match-string-no-properties 1)
7688 begin (match-beginning 0)
7689 end (match-end 0)
7690 text (match-string-no-properties 3))
7691 (when (char-equal (char-after (match-beginning 5)) ?\[)
7692 (setq reference (match-string-no-properties 6))))
7693 ;; Angle bracket URI at point.
7694 ((thing-at-point-looking-at markdown-regex-angle-uri)
7695 (setq begin (match-beginning 0)
7696 end (match-end 0)
7697 url (match-string-no-properties 2)))
7698 ;; Plain URI at point.
7699 ((thing-at-point-looking-at markdown-regex-uri)
7700 (setq begin (match-beginning 0)
7701 end (match-end 0)
7702 url (match-string-no-properties 1))))
7703 (list begin end text url reference title bang))))
7705 (defun markdown-link-url ()
7706 "Return the URL part of the regular (non-wiki) link at point.
7707 Works with both inline and reference style links, and with images.
7708 If point is not at a link or the link reference is not defined
7709 returns nil."
7710 (let* ((values (markdown-link-at-pos (point)))
7711 (text (nth 2 values))
7712 (url (nth 3 values))
7713 (ref (nth 4 values)))
7714 (or url (and ref (car (markdown-reference-definition
7715 (downcase (if (string= ref "") text ref))))))))
7717 (defun markdown--browse-url (url)
7718 (let* ((struct (url-generic-parse-url url))
7719 (full (url-fullness struct))
7720 (file url))
7721 ;; Parse URL, determine fullness, strip query string
7722 (setq file (car (url-path-and-query struct)))
7723 ;; Open full URLs in browser, files in Emacs
7724 (if full
7725 (browse-url url)
7726 (when (and file (> (length file) 0))
7727 (let ((link-file (funcall markdown-translate-filename-function file)))
7728 (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file))
7729 (if (functionp markdown-open-image-command)
7730 (funcall markdown-open-image-command link-file)
7731 (process-file markdown-open-image-command nil nil nil link-file))
7732 (find-file link-file)))))))
7734 (defun markdown-follow-link-at-point ()
7735 "Open the current non-wiki link.
7736 If the link is a complete URL, open in browser with `browse-url'.
7737 Otherwise, open with `find-file' after stripping anchor and/or query string.
7738 Translate filenames using `markdown-filename-translate-function'."
7739 (interactive)
7740 (if (markdown-link-p)
7741 (markdown--browse-url (markdown-link-url))
7742 (user-error "Point is not at a Markdown link or URL")))
7744 (defun markdown-fontify-inline-links (last)
7745 "Add text properties to next inline link from point to LAST."
7746 (when (markdown-match-generic-links last nil)
7747 (let* ((link-start (match-beginning 3))
7748 (link-end (match-end 3))
7749 (url-start (match-beginning 6))
7750 (url-end (match-end 6))
7751 (url (match-string-no-properties 6))
7752 (title-start (match-beginning 7))
7753 (title-end (match-end 7))
7754 (title (match-string-no-properties 7))
7755 ;; Markup part
7756 (mp (list 'face 'markdown-markup-face
7757 'invisible 'markdown-markup
7758 'rear-nonsticky t
7759 'font-lock-multiline t))
7760 ;; Link part (without face)
7761 (lp (list 'keymap markdown-mode-mouse-map
7762 'mouse-face 'markdown-highlight-face
7763 'font-lock-multiline t
7764 'help-echo (if title (concat title "\n" url) url)))
7765 ;; URL part
7766 (up (list 'keymap markdown-mode-mouse-map
7767 'face 'markdown-url-face
7768 'invisible 'markdown-markup
7769 'mouse-face 'markdown-highlight-face
7770 'font-lock-multiline t))
7771 ;; URL composition character
7772 (url-char (markdown--first-displayable markdown-url-compose-char))
7773 ;; Title part
7774 (tp (list 'face 'markdown-link-title-face
7775 'invisible 'markdown-markup
7776 'font-lock-multiline t)))
7777 (dolist (g '(1 2 4 5 8))
7778 (when (match-end g)
7779 (add-text-properties (match-beginning g) (match-end g) mp)))
7780 ;; Preserve existing faces applied to link part (e.g., inline code)
7781 (when link-start
7782 (add-text-properties link-start link-end lp)
7783 (add-face-text-property link-start link-end
7784 'markdown-link-face 'append))
7785 (when url-start (add-text-properties url-start url-end up))
7786 (when title-start (add-text-properties url-end title-end tp))
7787 (when (and markdown-hide-urls url-start)
7788 (compose-region url-start (or title-end url-end) url-char))
7789 t)))
7791 (defun markdown-fontify-reference-links (last)
7792 "Add text properties to next reference link from point to LAST."
7793 (when (markdown-match-generic-links last t)
7794 (let* ((link-start (match-beginning 3))
7795 (link-end (match-end 3))
7796 (ref-start (match-beginning 6))
7797 (ref-end (match-end 6))
7798 ;; Markup part
7799 (mp (list 'face 'markdown-markup-face
7800 'invisible 'markdown-markup
7801 'rear-nonsticky t
7802 'font-lock-multiline t))
7803 ;; Link part
7804 (lp (list 'keymap markdown-mode-mouse-map
7805 'face 'markdown-link-face
7806 'mouse-face 'markdown-highlight-face
7807 'font-lock-multiline t
7808 'help-echo (lambda (_ __ pos)
7809 (save-match-data
7810 (save-excursion
7811 (goto-char pos)
7812 (or (markdown-link-url)
7813 "Undefined reference"))))))
7814 ;; URL composition character
7815 (url-char (markdown--first-displayable markdown-url-compose-char))
7816 ;; Reference part
7817 (rp (list 'face 'markdown-reference-face
7818 'invisible 'markdown-markup
7819 'font-lock-multiline t)))
7820 (dolist (g '(1 2 4 5 8))
7821 (when (match-end g)
7822 (add-text-properties (match-beginning g) (match-end g) mp)))
7823 (when link-start (add-text-properties link-start link-end lp))
7824 (when ref-start (add-text-properties ref-start ref-end rp)
7825 (when (and markdown-hide-urls (> (- ref-end ref-start) 2))
7826 (compose-region ref-start ref-end url-char)))
7827 t)))
7829 (defun markdown-fontify-angle-uris (last)
7830 "Add text properties to angle URIs from point to LAST."
7831 (when (markdown-match-angle-uris last)
7832 (let* ((url-start (match-beginning 2))
7833 (url-end (match-end 2))
7834 ;; Markup part
7835 (mp (list 'face 'markdown-markup-face
7836 'invisible 'markdown-markup
7837 'rear-nonsticky t
7838 'font-lock-multiline t))
7839 ;; URI part
7840 (up (list 'keymap markdown-mode-mouse-map
7841 'face 'markdown-plain-url-face
7842 'mouse-face 'markdown-highlight-face
7843 'font-lock-multiline t)))
7844 (dolist (g '(1 3))
7845 (add-text-properties (match-beginning g) (match-end g) mp))
7846 (add-text-properties url-start url-end up)
7847 t)))
7849 (defun markdown-fontify-plain-uris (last)
7850 "Add text properties to plain URLs from point to LAST."
7851 (when (markdown-match-plain-uris last)
7852 (let* ((start (match-beginning 0))
7853 (end (match-end 0))
7854 (props (list 'keymap markdown-mode-mouse-map
7855 'face 'markdown-plain-url-face
7856 'mouse-face 'markdown-highlight-face
7857 'rear-nonsticky t
7858 'font-lock-multiline t)))
7859 (add-text-properties start end props)
7860 t)))
7862 (defun markdown-toggle-url-hiding (&optional arg)
7863 "Toggle the display or hiding of URLs.
7864 With a prefix argument ARG, enable URL hiding if ARG is positive,
7865 and disable it otherwise."
7866 (interactive (list (or current-prefix-arg 'toggle)))
7867 (setq markdown-hide-urls
7868 (if (eq arg 'toggle)
7869 (not markdown-hide-urls)
7870 (> (prefix-numeric-value arg) 0)))
7871 (if markdown-hide-urls
7872 (message "markdown-mode URL hiding enabled")
7873 (message "markdown-mode URL hiding disabled"))
7874 (markdown-reload-extensions))
7877 ;;; Wiki Links ================================================================
7879 (defun markdown-wiki-link-p ()
7880 "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
7881 A true wiki link name matches `markdown-regex-wiki-link' but does
7882 not match the current file name after conversion. This modifies
7883 the data returned by `match-data'. Note that the potential wiki
7884 link name must be available via `match-string'."
7885 (when markdown-enable-wiki-links
7886 (let ((case-fold-search nil))
7887 (and (thing-at-point-looking-at markdown-regex-wiki-link)
7888 (not (markdown-code-block-at-point-p))
7889 (or (not buffer-file-name)
7890 (not (string-equal (buffer-file-name)
7891 (markdown-convert-wiki-link-to-filename
7892 (markdown-wiki-link-link)))))))))
7894 (defun markdown-wiki-link-link ()
7895 "Return the link part of the wiki link using current match data.
7896 The location of the link component depends on the value of
7897 `markdown-wiki-link-alias-first'."
7898 (if markdown-wiki-link-alias-first
7899 (or (match-string-no-properties 5) (match-string-no-properties 3))
7900 (match-string-no-properties 3)))
7902 (defun markdown-wiki-link-alias ()
7903 "Return the alias or text part of the wiki link using current match data.
7904 The location of the alias component depends on the value of
7905 `markdown-wiki-link-alias-first'."
7906 (if markdown-wiki-link-alias-first
7907 (match-string-no-properties 3)
7908 (or (match-string-no-properties 5) (match-string-no-properties 3))))
7910 (defun markdown--wiki-link-search-types ()
7911 (let ((ret (and markdown-wiki-link-search-type
7912 (cl-copy-list markdown-wiki-link-search-type))))
7913 (when (and markdown-wiki-link-search-subdirectories
7914 (not (memq 'sub-directories markdown-wiki-link-search-type)))
7915 (push 'sub-directories ret))
7916 (when (and markdown-wiki-link-search-parent-directories
7917 (not (memq 'parent-directories markdown-wiki-link-search-type)))
7918 (push 'parent-directories ret))
7919 ret))
7921 (defun markdown--project-root ()
7922 (or (cl-loop for dir in '(".git" ".hg" ".svn")
7923 when (locate-dominating-file default-directory dir)
7924 return it)
7925 (progn
7926 (require 'project)
7927 (let ((project (project-current t)))
7928 (with-no-warnings
7929 (if (fboundp 'project-root)
7930 (project-root project)
7931 (car (project-roots project))))))))
7933 (defun markdown-convert-wiki-link-to-filename (name)
7934 "Generate a filename from the wiki link NAME.
7935 Spaces in NAME are replaced with `markdown-link-space-sub-char'.
7936 When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
7937 and [[test test]] both map to Test-test.ext. Look in the current
7938 directory first, then in subdirectories if
7939 `markdown-wiki-link-search-subdirectories' is non-nil, and then
7940 in parent directories if
7941 `markdown-wiki-link-search-parent-directories' is non-nil."
7942 (save-match-data
7943 ;; This function must not overwrite match data(PR #590)
7944 (let* ((basename (replace-regexp-in-string
7945 "[[:space:]\n]" markdown-link-space-sub-char name))
7946 (basename (if (derived-mode-p 'gfm-mode)
7947 (concat (upcase (substring basename 0 1))
7948 (downcase (substring basename 1 nil)))
7949 basename))
7950 (search-types (markdown--wiki-link-search-types))
7951 directory extension default candidates dir)
7952 (when buffer-file-name
7953 (setq directory (file-name-directory buffer-file-name)
7954 extension (file-name-extension buffer-file-name)))
7955 (setq default (concat basename
7956 (when extension (concat "." extension))))
7957 (cond
7958 ;; Look in current directory first.
7959 ((or (null buffer-file-name)
7960 (file-exists-p default))
7961 default)
7962 ;; Possibly search in subdirectories, next.
7963 ((and (memq 'sub-directories search-types)
7964 (setq candidates
7965 (directory-files-recursively
7966 directory (concat "^" default "$"))))
7967 (car candidates))
7968 ;; Possibly search in parent directories as a last resort.
7969 ((and (memq 'parent-directories search-types)
7970 (setq dir (locate-dominating-file directory default)))
7971 (concat dir default))
7972 ((and (memq 'project search-types)
7973 (setq candidates
7974 (directory-files-recursively
7975 (markdown--project-root) (concat "^" default "$"))))
7976 (car candidates))
7977 ;; If nothing is found, return default in current directory.
7978 (t default)))))
7980 (defun markdown-follow-wiki-link (name &optional other)
7981 "Follow the wiki link NAME.
7982 Convert the name to a file name and call `find-file'. Ensure that
7983 the new buffer remains in `markdown-mode'. Open the link in another
7984 window when OTHER is non-nil."
7985 (let ((filename (markdown-convert-wiki-link-to-filename name))
7986 (wp (when buffer-file-name
7987 (file-name-directory buffer-file-name))))
7988 (if (not wp)
7989 (user-error "Must be visiting a file")
7990 (when other (other-window 1))
7991 (let ((default-directory wp))
7992 (find-file filename)))
7993 (unless (derived-mode-p 'markdown-mode)
7994 (markdown-mode))))
7996 (defun markdown-follow-wiki-link-at-point (&optional arg)
7997 "Find Wiki Link at point.
7998 With prefix argument ARG, open the file in other window.
7999 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
8000 (interactive "P")
8001 (if (markdown-wiki-link-p)
8002 (markdown-follow-wiki-link (markdown-wiki-link-link) arg)
8003 (user-error "Point is not at a Wiki Link")))
8005 (defun markdown-highlight-wiki-link (from to face)
8006 "Highlight the wiki link in the region between FROM and TO using FACE."
8007 (put-text-property from to 'font-lock-face face))
8009 (defun markdown-unfontify-region-wiki-links (from to)
8010 "Remove wiki link faces from the region specified by FROM and TO."
8011 (interactive "*r")
8012 (let ((modified (buffer-modified-p)))
8013 (remove-text-properties from to '(font-lock-face markdown-link-face))
8014 (remove-text-properties from to '(font-lock-face markdown-missing-link-face))
8015 ;; remove-text-properties marks the buffer modified in emacs 24.3,
8016 ;; undo that if it wasn't originally marked modified
8017 (set-buffer-modified-p modified)))
8019 (defun markdown-fontify-region-wiki-links (from to)
8020 "Search region given by FROM and TO for wiki links and fontify them.
8021 If a wiki link is found check to see if the backing file exists
8022 and highlight accordingly."
8023 (goto-char from)
8024 (save-match-data
8025 (while (re-search-forward markdown-regex-wiki-link to t)
8026 (when (not (markdown-code-block-at-point-p))
8027 (let ((highlight-beginning (match-beginning 1))
8028 (highlight-end (match-end 1))
8029 (file-name
8030 (markdown-convert-wiki-link-to-filename
8031 (markdown-wiki-link-link))))
8032 (if (condition-case nil (file-exists-p file-name) (error nil))
8033 (markdown-highlight-wiki-link
8034 highlight-beginning highlight-end 'markdown-link-face)
8035 (markdown-highlight-wiki-link
8036 highlight-beginning highlight-end 'markdown-missing-link-face)))))))
8038 (defun markdown-extend-changed-region (from to)
8039 "Extend region given by FROM and TO so that we can fontify all links.
8040 The region is extended to the first newline before and the first
8041 newline after."
8042 ;; start looking for the first new line before 'from
8043 (goto-char from)
8044 (re-search-backward "\n" nil t)
8045 (let ((new-from (point-min))
8046 (new-to (point-max)))
8047 (if (not (= (point) from))
8048 (setq new-from (point)))
8049 ;; do the same thing for the first new line after 'to
8050 (goto-char to)
8051 (re-search-forward "\n" nil t)
8052 (if (not (= (point) to))
8053 (setq new-to (point)))
8054 (cl-values new-from new-to)))
8056 (defun markdown-check-change-for-wiki-link (from to)
8057 "Check region between FROM and TO for wiki links and re-fontify as needed."
8058 (interactive "*r")
8059 (let* ((modified (buffer-modified-p))
8060 (buffer-undo-list t)
8061 (inhibit-read-only t)
8062 (inhibit-point-motion-hooks t)
8063 deactivate-mark
8064 buffer-file-truename)
8065 (unwind-protect
8066 (save-excursion
8067 (save-match-data
8068 (save-restriction
8069 ;; Extend the region to fontify so that it starts
8070 ;; and ends at safe places.
8071 (cl-multiple-value-bind (new-from new-to)
8072 (markdown-extend-changed-region from to)
8073 (goto-char new-from)
8074 ;; Only refontify when the range contains text with a
8075 ;; wiki link face or if the wiki link regexp matches.
8076 (when (or (markdown-range-property-any
8077 new-from new-to 'font-lock-face
8078 '(markdown-link-face markdown-missing-link-face))
8079 (re-search-forward
8080 markdown-regex-wiki-link new-to t))
8081 ;; Unfontify existing fontification (start from scratch)
8082 (markdown-unfontify-region-wiki-links new-from new-to)
8083 ;; Now do the fontification.
8084 (markdown-fontify-region-wiki-links new-from new-to))))))
8085 (and (not modified)
8086 (buffer-modified-p)
8087 (set-buffer-modified-p nil)))))
8089 (defun markdown-check-change-for-wiki-link-after-change (from to _)
8090 "Check region between FROM and TO for wiki links and re-fontify as needed.
8091 Designed to be used with the `after-change-functions' hook."
8092 (markdown-check-change-for-wiki-link from to))
8094 (defun markdown-fontify-buffer-wiki-links ()
8095 "Refontify all wiki links in the buffer."
8096 (interactive)
8097 (markdown-check-change-for-wiki-link (point-min) (point-max)))
8099 (defun markdown-toggle-wiki-links (&optional arg)
8100 "Toggle support for wiki links.
8101 With a prefix argument ARG, enable wiki link support if ARG is positive,
8102 and disable it otherwise."
8103 (interactive (list (or current-prefix-arg 'toggle)))
8104 (setq markdown-enable-wiki-links
8105 (if (eq arg 'toggle)
8106 (not markdown-enable-wiki-links)
8107 (> (prefix-numeric-value arg) 0)))
8108 (if markdown-enable-wiki-links
8109 (message "markdown-mode wiki link support enabled")
8110 (message "markdown-mode wiki link support disabled"))
8111 (markdown-reload-extensions))
8113 (defun markdown-setup-wiki-link-hooks ()
8114 "Add or remove hooks for fontifying wiki links.
8115 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
8116 ;; Anytime text changes make sure it gets fontified correctly
8117 (if (and markdown-enable-wiki-links
8118 markdown-wiki-link-fontify-missing)
8119 (add-hook 'after-change-functions
8120 'markdown-check-change-for-wiki-link-after-change t t)
8121 (remove-hook 'after-change-functions
8122 'markdown-check-change-for-wiki-link-after-change t))
8123 ;; If we left the buffer there is a really good chance we were
8124 ;; creating one of the wiki link documents. Make sure we get
8125 ;; refontified when we come back.
8126 (if (and markdown-enable-wiki-links
8127 markdown-wiki-link-fontify-missing)
8128 (progn
8129 (add-hook 'window-configuration-change-hook
8130 'markdown-fontify-buffer-wiki-links t t)
8131 (markdown-fontify-buffer-wiki-links))
8132 (remove-hook 'window-configuration-change-hook
8133 'markdown-fontify-buffer-wiki-links t)
8134 (markdown-unfontify-region-wiki-links (point-min) (point-max))))
8137 ;;; Following & Doing =========================================================
8139 (defun markdown-follow-thing-at-point (arg)
8140 "Follow thing at point if possible, such as a reference link or wiki link.
8141 Opens inline and reference links in a browser. Opens wiki links
8142 to other files in the current window, or the another window if
8143 ARG is non-nil.
8144 See `markdown-follow-link-at-point' and
8145 `markdown-follow-wiki-link-at-point'."
8146 (interactive "P")
8147 (cond ((markdown-link-p)
8148 (markdown--browse-url (markdown-link-url)))
8149 ((markdown-wiki-link-p)
8150 (markdown-follow-wiki-link-at-point arg))
8152 (let* ((values (markdown-link-at-pos (point)))
8153 (url (nth 3 values)))
8154 (unless url
8155 (user-error "Nothing to follow at point"))
8156 (markdown--browse-url url)))))
8158 (defun markdown-do ()
8159 "Do something sensible based on context at point.
8160 Jumps between reference links and definitions; between footnote
8161 markers and footnote text."
8162 (interactive)
8163 (cond
8164 ;; Footnote definition
8165 ((markdown-footnote-text-positions)
8166 (markdown-footnote-return))
8167 ;; Footnote marker
8168 ((markdown-footnote-marker-positions)
8169 (markdown-footnote-goto-text))
8170 ;; Reference link
8171 ((thing-at-point-looking-at markdown-regex-link-reference)
8172 (markdown-reference-goto-definition))
8173 ;; Reference definition
8174 ((thing-at-point-looking-at markdown-regex-reference-definition)
8175 (markdown-reference-goto-link (match-string-no-properties 2)))
8176 ;; GFM task list item
8177 ((markdown-gfm-task-list-item-at-point)
8178 (markdown-toggle-gfm-checkbox))
8179 ;; Align table
8180 ((markdown-table-at-point-p)
8181 (call-interactively #'markdown-table-align))
8182 ;; Otherwise
8184 (markdown-insert-gfm-checkbox))))
8187 ;;; Miscellaneous =============================================================
8189 (defun markdown-compress-whitespace-string (str)
8190 "Compress whitespace in STR and return result.
8191 Leading and trailing whitespace is removed. Sequences of multiple
8192 spaces, tabs, and newlines are replaced with single spaces."
8193 (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
8194 (replace-regexp-in-string "[ \t\n]+" " " str)))
8196 (defun markdown--substitute-command-keys (string)
8197 "Like `substitute-command-keys' but, but prefers control characters.
8198 First pass STRING to `substitute-command-keys' and then
8199 substitute `C-i` for `TAB` and `C-m` for `RET`."
8200 (replace-regexp-in-string
8201 "\\<TAB\\>" "C-i"
8202 (replace-regexp-in-string
8203 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t))
8205 (defun markdown-line-number-at-pos (&optional pos)
8206 "Return (narrowed) buffer line number at position POS.
8207 If POS is nil, use current buffer location.
8208 This is an exact copy of `line-number-at-pos' for use in emacs21."
8209 (let ((opoint (or pos (point))) start)
8210 (save-excursion
8211 (goto-char (point-min))
8212 (setq start (point))
8213 (goto-char opoint)
8214 (forward-line 0)
8215 (1+ (count-lines start (point))))))
8217 (defun markdown-inside-link-p ()
8218 "Return t if point is within a link."
8219 (save-match-data
8220 (thing-at-point-looking-at (markdown-make-regex-link-generic))))
8222 (defun markdown-line-is-reference-definition-p ()
8223 "Return whether the current line is a (non-footnote) reference definition."
8224 (save-excursion
8225 (move-beginning-of-line 1)
8226 (and (looking-at-p markdown-regex-reference-definition)
8227 (not (looking-at-p "[ \t]*\\[^")))))
8229 (defun markdown-adaptive-fill-function ()
8230 "Return prefix for filling paragraph or nil if not determined."
8231 (cond
8232 ;; List item inside blockquote
8233 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
8234 (replace-regexp-in-string
8235 "[0-9\\.*+-]" " " (match-string-no-properties 0)))
8236 ;; Blockquote
8237 ((looking-at markdown-regex-blockquote)
8238 (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
8239 ;; List items
8240 ((looking-at markdown-regex-list)
8241 (match-string-no-properties 0))
8242 ;; Footnote definition
8243 ((looking-at-p markdown-regex-footnote-definition)
8244 " ") ; four spaces
8245 ;; No match
8246 (t nil)))
8248 (defun markdown-fill-paragraph (&optional justify)
8249 "Fill paragraph at or after point.
8250 This function is like \\[fill-paragraph], but it skips Markdown
8251 code blocks. If the point is in a code block, or just before one,
8252 do not fill. Otherwise, call `fill-paragraph' as usual. If
8253 JUSTIFY is non-nil, justify text as well. Since this function
8254 handles filling itself, it always returns t so that
8255 `fill-paragraph' doesn't run."
8256 (interactive "P")
8257 (unless (or (markdown-code-block-at-point-p)
8258 (save-excursion
8259 (back-to-indentation)
8260 (skip-syntax-forward "-")
8261 (markdown-code-block-at-point-p)))
8262 (let ((fill-prefix (save-excursion
8263 (goto-char (line-beginning-position))
8264 (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)")
8265 (match-string-no-properties 1)))))
8266 (fill-paragraph justify)))
8269 (defun markdown-fill-forward-paragraph (&optional arg)
8270 "Function used by `fill-paragraph' to move over ARG paragraphs.
8271 This is a `fill-forward-paragraph-function' for `markdown-mode'.
8272 It is called with a single argument specifying the number of
8273 paragraphs to move. Just like `forward-paragraph', it should
8274 return the number of paragraphs left to move."
8275 (or arg (setq arg 1))
8276 (if (> arg 0)
8277 ;; With positive ARG, move across ARG non-code-block paragraphs,
8278 ;; one at a time. When passing a code block, don't decrement ARG.
8279 (while (and (not (eobp))
8280 (> arg 0)
8281 (= (forward-paragraph 1) 0)
8282 (or (markdown-code-block-at-pos (point-at-bol 0))
8283 (setq arg (1- arg)))))
8284 ;; Move backward by one paragraph with negative ARG (always -1).
8285 (let ((start (point)))
8286 (setq arg (forward-paragraph arg))
8287 (while (and (not (eobp))
8288 (progn (move-to-left-margin) (not (eobp)))
8289 (looking-at-p paragraph-separate))
8290 (forward-line 1))
8291 (cond
8292 ;; Move point past whitespace following list marker.
8293 ((looking-at markdown-regex-list)
8294 (goto-char (match-end 0)))
8295 ;; Move point past whitespace following pipe at beginning of line
8296 ;; to handle Pandoc line blocks.
8297 ((looking-at "^|\\s-*")
8298 (goto-char (match-end 0)))
8299 ;; Return point if the paragraph passed was a code block.
8300 ((markdown-code-block-at-pos (point-at-bol 2))
8301 (goto-char start)))))
8302 arg)
8304 (defun markdown--inhibit-electric-quote ()
8305 "Function added to `electric-quote-inhibit-functions'.
8306 Return non-nil if the quote has been inserted inside a code block
8307 or span."
8308 (let ((pos (1- (point))))
8309 (or (markdown-inline-code-at-pos pos)
8310 (markdown-code-block-at-pos pos))))
8313 ;;; Extension Framework =======================================================
8315 (defun markdown-reload-extensions ()
8316 "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
8317 (interactive)
8318 (when (derived-mode-p 'markdown-mode)
8319 ;; Refontify buffer
8320 (font-lock-flush)
8321 ;; Add or remove hooks related to extensions
8322 (markdown-setup-wiki-link-hooks)))
8324 (defun markdown-handle-local-variables ()
8325 "Run in `hack-local-variables-hook' to update font lock rules.
8326 Checks to see if there is actually a ‘markdown-mode’ file local variable
8327 before regenerating font-lock rules for extensions."
8328 (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist)
8329 (assoc 'markdown-enable-math file-local-variables-alist))
8330 (when (assoc 'markdown-enable-math file-local-variables-alist)
8331 (markdown-toggle-math markdown-enable-math))
8332 (markdown-reload-extensions)))
8335 ;;; Math Support ==============================================================
8337 (defconst markdown-mode-font-lock-keywords-math
8338 (list
8339 ;; Equation reference (eq:foo)
8340 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face)
8341 (2 markdown-reference-face)
8342 (3 markdown-markup-face)))
8343 ;; Equation reference \eqref{foo}
8344 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face)
8345 (2 markdown-reference-face)
8346 (3 markdown-markup-face))))
8347 "Font lock keywords to add and remove when toggling math support.")
8349 (defun markdown-toggle-math (&optional arg)
8350 "Toggle support for inline and display LaTeX math expressions.
8351 With a prefix argument ARG, enable math mode if ARG is positive,
8352 and disable it otherwise. If called from Lisp, enable the mode
8353 if ARG is omitted or nil."
8354 (interactive (list (or current-prefix-arg 'toggle)))
8355 (setq markdown-enable-math
8356 (if (eq arg 'toggle)
8357 (not markdown-enable-math)
8358 (> (prefix-numeric-value arg) 0)))
8359 (if markdown-enable-math
8360 (progn
8361 (font-lock-add-keywords
8362 'markdown-mode markdown-mode-font-lock-keywords-math)
8363 (message "markdown-mode math support enabled"))
8364 (font-lock-remove-keywords
8365 'markdown-mode markdown-mode-font-lock-keywords-math)
8366 (message "markdown-mode math support disabled"))
8367 (markdown-reload-extensions))
8370 ;;; GFM Checkboxes ============================================================
8372 (define-button-type 'markdown-gfm-checkbox-button
8373 'follow-link t
8374 'face 'markdown-gfm-checkbox-face
8375 'mouse-face 'markdown-highlight-face
8376 'action #'markdown-toggle-gfm-checkbox-button)
8378 (defun markdown-gfm-task-list-item-at-point (&optional bounds)
8379 "Return non-nil if there is a GFM task list item at the point.
8380 Optionally, the list item BOUNDS may be given if available, as
8381 returned by `markdown-cur-list-item-bounds'. When a task list item
8382 is found, the return value is the same value returned by
8383 `markdown-cur-list-item-bounds'."
8384 (unless bounds
8385 (setq bounds (markdown-cur-list-item-bounds)))
8386 (> (length (nth 5 bounds)) 0))
8388 (defun markdown-insert-gfm-checkbox ()
8389 "Add GFM checkbox at point.
8390 Returns t if added.
8391 Returns nil if non-applicable."
8392 (interactive)
8393 (let ((bounds (markdown-cur-list-item-bounds)))
8394 (if bounds
8395 (unless (cl-sixth bounds)
8396 (let ((pos (+ (cl-first bounds) (cl-fourth bounds)))
8397 (markup "[ ] "))
8398 (if (< pos (point))
8399 (save-excursion
8400 (goto-char pos)
8401 (insert markup))
8402 (goto-char pos)
8403 (insert markup))
8404 (syntax-propertize (+ (cl-second bounds) 4))
8406 (unless (save-excursion
8407 (back-to-indentation)
8408 (or (markdown-list-item-at-point-p)
8409 (markdown-heading-at-point)
8410 (markdown-in-comment-p)
8411 (markdown-code-block-at-point-p)))
8412 (let ((pos (save-excursion
8413 (back-to-indentation)
8414 (point)))
8415 (markup (concat (or (save-excursion
8416 (beginning-of-line 0)
8417 (cl-fifth (markdown-cur-list-item-bounds)))
8418 markdown-unordered-list-item-prefix)
8419 "[ ] ")))
8420 (if (< pos (point))
8421 (save-excursion
8422 (goto-char pos)
8423 (insert markup))
8424 (goto-char pos)
8425 (insert markup))
8426 (syntax-propertize (point-at-eol))
8427 t)))))
8429 (defun markdown-toggle-gfm-checkbox ()
8430 "Toggle GFM checkbox at point.
8431 Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
8432 Returns nil if there is no task list item at the point."
8433 (interactive)
8434 (save-match-data
8435 (save-excursion
8436 (let ((bounds (markdown-cur-list-item-bounds)))
8437 (when bounds
8438 ;; Move to beginning of task list item
8439 (goto-char (cl-first bounds))
8440 ;; Advance to column of first non-whitespace after marker
8441 (forward-char (cl-fourth bounds))
8442 (cond ((looking-at "\\[ \\]")
8443 (replace-match
8444 (if markdown-gfm-uppercase-checkbox "[X]" "[x]")
8445 nil t)
8446 (match-string-no-properties 0))
8447 ((looking-at "\\[[xX]\\]")
8448 (replace-match "[ ]" nil t)
8449 (match-string-no-properties 0))))))))
8451 (defun markdown-toggle-gfm-checkbox-button (button)
8452 "Toggle GFM checkbox BUTTON on click."
8453 (save-match-data
8454 (save-excursion
8455 (goto-char (button-start button))
8456 (markdown-toggle-gfm-checkbox))))
8458 (defun markdown-make-gfm-checkboxes-buttons (start end)
8459 "Make GFM checkboxes buttons in region between START and END."
8460 (save-excursion
8461 (goto-char start)
8462 (let ((case-fold-search t))
8463 (save-excursion
8464 (while (re-search-forward markdown-regex-gfm-checkbox end t)
8465 (make-button (match-beginning 1) (match-end 1)
8466 :type 'markdown-gfm-checkbox-button))))))
8468 ;; Called when any modification is made to buffer text.
8469 (defun markdown-gfm-checkbox-after-change-function (beg end _)
8470 "Add to `after-change-functions' to setup GFM checkboxes as buttons.
8471 BEG and END are the limits of scanned region."
8472 (save-excursion
8473 (save-match-data
8474 ;; Rescan between start of line from `beg' and start of line after `end'.
8475 (markdown-make-gfm-checkboxes-buttons
8476 (progn (goto-char beg) (beginning-of-line) (point))
8477 (progn (goto-char end) (forward-line 1) (point))))))
8479 (defun markdown-remove-gfm-checkbox-overlays ()
8480 "Remove all GFM checkbox overlays in buffer."
8481 (save-excursion
8482 (save-restriction
8483 (widen)
8484 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face))))
8487 ;;; Display inline image ======================================================
8489 (defvar-local markdown-inline-image-overlays nil)
8491 (defun markdown-remove-inline-images ()
8492 "Remove inline image overlays from image links in the buffer.
8493 This can be toggled with `markdown-toggle-inline-images'
8494 or \\[markdown-toggle-inline-images]."
8495 (interactive)
8496 (mapc #'delete-overlay markdown-inline-image-overlays)
8497 (setq markdown-inline-image-overlays nil))
8499 (defcustom markdown-display-remote-images nil
8500 "If non-nil, download and display remote images.
8501 See also `markdown-inline-image-overlays'.
8503 Only image URLs specified with a protocol listed in
8504 `markdown-remote-image-protocols' are displayed."
8505 :group 'markdown
8506 :type 'boolean)
8508 (defcustom markdown-remote-image-protocols '("https")
8509 "List of protocols to use to download remote images.
8510 See also `markdown-display-remote-images'."
8511 :group 'markdown
8512 :type '(repeat string))
8514 (defvar markdown--remote-image-cache
8515 (make-hash-table :test 'equal)
8516 "A map from URLs to image paths.")
8518 (defun markdown--get-remote-image (url)
8519 "Retrieve the image path for a given URL."
8520 (or (gethash url markdown--remote-image-cache)
8521 (let ((dl-path (make-temp-file "markdown-mode--image")))
8522 (require 'url)
8523 (url-copy-file url dl-path t)
8524 (puthash url dl-path markdown--remote-image-cache))))
8526 (defun markdown-display-inline-images ()
8527 "Add inline image overlays to image links in the buffer.
8528 This can be toggled with `markdown-toggle-inline-images'
8529 or \\[markdown-toggle-inline-images]."
8530 (interactive)
8531 (unless (display-images-p)
8532 (error "Cannot show images"))
8533 (save-excursion
8534 (save-restriction
8535 (widen)
8536 (goto-char (point-min))
8537 (while (re-search-forward markdown-regex-link-inline nil t)
8538 (let* ((start (match-beginning 0))
8539 (imagep (match-beginning 1))
8540 (end (match-end 0))
8541 (file (match-string-no-properties 6)))
8542 (when (and imagep
8543 (not (zerop (length file))))
8544 (unless (file-exists-p file)
8545 (let* ((download-file (funcall markdown-translate-filename-function file))
8546 (valid-url (ignore-errors
8547 (member (downcase (url-type (url-generic-parse-url download-file)))
8548 markdown-remote-image-protocols))))
8549 (if (and markdown-display-remote-images valid-url)
8550 (setq file (markdown--get-remote-image download-file))
8551 (when (not valid-url)
8552 ;; strip query parameter
8553 (setq file (replace-regexp-in-string "?.+\\'" "" file))
8554 (unless (file-exists-p file)
8555 (setq file (url-unhex-string file)))))))
8556 (when (file-exists-p file)
8557 (let* ((abspath (if (file-name-absolute-p file)
8558 file
8559 (concat default-directory file)))
8560 (image
8561 (cond ((and markdown-max-image-size
8562 (image-type-available-p 'imagemagick))
8563 (create-image
8564 abspath 'imagemagick nil
8565 :max-width (car markdown-max-image-size)
8566 :max-height (cdr markdown-max-image-size)))
8567 (markdown-max-image-size
8568 (create-image abspath nil nil
8569 :max-width (car markdown-max-image-size)
8570 :max-height (cdr markdown-max-image-size)))
8571 (t (create-image abspath)))))
8572 (when image
8573 (let ((ov (make-overlay start end)))
8574 (overlay-put ov 'display image)
8575 (overlay-put ov 'face 'default)
8576 (push ov markdown-inline-image-overlays)))))))))))
8578 (defun markdown-toggle-inline-images ()
8579 "Toggle inline image overlays in the buffer."
8580 (interactive)
8581 (if markdown-inline-image-overlays
8582 (markdown-remove-inline-images)
8583 (markdown-display-inline-images)))
8586 ;;; GFM Code Block Fontification ==============================================
8588 (defcustom markdown-fontify-code-blocks-natively nil
8589 "When non-nil, fontify code in code blocks using the native major mode.
8590 This only works for fenced code blocks where the language is
8591 specified where we can automatically determine the appropriate
8592 mode to use. The language to mode mapping may be customized by
8593 setting the variable `markdown-code-lang-modes'."
8594 :group 'markdown
8595 :type 'boolean
8596 :safe 'booleanp
8597 :package-version '(markdown-mode . "2.3"))
8599 (defcustom markdown-fontify-code-block-default-mode nil
8600 "Default mode to use to fontify code blocks.
8601 This mode is used when automatic detection fails, such as for GFM
8602 code blocks with no language specified."
8603 :group 'markdown
8604 :type '(choice function (const :tag "None" nil))
8605 :package-version '(markdown-mode . "2.4"))
8607 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg)
8608 "Toggle the native fontification of code blocks.
8609 With a prefix argument ARG, enable if ARG is positive,
8610 and disable otherwise."
8611 (interactive (list (or current-prefix-arg 'toggle)))
8612 (setq markdown-fontify-code-blocks-natively
8613 (if (eq arg 'toggle)
8614 (not markdown-fontify-code-blocks-natively)
8615 (> (prefix-numeric-value arg) 0)))
8616 (if markdown-fontify-code-blocks-natively
8617 (message "markdown-mode native code block fontification enabled")
8618 (message "markdown-mode native code block fontification disabled"))
8619 (markdown-reload-extensions))
8621 ;; This is based on `org-src-lang-modes' from org-src.el
8622 (defcustom markdown-code-lang-modes
8623 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
8624 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
8625 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
8626 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
8627 ("bash" . sh-mode))
8628 "Alist mapping languages to their major mode.
8629 The key is the language name, the value is the major mode. For
8630 many languages this is simple, but for language where this is not
8631 the case, this variable provides a way to simplify things on the
8632 user side. For example, there is no ocaml-mode in Emacs, but the
8633 mode to use is `tuareg-mode'."
8634 :group 'markdown
8635 :type '(repeat
8636 (cons
8637 (string "Language name")
8638 (symbol "Major mode")))
8639 :package-version '(markdown-mode . "2.3"))
8641 (defun markdown-get-lang-mode (lang)
8642 "Return major mode that should be used for LANG.
8643 LANG is a string, and the returned major mode is a symbol."
8644 (cl-find-if
8645 'fboundp
8646 (list (cdr (assoc lang markdown-code-lang-modes))
8647 (cdr (assoc (downcase lang) markdown-code-lang-modes))
8648 (intern (concat lang "-mode"))
8649 (intern (concat (downcase lang) "-mode")))))
8651 (defun markdown-fontify-code-blocks-generic (matcher last)
8652 "Add text properties to next code block from point to LAST.
8653 Use matching function MATCHER."
8654 (when (funcall matcher last)
8655 (save-excursion
8656 (save-match-data
8657 (let* ((start (match-beginning 0))
8658 (end (match-end 0))
8659 ;; Find positions outside opening and closing backquotes.
8660 (bol-prev (progn (goto-char start)
8661 (if (bolp) (point-at-bol 0) (point-at-bol))))
8662 (eol-next (progn (goto-char end)
8663 (if (bolp) (point-at-bol 2) (point-at-bol 3))))
8664 lang)
8665 (if (and markdown-fontify-code-blocks-natively
8666 (or (setq lang (markdown-code-block-lang))
8667 markdown-fontify-code-block-default-mode))
8668 (markdown-fontify-code-block-natively lang start end)
8669 (add-text-properties start end '(face markdown-pre-face)))
8670 ;; Set background for block as well as opening and closing lines.
8671 (font-lock-append-text-property
8672 bol-prev eol-next 'face 'markdown-code-face)
8673 ;; Set invisible property for lines before and after, including newline.
8674 (add-text-properties bol-prev start '(invisible markdown-markup))
8675 (add-text-properties end eol-next '(invisible markdown-markup)))))
8678 (defun markdown-fontify-gfm-code-blocks (last)
8679 "Add text properties to next GFM code block from point to LAST."
8680 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last))
8682 (defun markdown-fontify-fenced-code-blocks (last)
8683 "Add text properties to next tilde fenced code block from point to LAST."
8684 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last))
8686 ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
8687 (defun markdown-fontify-code-block-natively (lang start end)
8688 "Fontify given GFM or fenced code block.
8689 This function is called by Emacs for automatic fontification when
8690 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
8691 language used in the block. START and END specify the block
8692 position."
8693 (let ((lang-mode (if lang (markdown-get-lang-mode lang)
8694 markdown-fontify-code-block-default-mode)))
8695 (when (fboundp lang-mode)
8696 (let ((string (buffer-substring-no-properties start end))
8697 (modified (buffer-modified-p))
8698 (markdown-buffer (current-buffer)) pos next)
8699 (remove-text-properties start end '(face nil))
8700 (with-current-buffer
8701 (get-buffer-create
8702 (concat " markdown-code-fontification:" (symbol-name lang-mode)))
8703 ;; Make sure that modification hooks are not inhibited in
8704 ;; the org-src-fontification buffer in case we're called
8705 ;; from `jit-lock-function' (Bug#25132).
8706 (let ((inhibit-modification-hooks nil))
8707 (delete-region (point-min) (point-max))
8708 (insert string " ")) ;; so there's a final property change
8709 (unless (eq major-mode lang-mode) (funcall lang-mode))
8710 (font-lock-ensure)
8711 (setq pos (point-min))
8712 (while (setq next (next-single-property-change pos 'face))
8713 (let ((val (get-text-property pos 'face)))
8714 (when val
8715 (put-text-property
8716 (+ start (1- pos)) (1- (+ start next)) 'face
8717 val markdown-buffer)))
8718 (setq pos next)))
8719 (add-text-properties
8720 start end
8721 '(font-lock-fontified t fontified t font-lock-multiline t))
8722 (set-buffer-modified-p modified)))))
8724 (require 'edit-indirect nil t)
8725 (defvar edit-indirect-guess-mode-function)
8726 (defvar edit-indirect-after-commit-functions)
8728 (defun markdown--edit-indirect-after-commit-function (beg end)
8729 "Corrective logic run on code block content from lines BEG to END.
8730 Restores code block indentation from BEG to END, and ensures trailing newlines
8731 at the END of code blocks."
8732 ;; ensure trailing newlines
8733 (goto-char end)
8734 (unless (eq (char-before) ?\n)
8735 (insert "\n"))
8736 ;; restore code block indentation
8737 (goto-char (- beg 1))
8738 (let ((block-indentation (current-indentation)))
8739 (when (> block-indentation 0)
8740 (indent-rigidly beg end block-indentation))))
8742 (defun markdown-edit-code-block ()
8743 "Edit Markdown code block in an indirect buffer."
8744 (interactive)
8745 (save-excursion
8746 (if (fboundp 'edit-indirect-region)
8747 (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
8748 (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2)))
8749 (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1))))
8750 (if (and begin end)
8751 (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation)))
8752 (lang (markdown-code-block-lang))
8753 (mode (or (and lang (markdown-get-lang-mode lang))
8754 markdown-edit-code-block-default-mode))
8755 (edit-indirect-guess-mode-function
8756 (lambda (_parent-buffer _beg _end)
8757 (funcall mode)))
8758 (indirect-buf (edit-indirect-region begin end 'display-buffer)))
8759 (when (> indentation 0) ;; un-indent in edit-indirect buffer
8760 (with-current-buffer indirect-buf
8761 (indent-rigidly (point-min) (point-max) (- indentation)))))
8762 (user-error "Not inside a GFM or tilde fenced code block")))
8763 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
8764 (progn (package-refresh-contents)
8765 (package-install 'edit-indirect)
8766 (markdown-edit-code-block))))))
8769 ;;; Table Editing =============================================================
8771 ;; These functions were originally adapted from `org-table.el'.
8773 ;; General helper functions
8775 (defmacro markdown--with-gensyms (symbols &rest body)
8776 (declare (debug (sexp body)) (indent 1))
8777 `(let ,(mapcar (lambda (s)
8778 `(,s (make-symbol (concat "--" (symbol-name ',s)))))
8779 symbols)
8780 ,@body))
8782 (defun markdown--split-string (string &optional separators)
8783 "Splits STRING into substrings at SEPARATORS.
8784 SEPARATORS is a regular expression. If nil it defaults to
8785 `split-string-default-separators'. This version returns no empty
8786 strings if there are matches at the beginning and end of string."
8787 (let ((start 0) notfirst list)
8788 (while (and (string-match
8789 (or separators split-string-default-separators)
8790 string
8791 (if (and notfirst
8792 (= start (match-beginning 0))
8793 (< start (length string)))
8794 (1+ start) start))
8795 (< (match-beginning 0) (length string)))
8796 (setq notfirst t)
8797 (or (eq (match-beginning 0) 0)
8798 (and (eq (match-beginning 0) (match-end 0))
8799 (eq (match-beginning 0) start))
8800 (push (substring string start (match-beginning 0)) list))
8801 (setq start (match-end 0)))
8802 (or (eq start (length string))
8803 (push (substring string start) list))
8804 (nreverse list)))
8806 (defun markdown--string-width (s)
8807 "Return width of string S.
8808 This version ignores characters with invisibility property
8809 `markdown-markup'."
8810 (let (b)
8811 (when (or (eq t buffer-invisibility-spec)
8812 (member 'markdown-markup buffer-invisibility-spec))
8813 (while (setq b (text-property-any
8814 0 (length s)
8815 'invisible 'markdown-markup s))
8816 (setq s (concat
8817 (substring s 0 b)
8818 (substring s (or (next-single-property-change
8819 b 'invisible s)
8820 (length s))))))))
8821 (string-width s))
8823 (defun markdown--remove-invisible-markup (s)
8824 "Remove Markdown markup from string S.
8825 This version removes characters with invisibility property
8826 `markdown-markup'."
8827 (let (b)
8828 (while (setq b (text-property-any
8829 0 (length s)
8830 'invisible 'markdown-markup s))
8831 (setq s (concat
8832 (substring s 0 b)
8833 (substring s (or (next-single-property-change
8834 b 'invisible s)
8835 (length s)))))))
8838 ;; Functions for maintaining tables
8840 (defvar markdown-table-at-point-p-function nil
8841 "Function to decide if point is inside a table.
8843 The indirection serves to differentiate between standard markdown
8844 tables and gfm tables which are less strict about the markup.")
8846 (defconst markdown-table-line-regexp "^[ \t]*|"
8847 "Regexp matching any line inside a table.")
8849 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]"
8850 "Regexp matching hline inside a table.")
8852 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]"
8853 "Regexp matching dline inside a table.")
8855 (defun markdown-table-at-point-p ()
8856 "Return non-nil when point is inside a table."
8857 (if (functionp markdown-table-at-point-p-function)
8858 (funcall markdown-table-at-point-p-function)
8859 (markdown--table-at-point-p)))
8861 (defun markdown--table-at-point-p ()
8862 "Return non-nil when point is inside a table."
8863 (save-excursion
8864 (beginning-of-line)
8865 (and (looking-at-p markdown-table-line-regexp)
8866 (not (markdown-code-block-at-point-p)))))
8868 (defconst gfm-table-line-regexp "^.?*|"
8869 "Regexp matching any line inside a table.")
8871 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+"
8872 "Regexp matching hline inside a table.")
8874 ;; GFM simplified tables syntax is as follows:
8875 ;; - A header line for the column names, this is any text
8876 ;; separated by `|'.
8877 ;; - Followed by a string -|-|- ..., the number of dashes is optional
8878 ;; but must be higher than 1. The number of separators should match
8879 ;; the number of columns.
8880 ;; - Followed by the rows of data, which has the same format as the
8881 ;; header line.
8882 ;; Example:
8884 ;; foo | bar
8885 ;; ------|---------
8886 ;; bar | baz
8887 ;; bar | baz
8888 (defun gfm--table-at-point-p ()
8889 "Return non-nil when point is inside a gfm-compatible table."
8890 (or (markdown--table-at-point-p)
8891 (save-excursion
8892 (beginning-of-line)
8893 (when (looking-at-p gfm-table-line-regexp)
8894 ;; we might be at the first line of the table, check if the
8895 ;; line below is the hline
8896 (or (save-excursion
8897 (forward-line 1)
8898 (looking-at-p gfm-table-hline-regexp))
8899 ;; go up to find the header
8900 (catch 'done
8901 (while (looking-at-p gfm-table-line-regexp)
8902 (cond
8903 ((looking-at-p gfm-table-hline-regexp)
8904 (throw 'done t))
8905 ((bobp)
8906 (throw 'done nil)))
8907 (forward-line -1))
8908 nil))))))
8910 (defun markdown-table-hline-at-point-p ()
8911 "Return non-nil when point is on a hline in a table.
8912 This function assumes point is on a table."
8913 (save-excursion
8914 (beginning-of-line)
8915 (looking-at-p markdown-table-hline-regexp)))
8917 (defun markdown-table-begin ()
8918 "Find the beginning of the table and return its position.
8919 This function assumes point is on a table."
8920 (save-excursion
8921 (while (and (not (bobp))
8922 (markdown-table-at-point-p))
8923 (forward-line -1))
8924 (unless (or (eobp)
8925 (markdown-table-at-point-p))
8926 (forward-line 1))
8927 (point)))
8929 (defun markdown-table-end ()
8930 "Find the end of the table and return its position.
8931 This function assumes point is on a table."
8932 (save-excursion
8933 (while (and (not (eobp))
8934 (markdown-table-at-point-p))
8935 (forward-line 1))
8936 (point)))
8938 (defun markdown-table-get-dline ()
8939 "Return index of the table data line at point.
8940 This function assumes point is on a table."
8941 (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
8942 (save-excursion
8943 (goto-char (markdown-table-begin))
8944 (while (and (re-search-forward
8945 markdown-table-dline-regexp end t)
8946 (setq cnt (1+ cnt))
8947 (< (point-at-eol) pos))))
8948 cnt))
8950 (defun markdown--thing-at-wiki-link (pos)
8951 (when markdown-enable-wiki-links
8952 (save-excursion
8953 (save-match-data
8954 (goto-char pos)
8955 (thing-at-point-looking-at markdown-regex-wiki-link)))))
8957 (defun markdown-table-get-column ()
8958 "Return table column at point.
8959 This function assumes point is on a table."
8960 (let ((pos (point)) (cnt 0))
8961 (save-excursion
8962 (beginning-of-line)
8963 (while (search-forward "|" pos t)
8964 (unless (markdown--thing-at-wiki-link (match-beginning 0))
8965 (setq cnt (1+ cnt)))))
8966 cnt))
8968 (defun markdown-table-get-cell (&optional n)
8969 "Return the content of the cell in column N of current row.
8970 N defaults to column at point. This function assumes point is on
8971 a table."
8972 (and n (markdown-table-goto-column n))
8973 (skip-chars-backward "^|\n") (backward-char 1)
8974 (if (looking-at "|[^|\r\n]*")
8975 (let* ((pos (match-beginning 0))
8976 (val (buffer-substring (1+ pos) (match-end 0))))
8977 (goto-char (min (point-at-eol) (+ 2 pos)))
8978 ;; Trim whitespaces
8979 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val)
8980 val (replace-regexp-in-string "[ \t]+\\'" "" val)))
8981 (forward-char 1) ""))
8983 (defun markdown-table-goto-dline (n)
8984 "Go to the Nth data line in the table at point.
8985 Return t when the line exists, nil otherwise. This function
8986 assumes point is on a table."
8987 (goto-char (markdown-table-begin))
8988 (let ((end (markdown-table-end)) (cnt 0))
8989 (while (and (re-search-forward
8990 markdown-table-dline-regexp end t)
8991 (< (setq cnt (1+ cnt)) n)))
8992 (= cnt n)))
8994 (defun markdown-table-goto-column (n &optional on-delim)
8995 "Go to the Nth column in the table line at point.
8996 With optional argument ON-DELIM, stop with point before the left
8997 delimiter of the cell. If there are less than N cells, just go
8998 beyond the last delimiter. This function assumes point is on a
8999 table."
9000 (beginning-of-line 1)
9001 (when (> n 0)
9002 (while (and (> n 0) (search-forward "|" (point-at-eol) t))
9003 (unless (markdown--thing-at-wiki-link (match-beginning 0))
9004 (cl-decf n)))
9005 (if on-delim
9006 (backward-char 1)
9007 (when (looking-at " ") (forward-char 1)))))
9009 (defmacro markdown-table-save-cell (&rest body)
9010 "Save cell at point, execute BODY and restore cell.
9011 This function assumes point is on a table."
9012 (declare (debug (body)))
9013 (markdown--with-gensyms (line column)
9014 `(let ((,line (copy-marker (line-beginning-position)))
9015 (,column (markdown-table-get-column)))
9016 (unwind-protect
9017 (progn ,@body)
9018 (goto-char ,line)
9019 (markdown-table-goto-column ,column)
9020 (set-marker ,line nil)))))
9022 (defun markdown-table-blank-line (s)
9023 "Convert a table line S into a line with blank cells."
9024 (if (string-match "^[ \t]*|-" s)
9025 (setq s (mapconcat
9026 (lambda (x) (if (member x '(?| ?+)) "|" " "))
9027 s ""))
9028 (with-temp-buffer
9029 (insert s)
9030 (goto-char (point-min))
9031 (when (re-search-forward "|" nil t)
9032 (let ((cur (point))
9033 ret)
9034 (while (re-search-forward "|" nil t)
9035 (when (and (not (eql (char-before (match-beginning 0)) ?\\))
9036 (not (markdown--thing-at-wiki-link (match-beginning 0))))
9037 (push (make-string (- (match-beginning 0) cur) ? ) ret)
9038 (setq cur (match-end 0))))
9039 (format "|%s|" (string-join (nreverse ret) "|")))))))
9041 (defun markdown-table-colfmt (fmtspec)
9042 "Process column alignment specifier FMTSPEC for tables."
9043 (when (stringp fmtspec)
9044 (mapcar (lambda (x)
9045 (cond ((string-match-p "^:.*:$" x) 'c)
9046 ((string-match-p "^:" x) 'l)
9047 ((string-match-p ":$" x) 'r)
9048 (t 'd)))
9049 (markdown--split-string fmtspec "\\s-*|\\s-*"))))
9051 (defun markdown--first-column-p (bar-pos)
9052 (save-excursion
9053 (save-match-data
9054 (goto-char bar-pos)
9055 (looking-back "^\\s-*" (line-beginning-position)))))
9057 (defun markdown--table-line-to-columns (line)
9058 (with-temp-buffer
9059 (insert line)
9060 (goto-char (point-min))
9061 (let ((cur (point))
9062 ret)
9063 (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)
9064 (if (markdown--first-column-p (match-beginning 1))
9065 (setq cur (match-end 0))
9066 (cond ((eql (char-before (match-beginning 1)) ?\\)
9067 ;; keep spaces
9068 (goto-char (match-end 1)))
9069 ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing
9071 (push (buffer-substring-no-properties cur (match-beginning 0)) ret)
9072 (setq cur (match-end 0))))))
9073 (when (< cur (length line))
9074 (push (buffer-substring-no-properties cur (point-max)) ret))
9075 (nreverse ret))))
9077 (defun markdown-table-align ()
9078 "Align table at point.
9079 This function assumes point is on a table."
9080 (interactive)
9081 (let ((begin (markdown-table-begin))
9082 (end (copy-marker (markdown-table-end))))
9083 (markdown-table-save-cell
9084 (goto-char begin)
9085 (let* (fmtspec
9086 ;; Store table indent
9087 (indent (progn (looking-at "[ \t]*") (match-string 0)))
9088 ;; Split table in lines and save column format specifier
9089 (lines (mapcar (lambda (l)
9090 (if (string-match-p "\\`[ \t]*|[ \t]*[-:]" l)
9091 (progn (setq fmtspec (or fmtspec l)) nil) l))
9092 (markdown--split-string (buffer-substring begin end) "\n")))
9093 ;; Split lines in cells
9094 (cells (mapcar (lambda (l) (markdown--table-line-to-columns l))
9095 (remq nil lines)))
9096 ;; Calculate maximum number of cells in a line
9097 (maxcells (if cells
9098 (apply #'max (mapcar #'length cells))
9099 (user-error "Empty table")))
9100 ;; Empty cells to fill short lines
9101 (emptycells (make-list maxcells ""))
9102 maxwidths)
9103 ;; Calculate maximum width for each column
9104 (dotimes (i maxcells)
9105 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells)))
9106 (push (apply #'max 1 (mapcar #'markdown--string-width column))
9107 maxwidths)))
9108 (setq maxwidths (nreverse maxwidths))
9109 ;; Process column format specifier
9110 (setq fmtspec (markdown-table-colfmt fmtspec))
9111 ;; Compute formats needed for output of table lines
9112 (let ((hfmt (concat indent "|"))
9113 (rfmt (concat indent "|"))
9114 hfmt1 rfmt1 fmt)
9115 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|")))
9116 (setq fmt (pop fmtspec))
9117 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |"))
9118 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |"))
9119 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |"))
9120 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |")))
9121 (setq rfmt (concat rfmt (format rfmt1 width)))
9122 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-)))))
9123 ;; Replace modified lines only
9124 (dolist (line lines)
9125 (let ((line (if line
9126 (apply #'format rfmt (append (pop cells) emptycells))
9127 hfmt))
9128 (previous (buffer-substring (point) (line-end-position))))
9129 (if (equal previous line)
9130 (forward-line)
9131 (insert line "\n")
9132 (delete-region (point) (line-beginning-position 2))))))
9133 (set-marker end nil)))))
9135 (defun markdown-table-insert-row (&optional arg)
9136 "Insert a new row above the row at point into the table.
9137 With optional argument ARG, insert below the current row."
9138 (interactive "P")
9139 (unless (markdown-table-at-point-p)
9140 (user-error "Not at a table"))
9141 (let* ((line (buffer-substring
9142 (line-beginning-position) (line-end-position)))
9143 (new (markdown-table-blank-line line)))
9144 (beginning-of-line (if arg 2 1))
9145 (unless (bolp) (insert "\n"))
9146 (insert-before-markers new "\n")
9147 (beginning-of-line 0)
9148 (re-search-forward "| ?" (line-end-position) t)))
9150 (defun markdown-table-delete-row ()
9151 "Delete row or horizontal line at point from the table."
9152 (interactive)
9153 (unless (markdown-table-at-point-p)
9154 (user-error "Not at a table"))
9155 (let ((col (current-column)))
9156 (kill-region (point-at-bol)
9157 (min (1+ (point-at-eol)) (point-max)))
9158 (unless (markdown-table-at-point-p) (beginning-of-line 0))
9159 (move-to-column col)))
9161 (defun markdown-table-move-row (&optional up)
9162 "Move table line at point down.
9163 With optional argument UP, move it up."
9164 (interactive "P")
9165 (unless (markdown-table-at-point-p)
9166 (user-error "Not at a table"))
9167 (let* ((col (current-column)) (pos (point))
9168 (tonew (if up 0 2)) txt)
9169 (beginning-of-line tonew)
9170 (unless (markdown-table-at-point-p)
9171 (goto-char pos) (user-error "Cannot move row further"))
9172 (goto-char pos) (beginning-of-line 1) (setq pos (point))
9173 (setq txt (buffer-substring (point) (1+ (point-at-eol))))
9174 (delete-region (point) (1+ (point-at-eol)))
9175 (beginning-of-line tonew)
9176 (insert txt) (beginning-of-line 0)
9177 (move-to-column col)))
9179 (defun markdown-table-move-row-up ()
9180 "Move table row at point up."
9181 (interactive)
9182 (markdown-table-move-row 'up))
9184 (defun markdown-table-move-row-down ()
9185 "Move table row at point down."
9186 (interactive)
9187 (markdown-table-move-row nil))
9189 (defun markdown-table-insert-column ()
9190 "Insert a new table column."
9191 (interactive)
9192 (unless (markdown-table-at-point-p)
9193 (user-error "Not at a table"))
9194 (let* ((col (max 1 (markdown-table-get-column)))
9195 (begin (markdown-table-begin))
9196 (end (copy-marker (markdown-table-end))))
9197 (markdown-table-save-cell
9198 (goto-char begin)
9199 (while (< (point) end)
9200 (markdown-table-goto-column col t)
9201 (if (markdown-table-hline-at-point-p)
9202 (insert "|---")
9203 (insert "| "))
9204 (forward-line)))
9205 (set-marker end nil)
9206 (markdown-table-align)))
9208 (defun markdown-table-delete-column ()
9209 "Delete column at point from table."
9210 (interactive)
9211 (unless (markdown-table-at-point-p)
9212 (user-error "Not at a table"))
9213 (let ((col (markdown-table-get-column))
9214 (begin (markdown-table-begin))
9215 (end (copy-marker (markdown-table-end))))
9216 (markdown-table-save-cell
9217 (goto-char begin)
9218 (while (< (point) end)
9219 (markdown-table-goto-column col t)
9220 (and (looking-at "|[^|\n]+|")
9221 (replace-match "|"))
9222 (forward-line)))
9223 (set-marker end nil)
9224 (markdown-table-goto-column (max 1 (1- col)))
9225 (markdown-table-align)))
9227 (defun markdown-table-move-column (&optional left)
9228 "Move table column at point to the right.
9229 With optional argument LEFT, move it to the left."
9230 (interactive "P")
9231 (unless (markdown-table-at-point-p)
9232 (user-error "Not at a table"))
9233 (let* ((col (markdown-table-get-column))
9234 (col1 (if left (1- col) col))
9235 (colpos (if left (1- col) (1+ col)))
9236 (begin (markdown-table-begin))
9237 (end (copy-marker (markdown-table-end))))
9238 (when (and left (= col 1))
9239 (user-error "Cannot move column further left"))
9240 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
9241 (user-error "Cannot move column further right"))
9242 (markdown-table-save-cell
9243 (goto-char begin)
9244 (while (< (point) end)
9245 (markdown-table-goto-column col1 t)
9246 (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
9247 (replace-match "|\\2|\\1|"))
9248 (forward-line)))
9249 (set-marker end nil)
9250 (markdown-table-goto-column colpos)
9251 (markdown-table-align)))
9253 (defun markdown-table-move-column-left ()
9254 "Move table column at point to the left."
9255 (interactive)
9256 (markdown-table-move-column 'left))
9258 (defun markdown-table-move-column-right ()
9259 "Move table column at point to the right."
9260 (interactive)
9261 (markdown-table-move-column nil))
9263 (defun markdown-table-next-row ()
9264 "Go to the next row (same column) in the table.
9265 Create new table lines if required."
9266 (interactive)
9267 (unless (markdown-table-at-point-p)
9268 (user-error "Not at a table"))
9269 (if (or (looking-at "[ \t]*$")
9270 (save-excursion (skip-chars-backward " \t") (bolp)))
9271 (newline)
9272 (markdown-table-align)
9273 (let ((col (markdown-table-get-column)))
9274 (beginning-of-line 2)
9275 (if (or (not (markdown-table-at-point-p))
9276 (markdown-table-hline-at-point-p))
9277 (progn
9278 (beginning-of-line 0)
9279 (markdown-table-insert-row 'below)))
9280 (markdown-table-goto-column col)
9281 (skip-chars-backward "^|\n\r")
9282 (when (looking-at " ") (forward-char 1)))))
9284 (defun markdown-table-forward-cell ()
9285 "Go to the next cell in the table.
9286 Create new table lines if required."
9287 (interactive)
9288 (unless (markdown-table-at-point-p)
9289 (user-error "Not at a table"))
9290 (markdown-table-align)
9291 (let ((end (markdown-table-end)))
9292 (when (markdown-table-hline-at-point-p) (end-of-line 1))
9293 (condition-case nil
9294 (progn
9295 (re-search-forward "\\(?:^\\|[^\\]\\)|" end)
9296 (when (looking-at "[ \t]*$")
9297 (re-search-forward "\\(?:^\\|[^\\]:\\)|" end))
9298 (when (and (looking-at "[-:]")
9299 (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t))
9300 (goto-char (match-beginning 1)))
9301 (if (looking-at "[-:]")
9302 (progn
9303 (beginning-of-line 0)
9304 (markdown-table-insert-row 'below))
9305 (when (looking-at " ") (forward-char 1))))
9306 (error (markdown-table-insert-row 'below)))))
9308 (defun markdown-table-backward-cell ()
9309 "Go to the previous cell in the table."
9310 (interactive)
9311 (unless (markdown-table-at-point-p)
9312 (user-error "Not at a table"))
9313 (markdown-table-align)
9314 (when (markdown-table-hline-at-point-p) (beginning-of-line 1))
9315 (condition-case nil
9316 (progn
9317 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))
9318 ;; When this function is called while in the first cell in a
9319 ;; table, the point will now be at the beginning of a line. In
9320 ;; this case, we need to move past one additional table
9321 ;; boundary, the end of the table on the previous line.
9322 (when (= (point) (line-beginning-position))
9323 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
9324 (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
9325 (error (user-error "Cannot move to previous table cell")))
9326 (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0)))
9328 ;; This may have dropped point on the hline.
9329 (when (markdown-table-hline-at-point-p)
9330 (markdown-table-backward-cell)))
9332 (defun markdown-table-transpose ()
9333 "Transpose table at point.
9334 Horizontal separator lines will be eliminated."
9335 (interactive)
9336 (unless (markdown-table-at-point-p)
9337 (user-error "Not at a table"))
9338 (let* ((table (buffer-substring-no-properties
9339 (markdown-table-begin) (markdown-table-end)))
9340 ;; Convert table to Lisp structure
9341 (table (delq nil
9342 (mapcar
9343 (lambda (x)
9344 (unless (string-match-p
9345 markdown-table-hline-regexp x)
9346 (markdown--table-line-to-columns x)))
9347 (markdown--split-string table "[ \t]*\n[ \t]*"))))
9348 (dline_old (markdown-table-get-dline))
9349 (col_old (markdown-table-get-column))
9350 (contents (mapcar (lambda (_)
9351 (let ((tp table))
9352 (mapcar
9353 (lambda (_)
9354 (prog1
9355 (pop (car tp))
9356 (setq tp (cdr tp))))
9357 table)))
9358 (car table))))
9359 (goto-char (markdown-table-begin))
9360 (save-excursion
9361 (re-search-forward "|") (backward-char)
9362 (delete-region (point) (markdown-table-end))
9363 (insert (mapconcat
9364 (lambda(x)
9365 (concat "| " (mapconcat 'identity x " | " ) " |\n"))
9366 contents "")))
9367 (markdown-table-goto-dline col_old)
9368 (markdown-table-goto-column dline_old))
9369 (markdown-table-align))
9371 (defun markdown-table-sort-lines (&optional sorting-type)
9372 "Sort table lines according to the column at point.
9374 The position of point indicates the column to be used for
9375 sorting, and the range of lines is the range between the nearest
9376 horizontal separator lines, or the entire table of no such lines
9377 exist. If point is before the first column, user will be prompted
9378 for the sorting column. If there is an active region, the mark
9379 specifies the first line and the sorting column, while point
9380 should be in the last line to be included into the sorting.
9382 The command then prompts for the sorting type which can be
9383 alphabetically or numerically. Sorting in reverse order is also
9384 possible.
9386 If SORTING-TYPE is specified when this function is called from a
9387 Lisp program, no prompting will take place. SORTING-TYPE must be
9388 a character, any of (?a ?A ?n ?N) where the capital letters
9389 indicate that sorting should be done in reverse order."
9390 (interactive)
9391 (unless (markdown-table-at-point-p)
9392 (user-error "Not at a table"))
9393 ;; Set sorting type and column used for sorting
9394 (let ((column (let ((c (markdown-table-get-column)))
9395 (cond ((> c 0) c)
9396 ((called-interactively-p 'any)
9397 (read-number "Use column N for sorting: "))
9398 (t 1))))
9399 (sorting-type
9400 (or sorting-type
9401 (read-char-exclusive
9402 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))
9403 (save-restriction
9404 ;; Narrow buffer to appropriate sorting area
9405 (if (region-active-p)
9406 (narrow-to-region
9407 (save-excursion
9408 (progn
9409 (goto-char (region-beginning)) (line-beginning-position)))
9410 (save-excursion
9411 (progn
9412 (goto-char (region-end)) (line-end-position))))
9413 (let ((start (markdown-table-begin))
9414 (end (markdown-table-end)))
9415 (narrow-to-region
9416 (save-excursion
9417 (if (re-search-backward
9418 markdown-table-hline-regexp start t)
9419 (line-beginning-position 2)
9420 start))
9421 (if (save-excursion (re-search-forward
9422 markdown-table-hline-regexp end t))
9423 (match-beginning 0)
9424 end))))
9425 ;; Determine arguments for `sort-subr'
9426 (let* ((extract-key-from-cell
9427 (cl-case sorting-type
9428 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity)
9429 ((?n ?N) #'string-to-number)
9430 (t (user-error "Invalid sorting type: %c" sorting-type))))
9431 (predicate
9432 (cl-case sorting-type
9433 ((?n ?N) #'<)
9434 ((?a ?A) #'string<))))
9435 ;; Sort selected area
9436 (goto-char (point-min))
9437 (sort-subr (memq sorting-type '(?A ?N))
9438 (lambda ()
9439 (forward-line)
9440 (while (and (not (eobp))
9441 (not (looking-at
9442 markdown-table-dline-regexp)))
9443 (forward-line)))
9444 #'end-of-line
9445 (lambda ()
9446 (funcall extract-key-from-cell
9447 (markdown-table-get-cell column)))
9449 predicate)
9450 (goto-char (point-min))))))
9452 (defun markdown-table-convert-region (begin end &optional separator)
9453 "Convert region from BEGIN to END to table with SEPARATOR.
9455 If every line contains at least one TAB character, the function
9456 assumes that the material is tab separated (TSV). If every line
9457 contains a comma, comma-separated values (CSV) are assumed. If
9458 not, lines are split at whitespace into cells.
9460 You can use a prefix argument to force a specific separator:
9461 \\[universal-argument] once forces CSV, \\[universal-argument]
9462 twice forces TAB, and \\[universal-argument] three times will
9463 prompt for a regular expression to match the separator, and a
9464 numeric argument N indicates that at least N consecutive
9465 spaces, or alternatively a TAB should be used as the separator."
9467 (interactive "r\nP")
9468 (let* ((begin (min begin end)) (end (max begin end)) re)
9469 (goto-char begin) (beginning-of-line 1)
9470 (setq begin (point-marker))
9471 (goto-char end)
9472 (if (bolp) (backward-char 1) (end-of-line 1))
9473 (setq end (point-marker))
9474 (when (equal separator '(64))
9475 (setq separator (read-regexp "Regexp for cell separator: ")))
9476 (unless separator
9477 ;; Get the right cell separator
9478 (goto-char begin)
9479 (setq separator
9480 (cond
9481 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
9482 ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
9483 (t 1))))
9484 (goto-char begin)
9485 (if (equal separator '(4))
9486 ;; Parse CSV
9487 (while (< (point) end)
9488 (cond
9489 ((looking-at "^") (insert "| "))
9490 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
9491 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
9492 (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
9493 ((looking-at "[^,\n]+") (goto-char (match-end 0)))
9494 ((looking-at "[ \t]*,") (replace-match " | "))
9495 (t (beginning-of-line 2))))
9496 (setq re
9497 (cond
9498 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
9499 ((equal separator '(16)) "^\\|\t")
9500 ((integerp separator)
9501 (if (< separator 1)
9502 (user-error "Cell separator must contain one or more spaces")
9503 (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
9504 ((stringp separator) (format "^ *\\|%s" separator))
9505 (t (error "Invalid cell separator"))))
9506 (while (re-search-forward re end t) (replace-match "| " t t)))
9507 (goto-char begin)
9508 (markdown-table-align)))
9510 (defun markdown-insert-table (&optional rows columns align)
9511 "Insert an empty pipe table.
9512 Optional arguments ROWS, COLUMNS, and ALIGN specify number of
9513 rows and columns and the column alignment."
9514 (interactive)
9515 (let* ((rows (or rows (string-to-number (read-string "Row size: "))))
9516 (columns (or columns (string-to-number (read-string "Column size: "))))
9517 (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): ")))
9518 (align (cond ((equal align "l") ":--")
9519 ((equal align "r") "--:")
9520 ((equal align "c") ":-:")
9521 (t "---")))
9522 (pos (point))
9523 (indent (make-string (current-column) ?\ ))
9524 (line (concat
9525 (apply 'concat indent "|"
9526 (make-list columns " |")) "\n"))
9527 (hline (apply 'concat indent "|"
9528 (make-list columns (concat align "|")))))
9529 (if (string-match
9530 "^[ \t]*$" (buffer-substring-no-properties
9531 (point-at-bol) (point)))
9532 (beginning-of-line 1)
9533 (newline))
9534 (dotimes (_ rows) (insert line))
9535 (goto-char pos)
9536 (if (> rows 1)
9537 (progn
9538 (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos)))
9539 (markdown-table-forward-cell)))
9542 ;;; ElDoc Support =============================================================
9544 (defun markdown-eldoc-function ()
9545 "Return a helpful string when appropriate based on context.
9546 * Report URL when point is at a hidden URL.
9547 * Report language name when point is a code block with hidden markup."
9548 (cond
9549 ;; Hidden URL or reference for inline link
9550 ((and (or (thing-at-point-looking-at markdown-regex-link-inline)
9551 (thing-at-point-looking-at markdown-regex-link-reference))
9552 (or markdown-hide-urls markdown-hide-markup))
9553 (let* ((imagep (string-equal (match-string 1) "!"))
9554 (edit-keys (markdown--substitute-command-keys
9555 (if imagep
9556 "\\[markdown-insert-image]"
9557 "\\[markdown-insert-link]")))
9558 (edit-str (propertize edit-keys 'face 'font-lock-constant-face))
9559 (referencep (string-equal (match-string 5) "["))
9560 (object (if referencep "reference" "URL")))
9561 (format "Hidden %s (%s to edit): %s" object edit-str
9562 (if referencep
9563 (concat
9564 (propertize "[" 'face 'markdown-markup-face)
9565 (propertize (match-string-no-properties 6)
9566 'face 'markdown-reference-face)
9567 (propertize "]" 'face 'markdown-markup-face))
9568 (propertize (match-string-no-properties 6)
9569 'face 'markdown-url-face)))))
9570 ;; Hidden language name for fenced code blocks
9571 ((and (markdown-code-block-at-point-p)
9572 (not (get-text-property (point) 'markdown-pre))
9573 markdown-hide-markup)
9574 (let ((lang (save-excursion (markdown-code-block-lang))))
9575 (unless lang (setq lang "[unspecified]"))
9576 (format "Hidden code block language: %s (%s to toggle markup)"
9577 (propertize lang 'face 'markdown-language-keyword-face)
9578 (markdown--substitute-command-keys
9579 "\\[markdown-toggle-markup-hiding]"))))))
9582 ;;; Mode Definition ==========================================================
9584 (defun markdown-show-version ()
9585 "Show the version number in the minibuffer."
9586 (interactive)
9587 (message "markdown-mode, version %s" markdown-mode-version))
9589 (defun markdown-mode-info ()
9590 "Open the `markdown-mode' homepage."
9591 (interactive)
9592 (browse-url "https://jblevins.org/projects/markdown-mode/"))
9594 ;;;###autoload
9595 (define-derived-mode markdown-mode text-mode "Markdown"
9596 "Major mode for editing Markdown files."
9597 ;; Natural Markdown tab width
9598 (setq tab-width 4)
9599 ;; Comments
9600 (setq-local comment-start "<!-- ")
9601 (setq-local comment-end " -->")
9602 (setq-local comment-start-skip "<!--[ \t]*")
9603 (setq-local comment-column 0)
9604 (setq-local comment-auto-fill-only-comments nil)
9605 (setq-local comment-use-syntax t)
9606 ;; Sentence
9607 (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*")
9608 ;; Syntax
9609 (add-hook 'syntax-propertize-extend-region-functions
9610 #'markdown-syntax-propertize-extend-region)
9611 (add-hook 'jit-lock-after-change-extend-region-functions
9612 #'markdown-font-lock-extend-region-function t t)
9613 (setq-local syntax-propertize-function #'markdown-syntax-propertize)
9614 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
9615 ;; Font lock.
9616 (setq font-lock-defaults
9617 '(markdown-mode-font-lock-keywords
9618 nil nil nil nil
9619 (font-lock-multiline . t)
9620 (font-lock-syntactic-face-function . markdown-syntactic-face)
9621 (font-lock-extra-managed-props
9622 . (composition display invisible rear-nonsticky
9623 keymap help-echo mouse-face))))
9624 (if markdown-hide-markup
9625 (add-to-invisibility-spec 'markdown-markup)
9626 (remove-from-invisibility-spec 'markdown-markup))
9627 ;; Wiki links
9628 (markdown-setup-wiki-link-hooks)
9629 ;; Math mode
9630 (when markdown-enable-math (markdown-toggle-math t))
9631 ;; Add a buffer-local hook to reload after file-local variables are read
9632 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t)
9633 ;; For imenu support
9634 (setq imenu-create-index-function
9635 (if markdown-nested-imenu-heading-index
9636 #'markdown-imenu-create-nested-index
9637 #'markdown-imenu-create-flat-index))
9639 ;; Defun movement
9640 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun)
9641 (setq-local end-of-defun-function #'markdown-end-of-defun)
9642 ;; Paragraph filling
9643 (setq-local fill-paragraph-function #'markdown-fill-paragraph)
9644 (setq-local paragraph-start
9645 ;; Should match start of lines that start or separate paragraphs
9646 (mapconcat #'identity
9648 "\f" ; starts with a literal line-feed
9649 "[ \t\f]*$" ; space-only line
9650 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9651 "[ \t]*[*+-][ \t]+" ; unordered list item
9652 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
9653 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
9654 "[ \t]*:[ \t]+" ; definition
9655 "^|" ; table or Pandoc line block
9657 "\\|"))
9658 (setq-local paragraph-separate
9659 ;; Should match lines that separate paragraphs without being
9660 ;; part of any paragraph:
9661 (mapconcat #'identity
9662 '("[ \t\f]*$" ; space-only line
9663 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9664 ;; The following is not ideal, but the Fill customization
9665 ;; options really only handle paragraph-starting prefixes,
9666 ;; not paragraph-ending suffixes:
9667 ".* $" ; line ending in two spaces
9668 "^#+"
9669 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
9670 "\\|"))
9671 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'")
9672 (setq-local adaptive-fill-regexp "\\s-*")
9673 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function)
9674 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph)
9675 ;; Outline mode
9676 (setq-local outline-regexp markdown-regex-header)
9677 (setq-local outline-level #'markdown-outline-level)
9678 ;; Cause use of ellipses for invisible text.
9679 (add-to-invisibility-spec '(outline . t))
9680 ;; ElDoc support
9681 (add-function :before-until (local 'eldoc-documentation-function)
9682 #'markdown-eldoc-function)
9683 ;; Inhibiting line-breaking:
9684 ;; Separating out each condition into a separate function so that users can
9685 ;; override if desired (with remove-hook)
9686 (add-hook 'fill-nobreak-predicate
9687 #'markdown-line-is-reference-definition-p nil t)
9688 (add-hook 'fill-nobreak-predicate
9689 #'markdown-pipe-at-bol-p nil t)
9691 ;; Indentation
9692 (setq-local indent-line-function markdown-indent-function)
9693 (setq-local indent-region-function #'markdown--indent-region)
9695 ;; Flyspell
9696 (setq-local flyspell-generic-check-word-predicate
9697 #'markdown-flyspell-check-word-p)
9699 ;; Electric quoting
9700 (add-hook 'electric-quote-inhibit-functions
9701 #'markdown--inhibit-electric-quote nil :local)
9703 ;; Make checkboxes buttons
9704 (when markdown-make-gfm-checkboxes-buttons
9705 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
9706 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t)
9707 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t))
9709 ;; edit-indirect
9710 (add-hook 'edit-indirect-after-commit-functions
9711 #'markdown--edit-indirect-after-commit-function
9712 nil 'local)
9714 ;; Marginalized headings
9715 (when markdown-marginalize-headers
9716 (add-hook 'window-configuration-change-hook
9717 #'markdown-marginalize-update-current nil t))
9719 ;; add live preview export hook
9720 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t)
9721 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t))
9723 ;;;###autoload
9724 (add-to-list 'auto-mode-alist
9725 '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode))
9728 ;;; GitHub Flavored Markdown Mode ============================================
9730 (defun gfm--electric-pair-fence-code-block ()
9731 (when (and electric-pair-mode
9732 (not markdown-gfm-use-electric-backquote)
9733 (eql last-command-event ?`)
9734 (let ((count 0))
9735 (while (eql (char-before (- (point) count)) ?`)
9736 (cl-incf count))
9737 (= count 3))
9738 (eql (char-after) ?`))
9739 (save-excursion (insert (make-string 2 ?`)))))
9741 (defvar gfm-mode-hook nil
9742 "Hook run when entering GFM mode.")
9744 ;;;###autoload
9745 (define-derived-mode gfm-mode markdown-mode "GFM"
9746 "Major mode for editing GitHub Flavored Markdown files."
9747 (setq markdown-link-space-sub-char "-")
9748 (setq markdown-wiki-link-search-subdirectories t)
9749 (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p)
9750 (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t)
9751 (markdown-gfm-parse-buffer-for-languages))
9754 ;;; Viewing modes =============================================================
9756 (defcustom markdown-hide-markup-in-view-modes t
9757 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
9758 :group 'markdown
9759 :type 'boolean
9760 :safe 'booleanp)
9762 (defvar markdown-view-mode-map
9763 (let ((map (make-sparse-keymap)))
9764 (define-key map (kbd "p") #'markdown-outline-previous)
9765 (define-key map (kbd "n") #'markdown-outline-next)
9766 (define-key map (kbd "f") #'markdown-outline-next-same-level)
9767 (define-key map (kbd "b") #'markdown-outline-previous-same-level)
9768 (define-key map (kbd "u") #'markdown-outline-up)
9769 (define-key map (kbd "DEL") #'scroll-down-command)
9770 (define-key map (kbd "SPC") #'scroll-up-command)
9771 (define-key map (kbd ">") #'end-of-buffer)
9772 (define-key map (kbd "<") #'beginning-of-buffer)
9773 (define-key map (kbd "q") #'kill-this-buffer)
9774 (define-key map (kbd "?") #'describe-mode)
9775 map)
9776 "Keymap for `markdown-view-mode'.")
9778 (defun markdown--filter-visible (beg end &optional delete)
9779 (let ((result "")
9780 (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face)))
9781 (while (< beg end)
9782 (when (markdown--face-p beg invisible-faces)
9783 (cl-incf beg)
9784 (while (and (markdown--face-p beg invisible-faces) (< beg end))
9785 (cl-incf beg)))
9786 (let ((next (next-single-char-property-change beg 'invisible)))
9787 (unless (get-char-property beg 'invisible)
9788 (setq result (concat result (buffer-substring beg (min end next)))))
9789 (setq beg next)))
9790 (prog1 result
9791 (when delete
9792 (let ((inhibit-read-only t))
9793 (delete-region beg end))))))
9795 ;;;###autoload
9796 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View"
9797 "Major mode for viewing Markdown content."
9798 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
9799 (add-to-invisibility-spec 'markdown-markup)
9800 (setq-local filter-buffer-substring-function #'markdown--filter-visible)
9801 (read-only-mode 1))
9803 (defvar gfm-view-mode-map
9804 markdown-view-mode-map
9805 "Keymap for `gfm-view-mode'.")
9807 ;;;###autoload
9808 (define-derived-mode gfm-view-mode gfm-mode "GFM-View"
9809 "Major mode for viewing GitHub Flavored Markdown content."
9810 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
9811 (setq-local markdown-fontify-code-blocks-natively t)
9812 (setq-local filter-buffer-substring-function #'markdown--filter-visible)
9813 (add-to-invisibility-spec 'markdown-markup)
9814 (read-only-mode 1))
9817 ;;; Live Preview Mode ========================================================
9818 ;;;###autoload
9819 (define-minor-mode markdown-live-preview-mode
9820 "Toggle native previewing on save for a specific markdown file."
9821 :lighter " MD-Preview"
9822 (if markdown-live-preview-mode
9823 (if (markdown-live-preview-get-filename)
9824 (markdown-display-buffer-other-window (markdown-live-preview-export))
9825 (markdown-live-preview-mode -1)
9826 (user-error "Buffer %s does not visit a file" (current-buffer)))
9827 (markdown-live-preview-remove)))
9830 (provide 'markdown-mode)
9832 ;; Local Variables:
9833 ;; indent-tabs-mode: nil
9834 ;; coding: utf-8
9835 ;; End:
9836 ;;; markdown-mode.el ends here