markdown-for-all-refs macro, markdown-get-all-refs function
[markdown-mode.git] / markdown-mode.el
blob770cd65bb7b3c745973d5996b74e3abe6580e26c
1 ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2007-2017 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.4-dev
10 ;; Package-Requires: ((emacs "24.4") (cl-lib "0.5"))
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)
45 (defvar jit-lock-start)
46 (defvar jit-lock-end)
47 (defvar flyspell-generic-check-word-predicate)
49 (declare-function eww-open-file "eww")
50 (declare-function url-path-and-query "url-parse")
53 ;;; Constants =================================================================
55 (defconst markdown-mode-version "2.4-dev"
56 "Markdown mode version number.")
58 (defconst markdown-output-buffer-name "*markdown-output*"
59 "Name of temporary buffer for markdown command output.")
62 ;;; Global Variables ==========================================================
64 (defvar markdown-reference-label-history nil
65 "History of used reference labels.")
67 (defvar markdown-live-preview-mode nil
68 "Sentinel variable for command `markdown-live-preview-mode'.")
70 (defvar markdown-gfm-language-history nil
71 "History list of languages used in the current buffer in GFM code blocks.")
74 ;;; Customizable Variables ====================================================
76 (defvar markdown-mode-hook nil
77 "Hook run when entering Markdown mode.")
79 (defvar markdown-before-export-hook nil
80 "Hook run before running Markdown to export XHTML output.
81 The hook may modify the buffer, which will be restored to it's
82 original state after exporting is complete.")
84 (defvar markdown-after-export-hook nil
85 "Hook run after XHTML output has been saved.
86 Any changes to the output buffer made by this hook will be saved.")
88 (defgroup markdown nil
89 "Major mode for editing text files in Markdown format."
90 :prefix "markdown-"
91 :group 'wp
92 :link '(url-link "https://jblevins.org/projects/markdown-mode/"))
94 (defcustom markdown-command "markdown"
95 "Command to run markdown."
96 :group 'markdown
97 :type '(choice (string :tag "Shell command") function))
99 (defcustom markdown-command-needs-filename nil
100 "Set to non-nil if `markdown-command' does not accept input from stdin.
101 Instead, it will be passed a filename as the final command line
102 option. As a result, you will only be able to run Markdown from
103 buffers which are visiting a file."
104 :group 'markdown
105 :type 'boolean)
107 (defcustom markdown-open-command nil
108 "Command used for opening Markdown files directly.
109 For example, a standalone Markdown previewer. This command will
110 be called with a single argument: the filename of the current
111 buffer. It can also be a function, which will be called without
112 arguments."
113 :group 'markdown
114 :type '(choice file function (const :tag "None" nil)))
116 (defcustom markdown-hr-strings
117 '("-------------------------------------------------------------------------------"
118 "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
119 "---------------------------------------"
120 "* * * * * * * * * * * * * * * * * * * *"
121 "---------"
122 "* * * * *")
123 "Strings to use when inserting horizontal rules.
124 The first string in the list will be the default when inserting a
125 horizontal rule. Strings should be listed in decreasing order of
126 prominence (as in headings from level one to six) for use with
127 promotion and demotion functions."
128 :group 'markdown
129 :type '(repeat string))
131 (defcustom markdown-bold-underscore nil
132 "Use two underscores when inserting bold text instead of two asterisks."
133 :group 'markdown
134 :type 'boolean)
136 (defcustom markdown-italic-underscore nil
137 "Use underscores when inserting italic text instead of asterisks."
138 :group 'markdown
139 :type 'boolean)
141 (defcustom markdown-marginalize-headers nil
142 "When non-nil, put opening atx header markup in a left margin.
144 This setting goes well with `markdown-asymmetric-header'. But
145 sadly it conflicts with `linum-mode' since they both use the
146 same margin."
147 :group 'markdown
148 :type 'boolean
149 :safe 'booleanp
150 :package-version '(markdown-mode . "2.4"))
152 (defcustom markdown-marginalize-headers-margin-width 6
153 "Character width of margin used for marginalized headers.
154 The default value is based on there being six heading levels
155 defined by Markdown and HTML. Increasing this produces extra
156 whitespace on the left. Decreasing it may be preferred when
157 fewer than six nested heading levels are used."
158 :group 'markdown
159 :type 'natnump
160 :safe 'natnump
161 :package-version '(markdown-mode . "2.4"))
163 (defcustom markdown-asymmetric-header nil
164 "Determines if atx header style will be asymmetric.
165 Set to a non-nil value to use asymmetric header styling, placing
166 header markup only at the beginning of the line. By default,
167 balanced markup will be inserted at the beginning and end of the
168 line around the header title."
169 :group 'markdown
170 :type 'boolean)
172 (defcustom markdown-indent-function 'markdown-indent-line
173 "Function to use to indent."
174 :group 'markdown
175 :type 'function)
177 (defcustom markdown-indent-on-enter t
178 "Determines indentation behavior when pressing \\[newline].
179 Possible settings are nil, t, and 'indent-and-new-item.
181 When non-nil, pressing \\[newline] will call `newline-and-indent'
182 to indent the following line according to the context using
183 `markdown-indent-function'. In this case, note that
184 \\[electric-newline-and-maybe-indent] can still be used to insert
185 a newline without indentation.
187 When set to 'indent-and-new-item and the point is in a list item
188 when \\[newline] is pressed, the list will be continued on the next
189 line, where a new item will be inserted.
191 When set to nil, simply call `newline' as usual. In this case,
192 you can still indent lines using \\[markdown-cycle] and continue
193 lists with \\[markdown-insert-list-item].
195 Note that this assumes the variable `electric-indent-mode' is
196 non-nil (enabled). When it is *disabled*, the behavior of
197 \\[newline] and `\\[electric-newline-and-maybe-indent]' are
198 reversed."
199 :group 'markdown
200 :type '(choice (const :tag "Don't automatically indent" nil)
201 (const :tag "Automatically indent" t)
202 (const :tag "Automatically indent and insert new list items" indent-and-new-item)))
204 (defcustom markdown-enable-wiki-links nil
205 "Syntax highlighting for wiki links.
206 Set this to a non-nil value to turn on wiki link support by default.
207 Support can be toggled later using the `markdown-toggle-wiki-links'
208 function or \\[markdown-toggle-wiki-links]."
209 :group 'markdown
210 :type 'boolean
211 :safe 'booleanp
212 :package-version '(markdown-mode . "2.2"))
214 (defcustom markdown-wiki-link-alias-first t
215 "When non-nil, treat aliased wiki links like [[alias text|PageName]].
216 Otherwise, they will be treated as [[PageName|alias text]]."
217 :group 'markdown
218 :type 'boolean
219 :safe 'booleanp)
221 (defcustom markdown-wiki-link-search-subdirectories nil
222 "When non-nil, search for wiki link targets in subdirectories.
223 This is the default search behavior for GitHub and is
224 automatically set to t in `gfm-mode'."
225 :group 'markdown
226 :type 'boolean
227 :safe 'booleanp
228 :package-version '(markdown-mode . "2.2"))
230 (defcustom markdown-wiki-link-search-parent-directories nil
231 "When non-nil, search for wiki link targets in parent directories.
232 This is the default search behavior of Ikiwiki."
233 :group 'markdown
234 :type 'boolean
235 :safe 'booleanp
236 :package-version '(markdown-mode . "2.2"))
238 (defcustom markdown-wiki-link-fontify-missing nil
239 "When non-nil, change wiki link face according to existence of target files.
240 This is expensive because it requires checking for the file each time the buffer
241 changes or the user switches windows. It is disabled by default because it may
242 cause lag when typing on slower machines."
243 :group 'markdown
244 :type 'boolean
245 :safe 'booleanp
246 :package-version '(markdown-mode . "2.2"))
248 (defcustom markdown-uri-types
249 '("acap" "cid" "data" "dav" "fax" "file" "ftp"
250 "gopher" "http" "https" "imap" "ldap" "mailto"
251 "mid" "message" "modem" "news" "nfs" "nntp"
252 "pop" "prospero" "rtsp" "service" "sip" "tel"
253 "telnet" "tip" "urn" "vemmi" "wais")
254 "Link types for syntax highlighting of URIs."
255 :group 'markdown
256 :type '(repeat (string :tag "URI scheme")))
258 (defcustom markdown-url-compose-char
259 '(?∞ ?… ?⋯ ?# ?★ ?⚓)
260 "Placeholder character for hidden URLs.
261 This may be a single character or a list of characters. In case
262 of a list, the first one that satisfies `char-displayable-p' will
263 be used."
264 :type '(choice
265 (character :tag "Single URL replacement character")
266 (repeat :tag "List of possible URL replacement characters"
267 character))
268 :package-version '(markdown-mode . "2.3"))
270 (defcustom markdown-blockquote-display-char
271 '("▌" "┃" ">")
272 "String to display when hiding blockquote markup.
273 This may be a single string or a list of string. In case of a
274 list, the first one that satisfies `char-displayable-p' will be
275 used."
276 :type 'string
277 :type '(choice
278 (string :tag "Single blockquote display string")
279 (repeat :tag "List of possible blockquote display strings" string))
280 :package-version '(markdown-mode . "2.3"))
282 (defcustom markdown-hr-display-char
283 '(?─ ?━ ?-)
284 "Character for hiding horizontal rule markup.
285 This may be a single character or a list of characters. In case
286 of a list, the first one that satisfies `char-displayable-p' will
287 be used."
288 :group 'markdown
289 :type '(choice
290 (character :tag "Single HR display character")
291 (repeat :tag "List of possible HR display characters" character))
292 :package-version '(markdown-mode . "2.3"))
294 (defcustom markdown-definition-display-char
295 '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:)
296 "Character for replacing definition list markup.
297 This may be a single character or a list of characters. In case
298 of a list, the first one that satisfies `char-displayable-p' will
299 be used."
300 :type '(choice
301 (character :tag "Single definition list character")
302 (repeat :tag "List of possible definition list characters" character))
303 :package-version '(markdown-mode . "2.3"))
305 (defcustom markdown-enable-math nil
306 "Syntax highlighting for inline LaTeX and itex expressions.
307 Set this to a non-nil value to turn on math support by default.
308 Math support can be enabled, disabled, or toggled later using
309 `markdown-toggle-math' or \\[markdown-toggle-math]."
310 :group 'markdown
311 :type 'boolean
312 :safe 'booleanp)
313 (make-variable-buffer-local 'markdown-enable-math)
315 (defcustom markdown-enable-html t
316 "Enable font-lock support for HTML tags and attributes."
317 :group 'markdown
318 :type 'boolean
319 :safe 'booleanp
320 :package-version '(markdown-mode . "2.4"))
322 (defcustom markdown-css-paths nil
323 "URL of CSS file to link to in the output XHTML."
324 :group 'markdown
325 :type '(repeat (string :tag "CSS File Path")))
327 (defcustom markdown-content-type ""
328 "Content type string for the http-equiv header in XHTML output.
329 When set to a non-empty string, insert the http-equiv attribute.
330 Otherwise, this attribute is omitted."
331 :group 'markdown
332 :type 'string)
334 (defcustom markdown-coding-system nil
335 "Character set string for the http-equiv header in XHTML output.
336 Defaults to `buffer-file-coding-system' (and falling back to
337 `iso-8859-1' when not available). Common settings are `utf-8'
338 and `iso-latin-1'. Use `list-coding-systems' for more choices."
339 :group 'markdown
340 :type 'coding-system)
342 (defcustom markdown-export-kill-buffer t
343 "Kill output buffer after HTML export.
344 When non-nil, kill the HTML output buffer after
345 exporting with `markdown-export'."
346 :group 'markdown
347 :type 'boolean
348 :safe 'booleanp
349 :package-version '(markdown-mode . "2.4"))
351 (defcustom markdown-xhtml-header-content ""
352 "Additional content to include in the XHTML <head> block."
353 :group 'markdown
354 :type 'string)
356 (defcustom markdown-xhtml-body-preamble ""
357 "Content to include in the XHTML <body> block, before the output."
358 :group 'markdown
359 :type 'string
360 :safe 'stringp
361 :package-version '(markdown-mode . "2.4"))
363 (defcustom markdown-xhtml-body-epilogue ""
364 "Content to include in the XHTML <body> block, after the output."
365 :group 'markdown
366 :type 'string
367 :safe 'stringp
368 :package-version '(markdown-mode . "2.4"))
370 (defcustom markdown-xhtml-standalone-regexp
371 "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
372 "Regexp indicating whether `markdown-command' output is standalone XHTML."
373 :group 'markdown
374 :type 'regexp)
376 (defcustom markdown-link-space-sub-char "_"
377 "Character to use instead of spaces when mapping wiki links to filenames."
378 :group 'markdown
379 :type 'string)
381 (defcustom markdown-reference-location 'header
382 "Position where new reference definitions are inserted in the document."
383 :group 'markdown
384 :type '(choice (const :tag "At the end of the document" end)
385 (const :tag "Immediately after the current block" immediately)
386 (const :tag "At the end of the subtree" subtree)
387 (const :tag "Before next header" header)))
389 (defcustom markdown-footnote-location 'end
390 "Position where new footnotes are inserted in the document."
391 :group 'markdown
392 :type '(choice (const :tag "At the end of the document" end)
393 (const :tag "Immediately after the current block" immediately)
394 (const :tag "At the end of the subtree" subtree)
395 (const :tag "Before next header" header)))
397 (defcustom markdown-footnote-display '((raise 0.2) (height 0.8))
398 "Display specification for footnote markers and inline footnotes.
399 By default, footnote text is reduced in size and raised. Set to
400 nil to disable this."
401 :group 'markdown
402 :type '(choice (sexp :tag "Display specification")
403 (const :tag "Don't set display property" nil))
404 :package-version '(markdown-mode . "2.4"))
406 (defcustom markdown-sub-superscript-display
407 '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7)))
408 "Display specification for subscript and superscripts.
409 The car is used for subscript, the cdr is used for superscripts."
410 :group 'markdown
411 :type '(cons (choice (sexp :tag "Subscript form")
412 (const :tag "No lowering" nil))
413 (choice (sexp :tag "Superscript form")
414 (const :tag "No raising" nil)))
415 :package-version '(markdown-mode . "2.4"))
417 (defcustom markdown-unordered-list-item-prefix " * "
418 "String inserted before unordered list items."
419 :group 'markdown
420 :type 'string)
422 (defcustom markdown-nested-imenu-heading-index t
423 "Use nested or flat imenu heading index.
424 A nested index may provide more natural browsing from the menu,
425 but a flat list may allow for faster keyboard navigation via tab
426 completion."
427 :group 'markdown
428 :type 'boolean
429 :safe 'booleanp
430 :package-version '(markdown-mode . "2.2"))
432 (defcustom markdown-add-footnotes-to-imenu t
433 "Add footnotes to end of imenu heading index."
434 :group 'markdown
435 :type 'boolean
436 :safe 'booleanp
437 :package-version '(markdown-mode . "2.4"))
439 (defcustom markdown-make-gfm-checkboxes-buttons t
440 "When non-nil, make GFM checkboxes into buttons."
441 :group 'markdown
442 :type 'boolean)
444 (defcustom markdown-use-pandoc-style-yaml-metadata nil
445 "When non-nil, allow YAML metadata anywhere in the document."
446 :group 'markdown
447 :type 'boolean)
449 (defcustom markdown-split-window-direction 'any
450 "Preference for splitting windows for static and live preview.
451 The default value is 'any, which instructs Emacs to use
452 `split-window-sensibly' to automatically choose how to split
453 windows based on the values of `split-width-threshold' and
454 `split-height-threshold' and the available windows. To force
455 vertically split (left and right) windows, set this to 'vertical
456 or 'right. To force horizontally split (top and bottom) windows,
457 set this to 'horizontal or 'below."
458 :group 'markdown
459 :type '(choice (const :tag "Automatic" any)
460 (const :tag "Right (vertical)" right)
461 (const :tag "Below (horizontal)" below))
462 :package-version '(markdown-mode . "2.2"))
464 (defcustom markdown-live-preview-window-function
465 'markdown-live-preview-window-eww
466 "Function to display preview of Markdown output within Emacs.
467 Function must update the buffer containing the preview and return
468 the buffer."
469 :group 'markdown
470 :type 'function)
472 (defcustom markdown-live-preview-delete-export 'delete-on-destroy
473 "Delete exported HTML file when using `markdown-live-preview-export'.
474 If set to 'delete-on-export, delete on every export. When set to
475 'delete-on-destroy delete when quitting from command
476 `markdown-live-preview-mode'. Never delete if set to nil."
477 :group 'markdown
478 :type '(choice
479 (const :tag "Delete on every export" delete-on-export)
480 (const :tag "Delete when quitting live preview" delete-on-destroy)
481 (const :tag "Never delete" nil)))
483 (defcustom markdown-list-indent-width 4
484 "Depth of indentation for markdown lists.
485 Used in `markdown-demote-list-item' and
486 `markdown-promote-list-item'."
487 :group 'markdown
488 :type 'integer)
490 (defcustom markdown-enable-prefix-prompts t
491 "Display prompts for certain prefix commands.
492 Set to nil to disable these prompts."
493 :group 'markdown
494 :type 'boolean
495 :safe 'booleanp
496 :package-version '(markdown-mode . "2.3"))
498 (defcustom markdown-gfm-additional-languages nil
499 "Extra languages made available when inserting GFM code blocks.
500 Language strings must have be trimmed of whitespace and not
501 contain any curly braces. They may be of arbitrary
502 capitalization, though."
503 :group 'markdown
504 :type '(repeat (string :validate markdown-validate-language-string)))
506 (defcustom markdown-gfm-use-electric-backquote t
507 "Use `markdown-electric-backquote' when backquote is hit three times."
508 :group 'markdown
509 :type 'boolean)
511 (defcustom markdown-gfm-downcase-languages t
512 "If non-nil, downcase suggested languages.
513 This applies to insertions done with
514 `markdown-electric-backquote'."
515 :group 'markdown
516 :type 'boolean)
518 (defcustom markdown-edit-code-block-default-mode 'normal-mode
519 "Default mode to use for editing code blocks.
520 This mode is used when automatic detection fails, such as for GFM
521 code blocks with no language specified."
522 :group 'markdown
523 :type '(choice function (const :tag "None" nil))
524 :package-version '(markdown-mode . "2.4"))
526 (defcustom markdown-gfm-uppercase-checkbox nil
527 "If non-nil, use [X] for completed checkboxes, [x] otherwise."
528 :group 'markdown
529 :type 'boolean
530 :safe 'booleanp)
532 (defcustom markdown-hide-urls nil
533 "Hide URLs of inline links and reference tags of reference links.
534 Such URLs will be replaced by a single customizable
535 character, defined by `markdown-url-compose-char', but are still part
536 of the buffer. Links can be edited interactively with
537 \\[markdown-insert-link] or, for example, by deleting the final
538 parenthesis to remove the invisibility property. You can also
539 hover your mouse pointer over the link text to see the URL.
540 Set this to a non-nil value to turn this feature on by default.
541 You can interactively set the value of this variable by calling
542 `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
543 or from the menu Markdown > Links & Images menu."
544 :group 'markdown
545 :type 'boolean
546 :safe 'booleanp
547 :package-version '(markdown-mode . "2.3"))
548 (make-variable-buffer-local 'markdown-hide-urls)
550 (defcustom markdown-translate-filename-function #'identity
551 "Function to use to translate filenames when following links.
552 \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
553 call this function with the filename as only argument whenever
554 they encounter a filename (instead of a URL) to be visited and
555 use its return value instead of the filename in the link. For
556 example, if absolute filenames are actually relative to a server
557 root directory, you can set
558 `markdown-translate-filename-function' to a function that
559 prepends the root directory to the given filename."
560 :group 'markdown
561 :type 'function
562 :risky t
563 :package-version '(markdown-mode . "2.4"))
565 (defcustom markdown-max-image-size nil
566 "Maximum width and height for displayed inline images.
567 This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
568 When nil, use the actual size. Otherwise, use ImageMagick to
569 resize larger images to be of the given maximum dimensions. This
570 requires Emacs to be built with ImageMagick support."
571 :group 'markdown
572 :package-version '(markdown-mode . "2.4")
573 :type '(choice
574 (const :tag "Use actual image width" nil)
575 (cons (choice (sexp :tag "Maximum width in pixels")
576 (const :tag "No maximum width" nil))
577 (choice (sexp :tag "Maximum height in pixels")
578 (const :tag "No maximum height" nil)))))
581 ;;; Markdown-Specific `rx' Macro
583 ;; Based on python-rx from python.el.
584 (eval-and-compile
585 (defconst markdown-rx-constituents
586 `((newline . ,(rx "\n"))
587 (indent . ,(rx (or (repeat 4 " ") "\t")))
588 (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end))))
589 (numeral . ,(rx (and (one-or-more (any "0-9#")) ".")))
590 (bullet . ,(rx (any "*+:-")))
591 (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".")
592 (any "*+:-"))))
593 (checkbox . ,(rx "[" (any " xX") "]")))
594 "Markdown-specific sexps for `markdown-rx'")
596 (defun markdown-rx-to-string (form &optional no-group)
597 "Markdown mode specialized `rx-to-string' function.
598 This variant supports named Markdown expressions in FORM.
599 NO-GROUP non-nil means don't put shy groups around the result."
600 (let ((rx-constituents (append markdown-rx-constituents rx-constituents)))
601 (rx-to-string form no-group)))
603 (defmacro markdown-rx (&rest regexps)
604 "Markdown mode specialized rx macro.
605 This variant of `rx' supports common Markdown named REGEXPS."
606 (cond ((null regexps)
607 (error "No regexp"))
608 ((cdr regexps)
609 (markdown-rx-to-string `(and ,@regexps) t))
611 (markdown-rx-to-string (car regexps) t)))))
614 ;;; Regular Expressions =======================================================
616 (defconst markdown-regex-comment-start
617 "<!--"
618 "Regular expression matches HTML comment opening.")
620 (defconst markdown-regex-comment-end
621 "--[ \t]*>"
622 "Regular expression matches HTML comment closing.")
624 (defconst markdown-regex-link-inline
625 "\\(!\\)?\\(\\[\\)\\([^]^][^]]*\\|\\)\\(\\]\\)\\((\\)\\([^)]*?\\)\\(?:\\s-+\\(\"[^\"]*\"\\)\\)?\\()\\)"
626 "Regular expression for a [text](file) or an image link ![text](file).
627 Group 1 matches the leading exclamation point (optional).
628 Group 2 matches the opening square bracket.
629 Group 3 matches the text inside the square brackets.
630 Group 4 matches the closing square bracket.
631 Group 5 matches the opening parenthesis.
632 Group 6 matches the URL.
633 Group 7 matches the title (optional).
634 Group 8 matches the closing parenthesis.")
636 (defconst markdown-regex-link-reference
637 "\\(!\\)?\\(\\[\\)\\([^]^][^]]*\\|\\)\\(\\]\\)[ ]?\\(\\[\\)\\([^]]*?\\)\\(\\]\\)"
638 "Regular expression for a reference link [text][id].
639 Group 1 matches the leading exclamation point (optional).
640 Group 2 matches the opening square bracket for the link text.
641 Group 3 matches the text inside the square brackets.
642 Group 4 matches the closing square bracket for the link text.
643 Group 5 matches the opening square bracket for the reference label.
644 Group 6 matches the reference label.
645 Group 7 matches the closing square bracket for the reference label.")
647 (defconst markdown-regex-reference-definition
648 "^ \\{0,3\\}\\(\\[\\)\\([^]\n]+?\\)\\(\\]\\)\\(:\\)\\s *\\(.*?\\)\\s *\\( \"[^\"]*\"$\\|$\\)"
649 "Regular expression for a reference definition.
650 Group 1 matches the opening square bracket.
651 Group 2 matches the reference label.
652 Group 3 matches the closing square bracket.
653 Group 4 matches the colon.
654 Group 5 matches the URL.
655 Group 6 matches the title attribute (optional).")
657 (defconst markdown-regex-footnote
658 "\\(\\[\\^\\)\\(.+?\\)\\(\\]\\)"
659 "Regular expression for a footnote marker [^fn].
660 Group 1 matches the opening square bracket and carat.
661 Group 2 matches only the label, without the surrounding markup.
662 Group 3 matches the closing square bracket.")
664 (defconst markdown-regex-header
665 "^\\(?:\\([^\r\n\t -].*\\)\n\\(?:\\(=+\\)\\|\\(-+\\)\\)\\|\\(#+[ \t]+\\)\\(.*?\\)\\([ \t]*#*\\)\\)$"
666 "Regexp identifying Markdown headings.
667 Group 1 matches the text of a setext heading.
668 Group 2 matches the underline of a level-1 setext heading.
669 Group 3 matches the underline of a level-2 setext heading.
670 Group 4 matches the opening hash marks of an atx heading and whitespace.
671 Group 5 matches the text, without surrounding whitespace, of an atx heading.
672 Group 6 matches the closing whitespace and hash marks of an atx heading.")
674 (defconst markdown-regex-header-setext
675 "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
676 "Regular expression for generic setext-style (underline) headers.")
678 (defconst markdown-regex-header-atx
679 "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
680 "Regular expression for generic atx-style (hash mark) headers.")
682 (defconst markdown-regex-hr
683 (rx line-start
684 (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* ")))
685 (and (repeat 3 (and "-" (? " "))) (* (any "- ")))
686 (and (repeat 3 (and "_" (? " "))) (* (any "_ ")))))
687 line-end)
688 "Regular expression for matching Markdown horizontal rules.")
690 (defconst markdown-regex-code
691 "\\(?:\\`\\|[^\\]\\)\\(\\(`+\\)\\(\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(\\2\\)\\)\\(?:[^`]\\|\\'\\)"
692 "Regular expression for matching inline code fragments.
694 Group 1 matches the entire code fragment including the backquotes.
695 Group 2 matches the opening backquotes.
696 Group 3 matches the code fragment itself, without backquotes.
697 Group 4 matches the closing backquotes.
699 The leading, unnumbered group ensures that the leading backquote
700 character is not escaped.
701 The last group, also unnumbered, requires that the character
702 following the code fragment is not a backquote.
703 Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
704 but not two newlines in a row.")
706 (defconst markdown-regex-kbd
707 "\\(<kbd>\\)\\(\\(?:.\\|\n[^\n]\\)*?\\)\\(</kbd>\\)"
708 "Regular expression for matching <kbd> tags.
709 Groups 1 and 3 match the opening and closing tags.
710 Group 2 matches the key sequence.")
712 (defconst markdown-regex-gfm-code-block-open
713 "^[[:blank:]]*\\(```\\)\\([[:blank:]]*{?[[:blank:]]*\\)\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$"
714 "Regular expression matching opening of GFM code blocks.
715 Group 1 matches the opening three backquotes and any following whitespace.
716 Group 2 matches the opening brace (optional) and surrounding whitespace.
717 Group 3 matches the language identifier (optional).
718 Group 4 matches the info string (optional).
719 Group 5 matches the closing brace (optional), whitespace, and newline.
720 Groups need to agree with `markdown-regex-tilde-fence-begin'.")
722 (defconst markdown-regex-gfm-code-block-close
723 "^[[:blank:]]*\\(```\\)\\(\\s *?\\)$"
724 "Regular expression matching closing of GFM code blocks.
725 Group 1 matches the closing three backquotes.
726 Group 2 matches any whitespace and the final newline.")
728 (defconst markdown-regex-pre
729 "^\\( \\|\t\\).*$"
730 "Regular expression for matching preformatted text sections.")
732 (defconst markdown-regex-list
733 (markdown-rx line-start
734 ;; 1. Leading whitespace
735 (group (* blank))
736 ;; 2. List marker: a numeral, bullet, or colon
737 (group list-marker)
738 ;; 3. Trailing whitespace
739 (group (+ blank))
740 ;; 4. Optional checkbox for GFM task list items
741 (opt (group (and checkbox (* blank)))))
742 "Regular expression for matching list items.")
744 (defconst markdown-regex-bold
745 "\\(^\\|[^\\]\\)\\(\\([*_]\\{2\\}\\)\\([^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(\\3\\)\\)"
746 "Regular expression for matching bold text.
747 Group 1 matches the character before the opening asterisk or
748 underscore, if any, ensuring that it is not a backslash escape.
749 Group 2 matches the entire expression, including delimiters.
750 Groups 3 and 5 matches the opening and closing delimiters.
751 Group 4 matches the text inside the delimiters.")
753 (defconst markdown-regex-italic
754 "\\(?:^\\|[^\\]\\)\\(\\([*_]\\)\\([^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(\\2\\)\\)"
755 "Regular expression for matching italic text.
756 The leading unnumbered matches the character before the opening
757 asterisk or underscore, if any, ensuring that it is not a
758 backslash escape.
759 Group 1 matches the entire expression, including delimiters.
760 Groups 2 and 4 matches the opening and closing delimiters.
761 Group 3 matches the text inside the delimiters.")
763 (defconst markdown-regex-strike-through
764 "\\(^\\|[^\\]\\)\\(\\(~~\\)\\([^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(~~\\)\\)"
765 "Regular expression for matching strike-through text.
766 Group 1 matches the character before the opening tilde, if any,
767 ensuring that it is not a backslash escape.
768 Group 2 matches the entire expression, including delimiters.
769 Groups 3 and 5 matches the opening and closing delimiters.
770 Group 4 matches the text inside the delimiters.")
772 (defconst markdown-regex-gfm-italic
773 "\\(?:^\\|\\s-\\)\\(\\([*_]\\)\\([^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(\\2\\)\\)"
774 "Regular expression for matching italic text in GitHub Flavored Markdown.
775 Underscores in words are not treated as special.
776 Group 1 matches the entire expression, including delimiters.
777 Groups 2 and 4 matches the opening and closing delimiters.
778 Group 3 matches the text inside the delimiters.")
780 (defconst markdown-regex-blockquote
781 "^[ \t]*\\([A-Z]?>\\)\\([ \t]*\\)\\(.*\\)$"
782 "Regular expression for matching blockquote lines.
783 Also accounts for a potential capital letter preceding the angle
784 bracket, for use with Leanpub blocks (asides, warnings, info
785 blocks, etc.).
786 Group 1 matches the leading angle bracket.
787 Group 2 matches the separating whitespace.
788 Group 3 matches the text.")
790 (defconst markdown-regex-line-break
791 "[^ \n\t][ \t]*\\( \\)$"
792 "Regular expression for matching line breaks.")
794 (defconst markdown-regex-wiki-link
795 "\\(?:^\\|[^\\]\\)\\(\\(\\[\\[\\)\\([^]|]+\\)\\(?:\\(|\\)\\([^]]+\\)\\)?\\(\\]\\]\\)\\)"
796 "Regular expression for matching wiki links.
797 This matches typical bracketed [[WikiLinks]] as well as 'aliased'
798 wiki links of the form [[PageName|link text]].
799 The meanings of the first and second components depend
800 on the value of `markdown-wiki-link-alias-first'.
802 Group 1 matches the entire link.
803 Group 2 matches the opening square brackets.
804 Group 3 matches the first component of the wiki link.
805 Group 4 matches the pipe separator, when present.
806 Group 5 matches the second component of the wiki link, when present.
807 Group 6 matches the closing square brackets.")
809 (defconst markdown-regex-uri
810 (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)")
811 "Regular expression for matching inline URIs.")
813 (defconst markdown-regex-angle-uri
814 (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)")
815 "Regular expression for matching inline URIs in angle brackets.")
817 (defconst markdown-regex-email
818 "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
819 "Regular expression for matching inline email addresses.")
821 (defsubst markdown-make-regex-link-generic ()
822 "Make regular expression for matching any recognized link."
823 (concat "\\(?:" markdown-regex-link-inline
824 (when markdown-enable-wiki-links
825 (concat "\\|" markdown-regex-wiki-link))
826 "\\|" markdown-regex-link-reference
827 "\\|" markdown-regex-angle-uri "\\)"))
829 (defconst markdown-regex-gfm-checkbox
830 " \\(\\[[ xX]\\]\\) "
831 "Regular expression for matching GFM checkboxes.
832 Group 1 matches the text to become a button.")
834 (defconst markdown-regex-blank-line
835 "^[[:blank:]]*$"
836 "Regular expression that matches a blank line.")
838 (defconst markdown-regex-block-separator
839 "\n[\n\t\f ]*\n"
840 "Regular expression for matching block boundaries.")
842 (defconst markdown-regex-block-separator-noindent
843 (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)")
844 "Regexp for block separators before lines with no indentation.")
846 (defconst markdown-regex-math-inline-single
847 "\\(?:^\\|[^\\]\\)\\(\\$\\)\\(\\(?:[^\\$]\\|\\\\.\\)*\\)\\(\\$\\)"
848 "Regular expression for itex $..$ math mode expressions.
849 Groups 1 and 3 match the opening and closing dollar signs.
850 Group 2 matches the mathematical expression contained within.")
852 (defconst markdown-regex-math-inline-double
853 "\\(?:^\\|[^\\]\\)\\(\\$\\$\\)\\(\\(?:[^\\$]\\|\\\\.\\)*\\)\\(\\$\\$\\)"
854 "Regular expression for itex $$..$$ math mode expressions.
855 Groups 1 and 3 match opening and closing dollar signs.
856 Group 2 matches the mathematical expression contained within.")
858 (defconst markdown-regex-math-display
859 (rx line-start (* blank)
860 (group (group (repeat 1 2 "\\")) "[")
861 (group (*? anything))
862 (group (backref 2) "]")
863 line-end)
864 "Regular expression for \[..\] or \\[..\\] display math.
865 Groups 1 and 4 match the opening and closing markup.
866 Group 3 matches the mathematical expression contained within.
867 Group 2 matches the opening slashes, and is used internally to
868 match the closing slashes.")
870 (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line)
871 "Return regexp matching a tilde code fence at least NUM-TILDES long.
872 END-OF-LINE is the regexp construct to indicate end of line; $ if
873 missing."
874 (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)"
875 (or end-of-line "$")))
877 (defconst markdown-regex-tilde-fence-begin
878 (markdown-make-tilde-fence-regex
879 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
880 "Regular expression for matching tilde-fenced code blocks.
881 Group 1 matches the opening tildes.
882 Group 2 matches (optional) opening brace and surrounding whitespace.
883 Group 3 matches the language identifier (optional).
884 Group 4 matches the info string (optional).
885 Group 5 matches the closing brace (optional) and any surrounding whitespace.
886 Groups need to agree with `markdown-regex-gfm-code-block-open'.")
888 (defconst markdown-regex-declarative-metadata
889 "^\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
890 "Regular expression for matching declarative metadata statements.
891 This matches MultiMarkdown metadata as well as YAML and TOML
892 assignments such as the following:
894 variable: value
898 variable = value")
900 (defconst markdown-regex-pandoc-metadata
901 "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
902 "Regular expression for matching Pandoc metadata.")
904 (defconst markdown-regex-yaml-metadata-border
905 "\\(-\\{3\\}\\)$"
906 "Regular expression for matching YAML metadata.")
908 (defconst markdown-regex-yaml-pandoc-metadata-end-border
909 "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
910 "Regular expression for matching YAML metadata end borders.")
912 (defsubst markdown-get-yaml-metadata-start-border ()
913 "Return YAML metadata start border depending upon whether Pandoc is used."
914 (concat
915 (if markdown-use-pandoc-style-yaml-metadata "^" "\\`")
916 markdown-regex-yaml-metadata-border))
918 (defsubst markdown-get-yaml-metadata-end-border (_)
919 "Return YAML metadata end border depending upon whether Pandoc is used."
920 (if markdown-use-pandoc-style-yaml-metadata
921 markdown-regex-yaml-pandoc-metadata-end-border
922 markdown-regex-yaml-metadata-border))
924 (defconst markdown-regex-inline-attributes
925 "[ \t]*\\({:?\\)[ \t]*\\(\\(#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"]*['\"]?\\),?[ \t]*\\)+\\(}\\)[ \t]*$"
926 "Regular expression for matching inline identifiers or attribute lists.
927 Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
929 (defconst markdown-regex-leanpub-sections
930 (concat
931 "^\\({\\)\\("
932 (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
933 "\\)\\(}\\)[ \t]*\n")
934 "Regular expression for Leanpub section markers and related syntax.")
936 (defconst markdown-regex-sub-superscript
937 "\\(?:^\\|[^\\~^]\\)\\(\\([~^]\\)\\([[:alnum:]]+\\)\\(\\2\\)\\)"
938 "The regular expression matching a sub- or superscript.
939 The leading un-numbered group matches the character before the
940 opening tilde or carat, if any, ensuring that it is not a
941 backslash escape, carat, or tilde.
942 Group 1 matches the entire expression, including markup.
943 Group 2 matches the opening markup--a tilde or carat.
944 Group 3 matches the text inside the delimiters.
945 Group 4 matches the closing markup--a tilde or carat.")
947 (defconst markdown-regex-include
948 "^\\(<<\\)\\(?:\\(\\[\\)\\(.*\\)\\(\\]\\)\\)?\\(?:\\((\\)\\(.*\\)\\()\\)\\)?\\(?:\\({\\)\\(.*\\)\\(}\\)\\)?$"
949 "Regular expression matching common forms of include syntax.
950 Marked 2, Leanpub, and other processors support some of these forms:
952 <<[sections/section1.md]
953 <<(folder/filename)
954 <<[Code title](folder/filename)
955 <<{folder/raw_file.html}
957 Group 1 matches the opening two angle brackets.
958 Groups 2-4 match the opening square bracket, the text inside,
959 and the closing square bracket, respectively.
960 Groups 5-7 match the opening parenthesis, the text inside, and
961 the closing parenthesis.
962 Groups 8-10 match the opening brace, the text inside, and the brace.")
964 (defconst markdown-regex-pandoc-inline-footnote
965 "\\(\\^\\)\\(\\[\\)\\(\\(?:.\\|\n[^\n]\\)*?\\)\\(\\]\\)"
966 "Regular expression for Pandoc inline footnote^[footnote text].
967 Group 1 matches the opening caret.
968 Group 2 matches the opening square bracket.
969 Group 3 matches the footnote text, without the surrounding markup.
970 Group 4 matches the closing square bracket.")
972 (defconst markdown-regex-html-attr
973 "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
974 "Regular expression for matching HTML attributes and values.
975 Group 1 matches the attribute name.
976 Group 2 matches the following whitespace, equals sign, and value, if any.
977 Group 3 matches the equals sign, if any.
978 Group 4 matches single-, double-, or un-quoted attribute values.")
980 (defconst markdown-regex-html-tag
981 (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
982 "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
983 "Regular expression for matching HTML tags.
984 Groups 1 and 9 match the beginning and ending angle brackets and slashes.
985 Group 2 matches the tag name.
986 Group 3 matches all attributes and whitespace following the tag name.")
988 (defconst markdown-regex-html-entity
989 "\\(&#?[[:alnum:]]+;\\)"
990 "Regular expression for matching HTML entities.")
993 ;;; Syntax ====================================================================
995 (defvar markdown--syntax-properties
996 (list 'markdown-tilde-fence-begin nil
997 'markdown-tilde-fence-end nil
998 'markdown-fenced-code nil
999 'markdown-yaml-metadata-begin nil
1000 'markdown-yaml-metadata-end nil
1001 'markdown-yaml-metadata-section nil
1002 'markdown-gfm-block-begin nil
1003 'markdown-gfm-block-end nil
1004 'markdown-gfm-code nil
1005 'markdown-list-item nil
1006 'markdown-pre nil
1007 'markdown-blockquote nil
1008 'markdown-hr nil
1009 'markdown-comment nil
1010 'markdown-heading nil
1011 'markdown-heading-1-setext nil
1012 'markdown-heading-2-setext nil
1013 'markdown-heading-1-atx nil
1014 'markdown-heading-2-atx nil
1015 'markdown-heading-3-atx nil
1016 'markdown-heading-4-atx nil
1017 'markdown-heading-5-atx nil
1018 'markdown-heading-6-atx nil
1019 'markdown-metadata-key nil
1020 'markdown-metadata-value nil
1021 'markdown-metadata-markup nil)
1022 "Property list of all Markdown syntactic properties.")
1024 (defsubst markdown-in-comment-p (&optional pos)
1025 "Return non-nil if POS is in a comment.
1026 If POS is not given, use point instead."
1027 (get-text-property (or pos (point)) 'markdown-comment))
1029 (defun markdown-syntax-propertize-extend-region (start end)
1030 "Extend START to END region to include an entire block of text.
1031 This helps improve syntax analysis for block constructs.
1032 Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
1033 Function is called repeatedly until it returns nil. For details, see
1034 `syntax-propertize-extend-region-functions'."
1035 (save-match-data
1036 (save-excursion
1037 (let* ((new-start (progn (goto-char start)
1038 (skip-chars-forward "\n")
1039 (if (re-search-backward "\n\n" nil t)
1040 (min start (match-end 0))
1041 (point-min))))
1042 (new-end (progn (goto-char end)
1043 (skip-chars-backward "\n")
1044 (if (re-search-forward "\n\n" nil t)
1045 (max end (match-beginning 0))
1046 (point-max))))
1047 (code-match (markdown--code-block-at-pos-no-syntax new-start))
1048 (new-start (or (and code-match (cl-first code-match)) new-start))
1049 (code-match (and (< end (point-max))
1050 (markdown--code-block-at-pos-no-syntax end)))
1051 (new-end (or (and code-match (cl-second code-match)) new-end)))
1052 (unless (and (eq new-start start) (eq new-end end))
1053 (cons new-start (min new-end (point-max))))))))
1055 (defun markdown-font-lock-extend-region-function (start end _)
1056 "Used in `jit-lock-after-change-extend-region-functions'.
1057 Delegates to `markdown-syntax-propertize-extend-region'. START
1058 and END are the previous region to refontify."
1059 (let ((res (markdown-syntax-propertize-extend-region start end)))
1060 (when res
1061 ;; syntax-propertize-function is not called when character at
1062 ;; (point-max) is deleted, but font-lock-extend-region-functions
1063 ;; are called. Force a syntax property update in that case.
1064 (when (= end (point-max))
1065 ;; This function is called in a buffer modification hook.
1066 ;; `markdown-syntax-propertize' doesn't save the match data,
1067 ;; so we have to do it here.
1068 (save-match-data
1069 (markdown-syntax-propertize (car res) (cdr res))))
1070 (setq jit-lock-start (car res)
1071 jit-lock-end (cdr res)))))
1073 (defun markdown--cur-list-item-bounds ()
1074 "Return a list describing the list item at point.
1075 Assumes that match data is set for `markdown-regex-list'. See the
1076 documentation for `markdown-cur-list-item-bounds' for the format of
1077 the returned list."
1078 (save-excursion
1079 (let* ((begin (match-beginning 0))
1080 (indent (length (match-string-no-properties 1)))
1081 (nonlist-indent (- (match-end 3) (match-beginning 0)))
1082 (marker (buffer-substring-no-properties
1083 (match-beginning 2) (match-end 3)))
1084 (checkbox (match-string-no-properties 4))
1085 (match (butlast (match-data t)))
1086 (end (markdown-cur-list-item-end nonlist-indent)))
1087 (list begin end indent nonlist-indent marker checkbox match))))
1089 (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds)
1090 "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
1091 Here, MARKER is a string representing the type of list and INDENT
1092 is an integer giving the indentation, in spaces, of the current
1093 block. CUR-BOUNDS is a list of the form returned by
1094 `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
1095 values for parent list items. When BOUNDS is nil, it means we are
1096 at baseline (not inside of a nested list)."
1097 (let ((prev-indent (or (cl-third (car bounds)) 0)))
1098 (cond
1099 ;; New list item at baseline.
1100 ((and marker (null bounds))
1101 (list cur-bounds))
1102 ;; List item with greater indentation (four or more spaces).
1103 ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
1104 ((and marker (>= indent (+ prev-indent 4)))
1105 (cons cur-bounds bounds))
1106 ;; List item with greater or equal indentation (less than four spaces).
1107 ;; Keep list level the same by replacing the car of BOUNDS.
1108 ((and marker (>= indent prev-indent))
1109 (cons cur-bounds (cdr bounds)))
1110 ;; Lesser indentation level.
1111 ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
1112 ;; indentation could move back more than one list level). Note
1113 ;; that this block need not be the beginning of list item.
1114 ((< indent prev-indent)
1115 (while (and (> (length bounds) 1)
1116 (setq prev-indent (cl-third (cadr bounds)))
1117 (< indent (+ prev-indent 4)))
1118 (setq bounds (cdr bounds)))
1119 (cons cur-bounds bounds))
1120 ;; Otherwise, do nothing.
1121 (t bounds))))
1123 (defun markdown-syntax-propertize-list-items (start end)
1124 "Propertize list items from START to END.
1125 Stores nested list item information in the `markdown-list-item'
1126 text property to make later syntax analysis easier. The value of
1127 this property is a list with elements of the form (begin . end)
1128 giving the bounds of the current and parent list items."
1129 (save-excursion
1130 (goto-char start)
1131 (let (bounds level pre-regexp)
1132 ;; Find a baseline point with zero list indentation
1133 (markdown-search-backward-baseline)
1134 ;; Search for all list items between baseline and END
1135 (while (and (< (point) end)
1136 (re-search-forward markdown-regex-list end 'limit))
1137 ;; Level of list nesting
1138 (setq level (length bounds))
1139 ;; Pre blocks need to be indented one level past the list level
1140 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level)))
1141 (beginning-of-line)
1142 (cond
1143 ;; Reset at headings, horizontal rules, and top-level blank lines.
1144 ;; Propertize baseline when in range.
1145 ((markdown-new-baseline)
1146 (setq bounds nil))
1147 ;; Make sure this is not a line from a pre block
1148 ((looking-at-p pre-regexp))
1149 ;; If not, then update levels and propertize list item when in range.
1151 (let* ((indent (current-indentation))
1152 (cur-bounds (markdown--cur-list-item-bounds))
1153 (first (cl-first cur-bounds))
1154 (last (cl-second cur-bounds))
1155 (marker (cl-fifth cur-bounds)))
1156 (setq bounds (markdown--append-list-item-bounds
1157 marker indent cur-bounds bounds))
1158 (when (and (<= start (point)) (<= (point) end))
1159 (put-text-property first last 'markdown-list-item bounds)))))
1160 (end-of-line)))))
1162 (defun markdown-syntax-propertize-pre-blocks (start end)
1163 "Match preformatted text blocks from START to END."
1164 (save-excursion
1165 (goto-char start)
1166 (let ((levels (markdown-calculate-list-levels))
1167 indent pre-regexp close-regexp open close)
1168 (while (and (< (point) end) (not close))
1169 ;; Search for a region with sufficient indentation
1170 (if (null levels)
1171 (setq indent 1)
1172 (setq indent (1+ (length levels))))
1173 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent))
1174 (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent)))
1176 (cond
1177 ;; If not at the beginning of a line, move forward
1178 ((not (bolp)) (forward-line))
1179 ;; Move past blank lines
1180 ((markdown-cur-line-blank-p) (forward-line))
1181 ;; At headers and horizontal rules, reset levels
1182 ((markdown-new-baseline) (forward-line) (setq levels nil))
1183 ;; If the current line has sufficient indentation, mark out pre block
1184 ;; The opening should be preceded by a blank line.
1185 ((and (markdown-prev-line-blank) (looking-at pre-regexp))
1186 (setq open (match-beginning 0))
1187 (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p))
1188 (not (eobp)))
1189 (forward-line))
1190 (skip-syntax-backward "-")
1191 (setq close (point)))
1192 ;; If current line has a list marker, update levels, move to end of block
1193 ((looking-at markdown-regex-list)
1194 (setq levels (markdown-update-list-levels
1195 (match-string 2) (current-indentation) levels))
1196 (markdown-end-of-text-block))
1197 ;; If this is the end of the indentation level, adjust levels accordingly.
1198 ;; Only match end of indentation level if levels is not the empty list.
1199 ((and (car levels) (looking-at-p close-regexp))
1200 (setq levels (markdown-update-list-levels
1201 nil (current-indentation) levels))
1202 (markdown-end-of-text-block))
1203 (t (markdown-end-of-text-block))))
1205 (when (and open close)
1206 ;; Set text property data
1207 (put-text-property open close 'markdown-pre (list open close))
1208 ;; Recursively search again
1209 (markdown-syntax-propertize-pre-blocks (point) end)))))
1211 (defconst markdown-fenced-block-pairs
1212 `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin)
1213 (markdown-make-tilde-fence-regex markdown-tilde-fence-end)
1214 markdown-fenced-code)
1215 ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin)
1216 (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end)
1217 markdown-yaml-metadata-section)
1218 ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin)
1219 (,markdown-regex-gfm-code-block-close markdown-gfm-block-end)
1220 markdown-gfm-code))
1221 "Mapping of regular expressions to \"fenced-block\" constructs.
1222 These constructs are distinguished by having a distinctive start
1223 and end pattern, both of which take up an entire line of text,
1224 but no special pattern to identify text within the fenced
1225 blocks (unlike blockquotes and indented-code sections).
1227 Each element within this list takes the form:
1229 ((START-REGEX-OR-FUN START-PROPERTY)
1230 (END-REGEX-OR-FUN END-PROPERTY)
1231 MIDDLE-PROPERTY)
1233 Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
1234 function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
1235 arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
1236 which is the length of the first group of the START-REGEX-OR-FUN match, which
1237 can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
1238 evaluate these into \"real\" regexps.
1240 The *-PROPERTY elements are the text properties applied to each part of the
1241 block construct when it is matched using
1242 `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
1243 to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
1244 MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
1245 `match-data' when the regexp was matched to the text. In the case of
1246 MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with
1247 begin and end set to the edges of the \"middle\" text. This makes fontification
1248 easier.")
1250 (defun markdown-text-property-at-point (prop)
1251 (get-text-property (point) prop))
1253 (defsubst markdown-maybe-funcall-regexp (object &optional arg)
1254 (cond ((functionp object)
1255 (if arg (funcall object arg) (funcall object)))
1256 ((stringp object) object)
1257 (t (error "Object cannot be turned into regex"))))
1259 (defsubst markdown-get-start-fence-regexp ()
1260 "Return regexp to find all \"start\" sections of fenced block constructs.
1261 Which construct is actually contained in the match must be found separately."
1262 (mapconcat
1263 #'identity
1264 (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry)))
1265 markdown-fenced-block-pairs)
1266 "\\|"))
1268 (defun markdown-get-fenced-block-begin-properties ()
1269 (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs))
1271 (defun markdown-get-fenced-block-end-properties ()
1272 (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs))
1274 (defun markdown-get-fenced-block-middle-properties ()
1275 (cl-mapcar #'cl-third markdown-fenced-block-pairs))
1277 (defun markdown-find-previous-prop (prop &optional lim)
1278 "Find previous place where property PROP is non-nil, up to LIM.
1279 Return a cons of (pos . property). pos is point if point contains
1280 non-nil PROP."
1281 (let ((res
1282 (if (get-text-property (point) prop) (point)
1283 (previous-single-property-change
1284 (point) prop nil (or lim (point-min))))))
1285 (when (and (not (get-text-property res prop))
1286 (> res (point-min))
1287 (get-text-property (1- res) prop))
1288 (cl-decf res))
1289 (when (and res (get-text-property res prop)) (cons res prop))))
1291 (defun markdown-find-next-prop (prop &optional lim)
1292 "Find next place where property PROP is non-nil, up to LIM.
1293 Return a cons of (POS . PROPERTY) where POS is point if point
1294 contains non-nil PROP."
1295 (let ((res
1296 (if (get-text-property (point) prop) (point)
1297 (next-single-property-change
1298 (point) prop nil (or lim (point-max))))))
1299 (when (and res (get-text-property res prop)) (cons res prop))))
1301 (defun markdown-min-of-seq (map-fn seq)
1302 "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
1303 (cl-loop for el in seq
1304 with min = 1.0e+INF ; infinity
1305 with min-el = nil
1306 do (let ((res (funcall map-fn el)))
1307 (when (< res min)
1308 (setq min res)
1309 (setq min-el el)))
1310 finally return min-el))
1312 (defun markdown-max-of-seq (map-fn seq)
1313 "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
1314 (cl-loop for el in seq
1315 with max = -1.0e+INF ; negative infinity
1316 with max-el = nil
1317 do (let ((res (funcall map-fn el)))
1318 (when (and res (> res max))
1319 (setq max res)
1320 (setq max-el el)))
1321 finally return max-el))
1323 (defun markdown-find-previous-block ()
1324 "Find previous block.
1325 Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
1326 unable to propertize the entire block, but was able to propertize the beginning
1327 of the block. If so, return a cons of (pos . property) where the beginning of
1328 the block was propertized."
1329 (let ((start-pt (point))
1330 (closest-open
1331 (markdown-max-of-seq
1332 #'car
1333 (cl-remove-if
1334 #'null
1335 (cl-mapcar
1336 #'markdown-find-previous-prop
1337 (markdown-get-fenced-block-begin-properties))))))
1338 (when closest-open
1339 (let* ((length-of-open-match
1340 (let ((match-d
1341 (get-text-property (car closest-open) (cdr closest-open))))
1342 (- (cl-fourth match-d) (cl-third match-d))))
1343 (end-regexp
1344 (markdown-maybe-funcall-regexp
1345 (cl-caadr
1346 (cl-find-if
1347 (lambda (entry) (eq (cl-cadar entry) (cdr closest-open)))
1348 markdown-fenced-block-pairs))
1349 length-of-open-match))
1350 (end-prop-loc
1351 (save-excursion
1352 (save-match-data
1353 (goto-char (car closest-open))
1354 (and (re-search-forward end-regexp start-pt t)
1355 (match-beginning 0))))))
1356 (and (not end-prop-loc) closest-open)))))
1358 (defun markdown-get-fenced-block-from-start (prop)
1359 "Return limits of an enclosing fenced block from its start, using PROP.
1360 Return value is a list usable as `match-data'."
1361 (catch 'no-rest-of-block
1362 (let* ((correct-entry
1363 (cl-find-if
1364 (lambda (entry) (eq (cl-cadar entry) prop))
1365 markdown-fenced-block-pairs))
1366 (begin-of-begin (cl-first (markdown-text-property-at-point prop)))
1367 (middle-prop (cl-third correct-entry))
1368 (end-prop (cl-cadadr correct-entry))
1369 (end-of-end
1370 (save-excursion
1371 (goto-char (match-end 0)) ; end of begin
1372 (unless (eobp) (forward-char))
1373 (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
1374 (if (not mid-prop-v) ; no middle
1375 (progn
1376 ;; try to find end by advancing one
1377 (let ((end-prop-v
1378 (markdown-text-property-at-point end-prop)))
1379 (if end-prop-v (cl-second end-prop-v)
1380 (throw 'no-rest-of-block nil))))
1381 (set-match-data mid-prop-v)
1382 (goto-char (match-end 0)) ; end of middle
1383 (beginning-of-line) ; into end
1384 (cl-second (markdown-text-property-at-point end-prop)))))))
1385 (list begin-of-begin end-of-end))))
1387 (defun markdown-get-fenced-block-from-middle (prop)
1388 "Return limits of an enclosing fenced block from its middle, using PROP.
1389 Return value is a list usable as `match-data'."
1390 (let* ((correct-entry
1391 (cl-find-if
1392 (lambda (entry) (eq (cl-third entry) prop))
1393 markdown-fenced-block-pairs))
1394 (begin-prop (cl-cadar correct-entry))
1395 (begin-of-begin
1396 (save-excursion
1397 (goto-char (match-beginning 0))
1398 (unless (bobp) (forward-line -1))
1399 (beginning-of-line)
1400 (cl-first (markdown-text-property-at-point begin-prop))))
1401 (end-prop (cl-cadadr correct-entry))
1402 (end-of-end
1403 (save-excursion
1404 (goto-char (match-end 0))
1405 (beginning-of-line)
1406 (cl-second (markdown-text-property-at-point end-prop)))))
1407 (list begin-of-begin end-of-end)))
1409 (defun markdown-get-fenced-block-from-end (prop)
1410 "Return limits of an enclosing fenced block from its end, using PROP.
1411 Return value is a list usable as `match-data'."
1412 (let* ((correct-entry
1413 (cl-find-if
1414 (lambda (entry) (eq (cl-cadadr entry) prop))
1415 markdown-fenced-block-pairs))
1416 (end-of-end (cl-second (markdown-text-property-at-point prop)))
1417 (middle-prop (cl-third correct-entry))
1418 (begin-prop (cl-cadar correct-entry))
1419 (begin-of-begin
1420 (save-excursion
1421 (goto-char (match-beginning 0)) ; beginning of end
1422 (unless (bobp) (backward-char)) ; into middle
1423 (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
1424 (if (not mid-prop-v)
1425 (progn
1426 (beginning-of-line)
1427 (cl-first (markdown-text-property-at-point begin-prop)))
1428 (set-match-data mid-prop-v)
1429 (goto-char (match-beginning 0)) ; beginning of middle
1430 (unless (bobp) (forward-line -1)) ; into beginning
1431 (beginning-of-line)
1432 (cl-first (markdown-text-property-at-point begin-prop)))))))
1433 (list begin-of-begin end-of-end)))
1435 (defun markdown-get-enclosing-fenced-block-construct (&optional pos)
1436 "Get \"fake\" match data for block enclosing POS.
1437 Returns fake match data which encloses the start, middle, and end
1438 of the block construct enclosing POS, if it exists. Used in
1439 `markdown-code-block-at-pos'."
1440 (save-excursion
1441 (when pos (goto-char pos))
1442 (beginning-of-line)
1443 (car
1444 (cl-remove-if
1445 #'null
1446 (cl-mapcar
1447 (lambda (fun-and-prop)
1448 (cl-destructuring-bind (fun prop) fun-and-prop
1449 (when prop
1450 (save-match-data
1451 (set-match-data (markdown-text-property-at-point prop))
1452 (funcall fun prop)))))
1453 `((markdown-get-fenced-block-from-start
1454 ,(cl-find-if
1455 #'markdown-text-property-at-point
1456 (markdown-get-fenced-block-begin-properties)))
1457 (markdown-get-fenced-block-from-middle
1458 ,(cl-find-if
1459 #'markdown-text-property-at-point
1460 (markdown-get-fenced-block-middle-properties)))
1461 (markdown-get-fenced-block-from-end
1462 ,(cl-find-if
1463 #'markdown-text-property-at-point
1464 (markdown-get-fenced-block-end-properties)))))))))
1466 (defun markdown-propertize-end-match (reg end fence-spec middle-begin)
1467 "Get match for REG up to END, if exists, and propertize appropriately.
1468 FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
1469 MIDDLE-BEGIN is the start of the \"middle\" section of the block."
1470 (when (re-search-forward reg end t)
1471 (let ((close-begin (match-beginning 0)) ; Start of closing line.
1472 (close-end (match-end 0)) ; End of closing line.
1473 (close-data (match-data t))) ; Match data for closing line.
1474 ;; Propertize middle section of fenced block.
1475 (put-text-property middle-begin close-begin
1476 (cl-third fence-spec)
1477 (list middle-begin close-begin))
1478 ;; If the block is a YAML block, propertize the declarations inside
1479 (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)
1480 ;; Propertize closing line of fenced block.
1481 (put-text-property close-begin close-end
1482 (cl-cadadr fence-spec) close-data))))
1484 (defun markdown-syntax-propertize-fenced-block-constructs (start end)
1485 "Propertize according to `markdown-fenced-block-pairs' from START to END.
1486 If unable to propertize an entire block (if the start of a block is within START
1487 and END, but the end of the block is not), propertize the start section of a
1488 block, then in a subsequent call propertize both middle and end by finding the
1489 start which was previously propertized."
1490 (let ((start-reg (markdown-get-start-fence-regexp)))
1491 (save-excursion
1492 (goto-char start)
1493 ;; start from previous unclosed block, if exists
1494 (let ((prev-begin-block (markdown-find-previous-block)))
1495 (when prev-begin-block
1496 (let* ((correct-entry
1497 (cl-find-if (lambda (entry)
1498 (eq (cdr prev-begin-block) (cl-cadar entry)))
1499 markdown-fenced-block-pairs))
1500 (enclosed-text-start (1+ (car prev-begin-block)))
1501 (start-length
1502 (save-excursion
1503 (goto-char (car prev-begin-block))
1504 (string-match
1505 (markdown-maybe-funcall-regexp
1506 (caar correct-entry))
1507 (buffer-substring
1508 (point-at-bol) (point-at-eol)))
1509 (- (match-end 1) (match-beginning 1))))
1510 (end-reg (markdown-maybe-funcall-regexp
1511 (cl-caadr correct-entry) start-length)))
1512 (markdown-propertize-end-match
1513 end-reg end correct-entry enclosed-text-start))))
1514 ;; find all new blocks within region
1515 (while (re-search-forward start-reg end t)
1516 ;; we assume the opening constructs take up (only) an entire line,
1517 ;; so we re-check the current line
1518 (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol)))
1519 ;; find entry in `markdown-fenced-block-pairs' corresponding
1520 ;; to regex which was matched
1521 (correct-entry
1522 (cl-find-if
1523 (lambda (fenced-pair)
1524 (string-match-p
1525 (markdown-maybe-funcall-regexp (caar fenced-pair))
1526 cur-line))
1527 markdown-fenced-block-pairs))
1528 (enclosed-text-start
1529 (save-excursion (1+ (point-at-eol))))
1530 (end-reg
1531 (markdown-maybe-funcall-regexp
1532 (cl-caadr correct-entry)
1533 (if (and (match-beginning 1) (match-end 1))
1534 (- (match-end 1) (match-beginning 1))
1535 0))))
1536 ;; get correct match data
1537 (save-excursion
1538 (beginning-of-line)
1539 (re-search-forward
1540 (markdown-maybe-funcall-regexp (caar correct-entry))
1541 (point-at-eol)))
1542 ;; mark starting, even if ending is outside of region
1543 (put-text-property (match-beginning 0) (match-end 0)
1544 (cl-cadar correct-entry) (match-data t))
1545 (markdown-propertize-end-match
1546 end-reg end correct-entry enclosed-text-start))))))
1548 (defun markdown-syntax-propertize-blockquotes (start end)
1549 "Match blockquotes from START to END."
1550 (save-excursion
1551 (goto-char start)
1552 (while (and (re-search-forward markdown-regex-blockquote end t)
1553 (not (markdown-code-block-at-pos (match-beginning 0))))
1554 (put-text-property (match-beginning 0) (match-end 0)
1555 'markdown-blockquote
1556 (match-data t)))))
1558 (defun markdown-syntax-propertize-hrs (start end)
1559 "Match horizontal rules from START to END."
1560 (save-excursion
1561 (goto-char start)
1562 (while (re-search-forward markdown-regex-hr end t)
1563 (unless (or (markdown-on-heading-p)
1564 (markdown-code-block-at-point-p))
1565 (put-text-property (match-beginning 0) (match-end 0)
1566 'markdown-hr
1567 (match-data t))))))
1569 (defun markdown-syntax-propertize-yaml-metadata (start end)
1570 "Propertize elements inside YAML metadata blocks from START to END.
1571 Assumes region from START and END is already known to be the interior
1572 region of a YAML metadata block as propertized by
1573 `markdown-syntax-propertize-fenced-block-constructs'."
1574 (save-excursion
1575 (goto-char start)
1576 (cl-loop
1577 while (re-search-forward markdown-regex-declarative-metadata end t)
1578 do (progn
1579 (put-text-property (match-beginning 1) (match-end 1)
1580 'markdown-metadata-key (match-data t))
1581 (put-text-property (match-beginning 2) (match-end 2)
1582 'markdown-metadata-markup (match-data t))
1583 (put-text-property (match-beginning 3) (match-end 3)
1584 'markdown-metadata-value (match-data t))))))
1586 (defun markdown-syntax-propertize-headings (start end)
1587 "Match headings of type SYMBOL with REGEX from START to END."
1588 (goto-char start)
1589 (while (re-search-forward markdown-regex-header end t)
1590 (unless (markdown-code-block-at-pos (match-beginning 0))
1591 (put-text-property
1592 (match-beginning 0) (match-end 0) 'markdown-heading
1593 (match-data t))
1594 (put-text-property
1595 (match-beginning 0) (match-end 0)
1596 (cond ((match-string-no-properties 2) 'markdown-heading-1-setext)
1597 ((match-string-no-properties 3) 'markdown-heading-2-setext)
1598 (t (let ((atx-level (length (markdown-trim-whitespace
1599 (match-string-no-properties 4)))))
1600 (intern (format "markdown-heading-%d-atx" atx-level)))))
1601 (match-data t)))))
1603 (defun markdown-syntax-propertize-comments (start end)
1604 "Match HTML comments from the START to END."
1605 (let* ((in-comment (nth 4 (syntax-ppss))))
1606 (goto-char start)
1607 (cond
1608 ;; Comment start
1609 ((and (not in-comment)
1610 (re-search-forward markdown-regex-comment-start end t)
1611 (not (markdown-inline-code-at-point-p))
1612 (not (markdown-code-block-at-point-p)))
1613 (let ((open-beg (match-beginning 0)))
1614 (put-text-property open-beg (1+ open-beg)
1615 'syntax-table (string-to-syntax "<"))
1616 (markdown-syntax-propertize-comments
1617 (min (1+ (match-end 0)) end (point-max)) end)))
1618 ;; Comment end
1619 ((and in-comment
1620 (re-search-forward markdown-regex-comment-end end t))
1621 (let ((comment-end (match-end 0))
1622 (comment-begin (nth 8 (syntax-ppss))))
1623 (put-text-property (1- comment-end) comment-end
1624 'syntax-table (string-to-syntax ">"))
1625 ;; Remove any other text properties inside the comment
1626 (remove-text-properties comment-begin comment-end
1627 markdown--syntax-properties)
1628 (put-text-property comment-begin comment-end
1629 'markdown-comment (list comment-begin comment-end))
1630 (markdown-syntax-propertize-comments
1631 (min (1+ comment-end) end (point-max)) end)))
1632 ;; Nothing found
1633 (t nil))))
1635 (defun markdown-syntax-propertize (start end)
1636 "Function used as `syntax-propertize-function'.
1637 START and END delimit region to propertize."
1638 (with-silent-modifications
1639 (save-excursion
1640 (remove-text-properties start end markdown--syntax-properties)
1641 (markdown-syntax-propertize-fenced-block-constructs start end)
1642 (markdown-syntax-propertize-list-items start end)
1643 (markdown-syntax-propertize-pre-blocks start end)
1644 (markdown-syntax-propertize-blockquotes start end)
1645 (markdown-syntax-propertize-headings start end)
1646 (markdown-syntax-propertize-hrs start end)
1647 (markdown-syntax-propertize-comments start end))))
1650 ;;; Markup Hiding
1652 (defconst markdown-markup-properties
1653 '(face markdown-markup-face invisible markdown-markup)
1654 "List of properties and values to apply to markup.")
1656 (defconst markdown-language-keyword-properties
1657 '(face markdown-language-keyword-face invisible markdown-markup)
1658 "List of properties and values to apply to code block language names.")
1660 (defconst markdown-language-info-properties
1661 '(face markdown-language-info-face invisible markdown-markup)
1662 "List of properties and values to apply to code block language info strings.")
1664 (defconst markdown-include-title-properties
1665 '(face markdown-link-title-face invisible markdown-markup)
1666 "List of properties and values to apply to included code titles.")
1668 (defcustom markdown-hide-markup nil
1669 "Determines whether markup in the buffer will be hidden.
1670 When set to nil, all markup is displayed in the buffer as it
1671 appears in the file. An exception is when `markdown-hide-urls'
1672 is non-nil.
1673 Set this to a non-nil value to turn this feature on by default.
1674 You can interactively toggle the value of this variable with
1675 `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
1676 or from the Markdown > Show & Hide menu.
1678 Markup hiding works by adding text properties to positions in the
1679 buffer---either the `invisible' property or the `display' property
1680 in cases where alternative glyphs are used (e.g., list bullets).
1681 This does not, however, affect printing or other output.
1682 Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
1683 not honor these text properties. For printing, it would be better
1684 to first convert to HTML or PDF (e.g,. using Pandoc)."
1685 :group 'markdown
1686 :type 'boolean
1687 :safe 'booleanp
1688 :package-version '(markdown-mode . "2.3"))
1689 (make-variable-buffer-local 'markdown-hide-markup)
1691 (defun markdown-toggle-markup-hiding (&optional arg)
1692 "Toggle the display or hiding of markup.
1693 With a prefix argument ARG, enable markup hiding if ARG is positive,
1694 and disable it otherwise.
1695 See `markdown-hide-markup' for additional details."
1696 (interactive (list (or current-prefix-arg 'toggle)))
1697 (setq markdown-hide-markup
1698 (if (eq arg 'toggle)
1699 (not markdown-hide-markup)
1700 (> (prefix-numeric-value arg) 0)))
1701 (if markdown-hide-markup
1702 (progn (add-to-invisibility-spec 'markdown-markup)
1703 (message "markdown-mode markup hiding enabled"))
1704 (progn (remove-from-invisibility-spec 'markdown-markup)
1705 (message "markdown-mode markup hiding disabled")))
1706 (markdown-reload-extensions))
1709 ;;; Font Lock =================================================================
1711 (require 'font-lock)
1713 (defvar markdown-italic-face 'markdown-italic-face
1714 "Face name to use for italic text.")
1716 (defvar markdown-bold-face 'markdown-bold-face
1717 "Face name to use for bold text.")
1719 (defvar markdown-strike-through-face 'markdown-strike-through-face
1720 "Face name to use for strike-through text.")
1722 (defvar markdown-header-delimiter-face 'markdown-header-delimiter-face
1723 "Face name to use as a base for header delimiters.")
1725 (defvar markdown-header-rule-face 'markdown-header-rule-face
1726 "Face name to use as a base for header rules.")
1728 (defvar markdown-header-face 'markdown-header-face
1729 "Face name to use as a base for headers.")
1731 (defvar markdown-header-face-1 'markdown-header-face-1
1732 "Face name to use for level-1 headers.")
1734 (defvar markdown-header-face-2 'markdown-header-face-2
1735 "Face name to use for level-2 headers.")
1737 (defvar markdown-header-face-3 'markdown-header-face-3
1738 "Face name to use for level-3 headers.")
1740 (defvar markdown-header-face-4 'markdown-header-face-4
1741 "Face name to use for level-4 headers.")
1743 (defvar markdown-header-face-5 'markdown-header-face-5
1744 "Face name to use for level-5 headers.")
1746 (defvar markdown-header-face-6 'markdown-header-face-6
1747 "Face name to use for level-6 headers.")
1749 (defvar markdown-inline-code-face 'markdown-inline-code-face
1750 "Face name to use for inline code.")
1752 (defvar markdown-list-face 'markdown-list-face
1753 "Face name to use for list markers.")
1755 (defvar markdown-blockquote-face 'markdown-blockquote-face
1756 "Face name to use for blockquote.")
1758 (defvar markdown-pre-face 'markdown-pre-face
1759 "Face name to use for preformatted text.")
1761 (defvar markdown-language-keyword-face 'markdown-language-keyword-face
1762 "Face name to use for programming language identifiers.")
1764 (defvar markdown-language-info-face 'markdown-language-info-face
1765 "Face name to use for programming info strings.")
1767 (defvar markdown-link-face 'markdown-link-face
1768 "Face name to use for links.")
1770 (defvar markdown-missing-link-face 'markdown-missing-link-face
1771 "Face name to use for links where the linked file does not exist.")
1773 (defvar markdown-reference-face 'markdown-reference-face
1774 "Face name to use for reference.")
1776 (defvar markdown-footnote-marker-face 'markdown-footnote-marker-face
1777 "Face name to use for footnote markers.")
1779 (defvar markdown-url-face 'markdown-url-face
1780 "Face name to use for URLs.")
1782 (defvar markdown-link-title-face 'markdown-link-title-face
1783 "Face name to use for reference link titles.")
1785 (defvar markdown-line-break-face 'markdown-line-break-face
1786 "Face name to use for hard line breaks.")
1788 (defvar markdown-comment-face 'markdown-comment-face
1789 "Face name to use for HTML comments.")
1791 (defvar markdown-math-face 'markdown-math-face
1792 "Face name to use for LaTeX expressions.")
1794 (defvar markdown-metadata-key-face 'markdown-metadata-key-face
1795 "Face name to use for metadata keys.")
1797 (defvar markdown-metadata-value-face 'markdown-metadata-value-face
1798 "Face name to use for metadata values.")
1800 (defvar markdown-gfm-checkbox-face 'markdown-gfm-checkbox-face
1801 "Face name to use for GFM checkboxes.")
1803 (defvar markdown-highlight-face 'markdown-highlight-face
1804 "Face name to use for mouse highlighting.")
1806 (defvar markdown-markup-face 'markdown-markup-face
1807 "Face name to use for markup elements.")
1809 (make-obsolete-variable 'markdown-italic-face "Use face name directly" "v2.4")
1810 (make-obsolete-variable 'markdown-bold-face "Use face name directly" "v2.4")
1811 (make-obsolete-variable 'markdown-strike-through-face "Use face name directly" "v2.4")
1812 (make-obsolete-variable 'markdown-header-delimiter-face "Use face name directly" "v2.4")
1813 (make-obsolete-variable 'markdown-header-rule-face "Use face name directly" "v2.4")
1814 (make-obsolete-variable 'markdown-header-face "Use face name directly" "v2.4")
1815 (make-obsolete-variable 'markdown-header-face-1 "Use face name directly" "v2.4")
1816 (make-obsolete-variable 'markdown-header-face-2 "Use face name directly" "v2.4")
1817 (make-obsolete-variable 'markdown-header-face-3 "Use face name directly" "v2.4")
1818 (make-obsolete-variable 'markdown-header-face-4 "Use face name directly" "v2.4")
1819 (make-obsolete-variable 'markdown-header-face-5 "Use face name directly" "v2.4")
1820 (make-obsolete-variable 'markdown-header-face-6 "Use face name directly" "v2.4")
1821 (make-obsolete-variable 'markdown-inline-code-face "Use face name directly" "v2.4")
1822 (make-obsolete-variable 'markdown-list-face "Use face name directly" "v2.4")
1823 (make-obsolete-variable 'markdown-blockquote-face "Use face name directly" "v2.4")
1824 (make-obsolete-variable 'markdown-pre-face "Use face name directly" "v2.4")
1825 (make-obsolete-variable 'markdown-language-keyword-face "Use face name directly" "v2.4")
1826 (make-obsolete-variable 'markdown-language-info-face "Use face name directly" "v2.4")
1827 (make-obsolete-variable 'markdown-link-face "Use face name directly" "v2.4")
1828 (make-obsolete-variable 'markdown-missing-link-face "Use face name directly" "v2.4")
1829 (make-obsolete-variable 'markdown-reference-face "Use face name directly" "v2.4")
1830 (make-obsolete-variable 'markdown-footnote-marker-face "Use face name directly" "v2.4")
1831 (make-obsolete-variable 'markdown-url-face "Use face name directly" "v2.4")
1832 (make-obsolete-variable 'markdown-link-title-face "Use face name directly" "v2.4")
1833 (make-obsolete-variable 'markdown-line-break-face "Use face name directly" "v2.4")
1834 (make-obsolete-variable 'markdown-comment-face "Use face name directly" "v2.4")
1835 (make-obsolete-variable 'markdown-math-face "Use face name directly" "v2.4")
1836 (make-obsolete-variable 'markdown-metadata-key-face "Use face name directly" "v2.4")
1837 (make-obsolete-variable 'markdown-metadata-value-face "Use face name directly" "v2.4")
1838 (make-obsolete-variable 'markdown-gfm-checkbox-face "Use face name directly" "v2.4")
1839 (make-obsolete-variable 'markdown-highlight-face "Use face name directly" "v2.4")
1840 (make-obsolete-variable 'markdown-markup-face "Use face name directly" "v2.4")
1842 (defgroup markdown-faces nil
1843 "Faces used in Markdown Mode"
1844 :group 'markdown
1845 :group 'faces)
1847 (defface markdown-italic-face
1848 '((t (:inherit italic)))
1849 "Face for italic text."
1850 :group 'markdown-faces)
1852 (defface markdown-bold-face
1853 '((t (:inherit bold)))
1854 "Face for bold text."
1855 :group 'markdown-faces)
1857 (defface markdown-strike-through-face
1858 '((t (:strike-through t)))
1859 "Face for strike-through text."
1860 :group 'markdown-faces)
1862 (defface markdown-markup-face
1863 '((t (:inherit shadow :slant normal :weight normal)))
1864 "Face for markup elements."
1865 :group 'markdown-faces)
1867 (defface markdown-header-rule-face
1868 '((t (:inherit markdown-markup-face)))
1869 "Base face for headers rules."
1870 :group 'markdown-faces)
1872 (defface markdown-header-delimiter-face
1873 '((t (:inherit markdown-markup-face)))
1874 "Base face for headers hash delimiter."
1875 :group 'markdown-faces)
1877 (defface markdown-list-face
1878 '((t (:inherit markdown-markup-face)))
1879 "Face for list item markers."
1880 :group 'markdown-faces)
1882 (defface markdown-blockquote-face
1883 '((t (:inherit font-lock-doc-face)))
1884 "Face for blockquote sections."
1885 :group 'markdown-faces)
1887 (defface markdown-code-face
1888 '((t (:inherit fixed-pitch)))
1889 "Face for inline code, pre blocks, and fenced code blocks.
1890 This may be used, for example, to add a contrasting background to
1891 inline code fragments and code blocks."
1892 :group 'markdown-faces)
1894 (defface markdown-inline-code-face
1895 '((t (:inherit (markdown-code-face font-lock-constant-face))))
1896 "Face for inline code."
1897 :group 'markdown-faces)
1899 (defface markdown-pre-face
1900 '((t (:inherit (markdown-code-face font-lock-constant-face))))
1901 "Face for preformatted text."
1902 :group 'markdown-faces)
1904 (defface markdown-table-face
1905 '((t (:inherit (markdown-code-face))))
1906 "Face for tables."
1907 :group 'markdown-faces)
1909 (defface markdown-language-keyword-face
1910 '((t (:inherit font-lock-type-face)))
1911 "Face for programming language identifiers."
1912 :group 'markdown-faces)
1914 (defface markdown-language-info-face
1915 '((t (:inherit font-lock-string-face)))
1916 "Face for programming language info strings."
1917 :group 'markdown-faces)
1919 (defface markdown-link-face
1920 '((t (:inherit link)))
1921 "Face for links."
1922 :group 'markdown-faces)
1924 (defface markdown-missing-link-face
1925 '((t (:inherit font-lock-warning-face)))
1926 "Face for missing links."
1927 :group 'markdown-faces)
1929 (defface markdown-reference-face
1930 '((t (:inherit markdown-markup-face)))
1931 "Face for link references."
1932 :group 'markdown-faces)
1934 (define-obsolete-face-alias 'markdown-footnote-face
1935 'markdown-footnote-marker-face "v2.3")
1937 (defface markdown-footnote-marker-face
1938 '((t (:inherit markdown-markup-face)))
1939 "Face for footnote markers."
1940 :group 'markdown-faces)
1942 (defface markdown-footnote-text-face
1943 '((t (:inherit font-lock-comment-face)))
1944 "Face for footnote text."
1945 :group 'markdown-faces)
1947 (defface markdown-url-face
1948 '((t (:inherit font-lock-string-face)))
1949 "Face for URLs that are part of markup.
1950 For example, this applies to URLs in inline links:
1951 [link text](http://example.com/)."
1952 :group 'markdown-faces)
1954 (defface markdown-plain-url-face
1955 '((t (:inherit markdown-link-face)))
1956 "Face for URLs that are also links.
1957 For example, this applies to plain angle bracket URLs:
1958 <http://example.com/>."
1959 :group 'markdown-faces)
1961 (defface markdown-link-title-face
1962 '((t (:inherit font-lock-comment-face)))
1963 "Face for reference link titles."
1964 :group 'markdown-faces)
1966 (defface markdown-line-break-face
1967 '((t (:inherit font-lock-constant-face :underline t)))
1968 "Face for hard line breaks."
1969 :group 'markdown-faces)
1971 (defface markdown-comment-face
1972 '((t (:inherit font-lock-comment-face)))
1973 "Face for HTML comments."
1974 :group 'markdown-faces)
1976 (defface markdown-math-face
1977 '((t (:inherit font-lock-string-face)))
1978 "Face for LaTeX expressions."
1979 :group 'markdown-faces)
1981 (defface markdown-metadata-key-face
1982 '((t (:inherit font-lock-variable-name-face)))
1983 "Face for metadata keys."
1984 :group 'markdown-faces)
1986 (defface markdown-metadata-value-face
1987 '((t (:inherit font-lock-string-face)))
1988 "Face for metadata values."
1989 :group 'markdown-faces)
1991 (defface markdown-gfm-checkbox-face
1992 '((t (:inherit font-lock-builtin-face)))
1993 "Face for GFM checkboxes."
1994 :group 'markdown-faces)
1996 (defface markdown-highlight-face
1997 '((t (:inherit highlight)))
1998 "Face for mouse highlighting."
1999 :group 'markdown-faces)
2001 (defface markdown-hr-face
2002 '((t (:inherit markdown-markup-face)))
2003 "Face for horizontal rules."
2004 :group 'markdown-faces)
2006 (defface markdown-html-tag-name-face
2007 '((t (:inherit font-lock-type-face)))
2008 "Face for HTML tag names."
2009 :group 'markdown-faces)
2011 (defface markdown-html-tag-delimiter-face
2012 '((t (:inherit markdown-markup-face)))
2013 "Face for HTML tag delimiters."
2014 :group 'markdown-faces)
2016 (defface markdown-html-attr-name-face
2017 '((t (:inherit font-lock-variable-name-face)))
2018 "Face for HTML attribute names."
2019 :group 'markdown-faces)
2021 (defface markdown-html-attr-value-face
2022 '((t (:inherit font-lock-string-face)))
2023 "Face for HTML attribute values."
2024 :group 'markdown-faces)
2026 (defface markdown-html-entity-face
2027 '((t (:inherit font-lock-variable-name-face)))
2028 "Face for HTML entities."
2029 :group 'markdown-faces)
2031 (defcustom markdown-header-scaling nil
2032 "Whether to use variable-height faces for headers.
2033 When non-nil, `markdown-header-face' will inherit from
2034 `variable-pitch' and the scaling values in
2035 `markdown-header-scaling-values' will be applied to
2036 headers of levels one through six respectively."
2037 :type 'boolean
2038 :initialize 'custom-initialize-default
2039 :set (lambda (symbol value)
2040 (set-default symbol value)
2041 (markdown-update-header-faces value))
2042 :group 'markdown-faces
2043 :package-version '(markdown-mode . "2.2"))
2045 (defcustom markdown-header-scaling-values
2046 '(2.0 1.7 1.4 1.1 1.0 1.0)
2047 "List of scaling values for headers of level one through six.
2048 Used when `markdown-header-scaling' is non-nil."
2049 :type 'list
2050 :initialize 'custom-initialize-default
2051 :set (lambda (symbol value)
2052 (set-default symbol value)
2053 (markdown-update-header-faces markdown-header-scaling value))
2054 :group 'markdown-faces)
2056 (defun markdown-make-header-faces ()
2057 "Build the faces used for Markdown headers."
2058 (let ((inherit-faces '(font-lock-function-name-face)))
2059 (when markdown-header-scaling
2060 (setq inherit-faces (cons 'variable-pitch inherit-faces)))
2061 (defface markdown-header-face
2062 `((t (:inherit ,inherit-faces :weight bold)))
2063 "Base face for headers."
2064 :group 'markdown-faces))
2065 (dotimes (num 6)
2066 (let* ((num1 (1+ num))
2067 (face-name (intern (format "markdown-header-face-%s" num1)))
2068 (scale (if markdown-header-scaling
2069 (float (nth num markdown-header-scaling-values))
2070 1.0)))
2071 (eval
2072 `(defface ,face-name
2073 '((t (:inherit markdown-header-face :height ,scale)))
2074 (format "Face for level %s headers.
2075 You probably don't want to customize this face directly. Instead
2076 you can customize the base face `markdown-header-face' or the
2077 variable-height variable `markdown-header-scaling'." ,num1)
2078 :group 'markdown-faces)))))
2080 (markdown-make-header-faces)
2082 (defun markdown-update-header-faces (&optional scaling scaling-values)
2083 "Update header faces, depending on if header SCALING is desired.
2084 If so, use given list of SCALING-VALUES relative to the baseline
2085 size of `markdown-header-face'."
2086 (dotimes (num 6)
2087 (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num))))
2088 (scale (cond ((not scaling) 1.0)
2089 (scaling-values (float (nth num scaling-values)))
2090 (t (float (nth num markdown-header-scaling-values))))))
2091 (unless (get face-name 'saved-face) ; Don't update customized faces
2092 (set-face-attribute face-name nil :height scale)))))
2094 (defun markdown-syntactic-face (state)
2095 "Return font-lock face for characters with given STATE.
2096 See `font-lock-syntactic-face-function' for details."
2097 (let ((in-comment (nth 4 state)))
2098 (cond
2099 (in-comment 'markdown-comment-face)
2100 (t nil))))
2102 (defcustom markdown-list-item-bullets
2103 '("●" "◎" "○" "◆" "◇" "►" "•")
2104 "List of bullets to use for unordered lists.
2105 It can contain any number of symbols, which will be repeated.
2106 Depending on your font, some reasonable choices are:
2107 ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸."
2108 :group 'markdown
2109 :type '(repeat (string :tag "Bullet character"))
2110 :package-version '(markdown-mode . "2.3"))
2112 (defun markdown--footnote-marker-properties ()
2113 "Return a font-lock facespec expression for footnote marker text."
2114 `(face markdown-footnote-marker-face
2115 ,@(when markdown-hide-markup
2116 `(display ,markdown-footnote-display))))
2118 (defun markdown--pandoc-inline-footnote-properties ()
2119 "Return a font-lock facespec expression for Pandoc inline footnote text."
2120 `(face markdown-footnote-text-face
2121 ,@(when markdown-hide-markup
2122 `(display ,markdown-footnote-display))))
2124 (defvar markdown-mode-font-lock-keywords
2125 `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face)))
2126 (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face)))
2127 (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face)
2128 (2 'markdown-markup-face)
2129 (3 'markdown-metadata-value-face)))
2130 (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties)
2131 (2 markdown-markup-properties nil t)
2132 (3 markdown-language-keyword-properties nil t)
2133 (4 markdown-language-info-properties nil t)
2134 (5 markdown-markup-properties nil t)))
2135 (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties)))
2136 (markdown-fontify-gfm-code-blocks)
2137 (markdown-fontify-tables)
2138 (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties)
2139 (2 markdown-markup-properties nil t)
2140 (3 markdown-language-keyword-properties nil t)
2141 (4 markdown-language-info-properties nil t)
2142 (5 markdown-markup-properties nil t)))
2143 (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties)))
2144 (markdown-fontify-fenced-code-blocks)
2145 (markdown-match-pre-blocks . ((0 'markdown-pre-face)))
2146 (markdown-fontify-headings)
2147 (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face)
2148 (2 'markdown-markup-face)
2149 (3 'markdown-metadata-value-face)))
2150 (markdown-match-pandoc-metadata . ((1 'markdown-markup-face)
2151 (2 'markdown-markup-face)
2152 (3 'markdown-metadata-value-face)))
2153 (markdown-fontify-hrs)
2154 (markdown-match-code . ((1 markdown-markup-properties prepend)
2155 (2 'markdown-inline-code-face prepend)
2156 (3 markdown-markup-properties prepend)))
2157 (,markdown-regex-kbd . ((1 markdown-markup-properties)
2158 (2 'markdown-inline-code-face)
2159 (3 markdown-markup-properties)))
2160 (markdown-fontify-angle-uris)
2161 (,markdown-regex-email . 'markdown-plain-url-face)
2162 (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t)
2163 (2 'markdown-html-tag-name-face t)
2164 (3 'markdown-html-tag-delimiter-face t)
2165 ;; Anchored matcher for HTML tag attributes
2166 (,markdown-regex-html-attr
2167 ;; Before searching, move past tag
2168 ;; name; set limit at tag close.
2169 (progn
2170 (goto-char (match-end 2)) (match-end 3))
2172 . ((1 'markdown-html-attr-name-face)
2173 (3 'markdown-html-tag-delimiter-face nil t)
2174 (4 'markdown-html-attr-value-face nil t)))))
2175 (,markdown-regex-html-entity . 'markdown-html-entity-face)
2176 (markdown-fontify-list-items)
2177 (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^
2178 (2 (markdown--footnote-marker-properties)) ; label
2179 (3 markdown-markup-properties))) ; ]
2180 (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^
2181 (2 markdown-markup-properties) ; [
2182 (3 (markdown--pandoc-inline-footnote-properties)) ; text
2183 (4 markdown-markup-properties))) ; ]
2184 (markdown-match-includes . ((1 markdown-markup-properties)
2185 (2 markdown-markup-properties nil t)
2186 (3 markdown-include-title-properties nil t)
2187 (4 markdown-markup-properties nil t)
2188 (5 markdown-markup-properties)
2189 (6 'markdown-url-face)
2190 (7 markdown-markup-properties)))
2191 (markdown-fontify-inline-links)
2192 (markdown-fontify-reference-links)
2193 (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [
2194 (2 'markdown-reference-face) ; label
2195 (3 'markdown-markup-face) ; ]
2196 (4 'markdown-markup-face) ; :
2197 (5 'markdown-url-face) ; url
2198 (6 'markdown-link-title-face))) ; "title" (optional)
2199 (markdown-fontify-plain-uris)
2200 ;; Math mode $..$
2201 (markdown-match-math-single . ((1 'markdown-markup-face prepend)
2202 (2 'markdown-math-face append)
2203 (3 'markdown-markup-face prepend)))
2204 ;; Math mode $$..$$
2205 (markdown-match-math-double . ((1 'markdown-markup-face prepend)
2206 (2 'markdown-math-face append)
2207 (3 'markdown-markup-face prepend)))
2208 ;; Math mode \[..\] and \\[..\\]
2209 (markdown-match-math-display . ((1 'markdown-markup-face prepend)
2210 (3 'markdown-math-face append)
2211 (4 'markdown-markup-face prepend)))
2212 (markdown-match-bold . ((1 markdown-markup-properties prepend)
2213 (2 'markdown-bold-face append)
2214 (3 markdown-markup-properties prepend)))
2215 (markdown-match-italic . ((1 markdown-markup-properties prepend)
2216 (2 'markdown-italic-face append)
2217 (3 markdown-markup-properties prepend)))
2218 (,markdown-regex-strike-through . ((3 markdown-markup-properties)
2219 (4 'markdown-strike-through-face)
2220 (5 markdown-markup-properties)))
2221 (,markdown-regex-line-break . (1 'markdown-line-break-face prepend))
2222 (markdown-fontify-sub-superscripts)
2223 (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend)))
2224 (markdown-match-leanpub-sections . ((0 markdown-markup-properties)))
2225 (markdown-fontify-blockquotes)
2226 (markdown-match-wiki-link . ((0 'markdown-link-face prepend))))
2227 "Syntax highlighting for Markdown files.")
2229 (define-obsolete-variable-alias
2230 'markdown-mode-font-lock-keywords-basic
2231 'markdown-mode-font-lock-keywords "v2.4")
2233 ;; Footnotes
2234 (defvar markdown-footnote-counter 0
2235 "Counter for footnote numbers.")
2236 (make-variable-buffer-local 'markdown-footnote-counter)
2238 (defconst markdown-footnote-chars
2239 "[[:alnum:]-]"
2240 "Regular expression matching any character that is allowed in a footnote identifier.")
2242 (defconst markdown-regex-footnote-definition
2243 (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)")
2244 "Regular expression matching a footnote definition, capturing the label.")
2247 ;;; Compatibility =============================================================
2249 (defun markdown-replace-regexp-in-string (regexp rep string)
2250 "Replace ocurrences of REGEXP with REP in STRING.
2251 This is a compatibility wrapper to provide `replace-regexp-in-string'
2252 in XEmacs 21."
2253 (if (featurep 'xemacs)
2254 (replace-in-string string regexp rep)
2255 (replace-regexp-in-string regexp rep string)))
2257 ;; `markdown-use-region-p' is a compatibility function which checks
2258 ;; for an active region, with fallbacks for older Emacsen and XEmacs.
2259 (eval-and-compile
2260 (cond
2261 ;; Emacs 24 and newer
2262 ((fboundp 'use-region-p)
2263 (defalias 'markdown-use-region-p 'use-region-p))
2264 ;; XEmacs
2265 ((fboundp 'region-active-p)
2266 (defalias 'markdown-use-region-p 'region-active-p))))
2268 ;; Use new names for outline-mode functions in Emacs 25 and later.
2269 (eval-and-compile
2270 (defalias 'markdown-hide-sublevels
2271 (if (fboundp 'outline-hide-sublevels)
2272 'outline-hide-sublevels
2273 'hide-sublevels))
2274 (defalias 'markdown-show-all
2275 (if (fboundp 'outline-show-all)
2276 'outline-show-all
2277 'show-all))
2278 (defalias 'markdown-hide-body
2279 (if (fboundp 'outline-hide-body)
2280 'outline-hide-body
2281 'hide-body))
2282 (defalias 'markdown-show-children
2283 (if (fboundp 'outline-show-children)
2284 'outline-show-children
2285 'show-children))
2286 (defalias 'markdown-show-subtree
2287 (if (fboundp 'outline-show-subtree)
2288 'outline-show-subtree
2289 'show-subtree))
2290 (defalias 'markdown-hide-subtree
2291 (if (fboundp 'outline-hide-subtree)
2292 'outline-hide-subtree
2293 'hide-subtree)))
2295 ;; Provide directory-name-p to Emacs 24
2296 (defsubst markdown-directory-name-p (name)
2297 "Return non-nil if NAME ends with a directory separator character.
2298 Taken from `directory-name-p' from Emacs 25 and provided here for
2299 backwards compatibility."
2300 (let ((len (length name))
2301 (lastc ?.))
2302 (if (> len 0)
2303 (setq lastc (aref name (1- len))))
2304 (or (= lastc ?/)
2305 (and (memq system-type '(windows-nt ms-dos))
2306 (= lastc ?\\)))))
2308 ;; Provide a function to find files recursively in Emacs 24.
2309 (defalias 'markdown-directory-files-recursively
2310 (if (fboundp 'directory-files-recursively)
2311 'directory-files-recursively
2312 (lambda (dir regexp)
2313 "Return list of all files under DIR that have file names matching REGEXP.
2314 This function works recursively. Files are returned in \"depth first\"
2315 order, and files from each directory are sorted in alphabetical order.
2316 Each file name appears in the returned list in its absolute form.
2317 Based on `directory-files-recursively' from Emacs 25 and provided
2318 here for backwards compatibility."
2319 (let ((result nil)
2320 (files nil)
2321 ;; When DIR is "/", remote file names like "/method:" could
2322 ;; also be offered. We shall suppress them.
2323 (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
2324 (dolist (file (sort (file-name-all-completions "" dir)
2325 'string<))
2326 (unless (member file '("./" "../"))
2327 (if (markdown-directory-name-p file)
2328 (let* ((leaf (substring file 0 (1- (length file))))
2329 (full-file (expand-file-name leaf dir)))
2330 (setq result
2331 (nconc result (markdown-directory-files-recursively
2332 full-file regexp))))
2333 (when (string-match-p regexp file)
2334 (push (expand-file-name file dir) files)))))
2335 (nconc result (nreverse files))))))
2337 (defun markdown-flyspell-check-word-p ()
2338 "Return t if `flyspell' should check word just before point.
2339 Used for `flyspell-generic-check-word-predicate'."
2340 (save-excursion
2341 (goto-char (1- (point)))
2342 (not (or (markdown-code-block-at-point-p)
2343 (markdown-inline-code-at-point-p)
2344 (markdown-in-comment-p)
2345 (let ((faces (get-text-property (point) 'face)))
2346 (if (listp faces)
2347 (or (memq 'markdown-reference-face faces)
2348 (memq 'markdown-markup-face faces)
2349 (memq 'markdown-plain-url-face faces)
2350 (memq 'markdown-inline-code-face faces)
2351 (memq 'markdown-url-face faces))
2352 (memq faces '(markdown-reference-face
2353 markdown-markup-face
2354 markdown-plain-url-face
2355 markdown-inline-code-face
2356 markdown-url-face))))))))
2358 (defun markdown-font-lock-ensure ()
2359 "Provide `font-lock-ensure' in Emacs 24."
2360 (if (fboundp 'font-lock-ensure)
2361 (font-lock-ensure)
2362 (with-no-warnings
2363 ;; Suppress warning about non-interactive use of
2364 ;; `font-lock-fontify-buffer' in Emacs 25.
2365 (font-lock-fontify-buffer))))
2368 ;;; Markdown Parsing Functions ================================================
2370 (define-obsolete-function-alias
2371 'markdown-cur-line-blank 'markdown-cur-line-blank-p "v2.4")
2372 (define-obsolete-function-alias
2373 'markdown-next-line-blank 'markdown-next-line-blank-p "v2.4")
2375 (defun markdown-cur-line-blank-p ()
2376 "Return t if the current line is blank and nil otherwise."
2377 (save-excursion
2378 (beginning-of-line)
2379 (looking-at-p markdown-regex-blank-line)))
2381 (defun markdown-prev-line-blank ()
2382 "Return t if the previous line is blank and nil otherwise.
2383 If we are at the first line, then consider the previous line to be blank."
2384 (or (= (line-beginning-position) (point-min))
2385 (save-excursion
2386 (forward-line -1)
2387 (looking-at markdown-regex-blank-line))))
2389 (defun markdown-prev-line-blank-p ()
2390 "Like `markdown-prev-line-blank', but preserve `match-data'."
2391 (save-match-data (markdown-prev-line-blank)))
2393 (defun markdown-next-line-blank-p ()
2394 "Return t if the next line is blank and nil otherwise.
2395 If we are at the last line, then consider the next line to be blank."
2396 (or (= (line-end-position) (point-max))
2397 (save-excursion
2398 (forward-line 1)
2399 (markdown-cur-line-blank-p))))
2401 (defun markdown-prev-line-indent ()
2402 "Return the number of leading whitespace characters in the previous line.
2403 Return 0 if the current line is the first line in the buffer."
2404 (save-excursion
2405 (if (= (line-beginning-position) (point-min))
2407 (forward-line -1)
2408 (current-indentation))))
2410 (defun markdown-next-line-indent ()
2411 "Return the number of leading whitespace characters in the next line.
2412 Return 0 if line is the last line in the buffer."
2413 (save-excursion
2414 (if (= (line-end-position) (point-max))
2416 (forward-line 1)
2417 (current-indentation))))
2419 (defun markdown-new-baseline ()
2420 "Determine if the current line begins a new baseline level.
2421 Assume point is positioned at beginning of line."
2422 (or (looking-at markdown-regex-header)
2423 (looking-at markdown-regex-hr)
2424 (and (= (current-indentation) 0)
2425 (not (looking-at markdown-regex-list))
2426 (markdown-prev-line-blank))))
2428 (defun markdown-search-backward-baseline ()
2429 "Search backward baseline point with no indentation and not a list item."
2430 (end-of-line)
2431 (let (stop)
2432 (while (not (or stop (bobp)))
2433 (re-search-backward markdown-regex-block-separator-noindent nil t)
2434 (when (match-end 2)
2435 (goto-char (match-end 2))
2436 (cond
2437 ((markdown-new-baseline)
2438 (setq stop t))
2439 ((looking-at-p markdown-regex-list)
2440 (setq stop nil))
2441 (t (setq stop t)))))))
2443 (defun markdown-update-list-levels (marker indent levels)
2444 "Update list levels given list MARKER, block INDENT, and current LEVELS.
2445 Here, MARKER is a string representing the type of list, INDENT is an integer
2446 giving the indentation, in spaces, of the current block, and LEVELS is a
2447 list of the indentation levels of parent list items. When LEVELS is nil,
2448 it means we are at baseline (not inside of a nested list)."
2449 (cond
2450 ;; New list item at baseline.
2451 ((and marker (null levels))
2452 (setq levels (list indent)))
2453 ;; List item with greater indentation (four or more spaces).
2454 ;; Increase list level.
2455 ((and marker (>= indent (+ (car levels) 4)))
2456 (setq levels (cons indent levels)))
2457 ;; List item with greater or equal indentation (less than four spaces).
2458 ;; Do not increase list level.
2459 ((and marker (>= indent (car levels)))
2460 levels)
2461 ;; Lesser indentation level.
2462 ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
2463 ;; indentation could move back more than one list level). Note
2464 ;; that this block need not be the beginning of list item.
2465 ((< indent (car levels))
2466 (while (and (> (length levels) 1)
2467 (< indent (+ (cadr levels) 4)))
2468 (setq levels (cdr levels)))
2469 levels)
2470 ;; Otherwise, do nothing.
2471 (t levels)))
2473 (defun markdown-calculate-list-levels ()
2474 "Calculate list levels at point.
2475 Return a list of the form (n1 n2 n3 ...) where n1 is the
2476 indentation of the deepest nested list item in the branch of
2477 the list at the point, n2 is the indentation of the parent
2478 list item, and so on. The depth of the list item is therefore
2479 the length of the returned list. If the point is not at or
2480 immediately after a list item, return nil."
2481 (save-excursion
2482 (let ((first (point)) levels indent pre-regexp)
2483 ;; Find a baseline point with zero list indentation
2484 (markdown-search-backward-baseline)
2485 ;; Search for all list items between baseline and LOC
2486 (while (and (< (point) first)
2487 (re-search-forward markdown-regex-list first t))
2488 (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels))))
2489 (beginning-of-line)
2490 (cond
2491 ;; Make sure this is not a header or hr
2492 ((markdown-new-baseline) (setq levels nil))
2493 ;; Make sure this is not a line from a pre block
2494 ((looking-at-p pre-regexp))
2495 ;; If not, then update levels
2497 (setq indent (current-indentation))
2498 (setq levels (markdown-update-list-levels (match-string 2)
2499 indent levels))))
2500 (end-of-line))
2501 levels)))
2503 (defun markdown-prev-list-item (level)
2504 "Search backward from point for a list item with indentation LEVEL.
2505 Set point to the beginning of the item, and return point, or nil
2506 upon failure."
2507 (let (bounds indent prev)
2508 (setq prev (point))
2509 (forward-line -1)
2510 (setq indent (current-indentation))
2511 (while
2512 (cond
2513 ;; List item
2514 ((and (looking-at-p markdown-regex-list)
2515 (setq bounds (markdown-cur-list-item-bounds)))
2516 (cond
2517 ;; Stop and return point at item of equal indentation
2518 ((= (nth 3 bounds) level)
2519 (setq prev (point))
2520 nil)
2521 ;; Stop and return nil at item with lesser indentation
2522 ((< (nth 3 bounds) level)
2523 (setq prev nil)
2524 nil)
2525 ;; Stop at beginning of buffer
2526 ((bobp) (setq prev nil))
2527 ;; Continue at item with greater indentation
2528 ((> (nth 3 bounds) level) t)))
2529 ;; Stop at beginning of buffer
2530 ((bobp) (setq prev nil))
2531 ;; Continue if current line is blank
2532 ((markdown-cur-line-blank-p) t)
2533 ;; Continue while indentation is the same or greater
2534 ((>= indent level) t)
2535 ;; Stop if current indentation is less than list item
2536 ;; and the next is blank
2537 ((and (< indent level)
2538 (markdown-next-line-blank-p))
2539 (setq prev nil))
2540 ;; Stop at a header
2541 ((looking-at-p markdown-regex-header) (setq prev nil))
2542 ;; Stop at a horizontal rule
2543 ((looking-at-p markdown-regex-hr) (setq prev nil))
2544 ;; Otherwise, continue.
2545 (t t))
2546 (forward-line -1)
2547 (setq indent (current-indentation)))
2548 prev))
2550 (defun markdown-next-list-item (level)
2551 "Search forward from point for the next list item with indentation LEVEL.
2552 Set point to the beginning of the item, and return point, or nil
2553 upon failure."
2554 (let (bounds indent next)
2555 (setq next (point))
2556 (if (looking-at markdown-regex-header-setext)
2557 (goto-char (match-end 0)))
2558 (forward-line)
2559 (setq indent (current-indentation))
2560 (while
2561 (cond
2562 ;; Stop at end of the buffer.
2563 ((eobp) nil)
2564 ;; Continue if the current line is blank
2565 ((markdown-cur-line-blank-p) t)
2566 ;; List item
2567 ((and (looking-at-p markdown-regex-list)
2568 (setq bounds (markdown-cur-list-item-bounds)))
2569 (cond
2570 ;; Continue at item with greater indentation
2571 ((> (nth 3 bounds) level) t)
2572 ;; Stop and return point at item of equal indentation
2573 ((= (nth 3 bounds) level)
2574 (setq next (point))
2575 nil)
2576 ;; Stop and return nil at item with lesser indentation
2577 ((< (nth 3 bounds) level)
2578 (setq next nil)
2579 nil)))
2580 ;; Continue while indentation is the same or greater
2581 ((>= indent level) t)
2582 ;; Stop if current indentation is less than list item
2583 ;; and the previous line was blank.
2584 ((and (< indent level)
2585 (markdown-prev-line-blank-p))
2586 (setq next nil))
2587 ;; Stop at a header
2588 ((looking-at-p markdown-regex-header) (setq next nil))
2589 ;; Stop at a horizontal rule
2590 ((looking-at-p markdown-regex-hr) (setq next nil))
2591 ;; Otherwise, continue.
2592 (t t))
2593 (forward-line)
2594 (setq indent (current-indentation)))
2595 next))
2597 (defun markdown-cur-list-item-end (level)
2598 "Move to end of list item with pre-marker indentation LEVEL.
2599 Return the point at the end when a list item was found at the
2600 original point. If the point is not in a list item, do nothing."
2601 (let (indent)
2602 (forward-line)
2603 (setq indent (current-indentation))
2604 (while
2605 (cond
2606 ;; Stop at end of the buffer.
2607 ((eobp) nil)
2608 ;; Continue while indentation is the same or greater
2609 ((>= indent level) t)
2610 ;; Continue if the current line is blank
2611 ((looking-at markdown-regex-blank-line) t)
2612 ;; Stop if current indentation is less than list item
2613 ;; and the previous line was blank.
2614 ((and (< indent level)
2615 (markdown-prev-line-blank))
2616 nil)
2617 ;; Stop at a new list items of the same or lesser
2618 ;; indentation, headings, and horizontal rules.
2619 ((looking-at (concat "\\(?:" markdown-regex-list
2620 "\\|" markdown-regex-header
2621 "\\|" markdown-regex-hr "\\)"))
2622 nil)
2623 ;; Otherwise, continue.
2624 (t t))
2625 (forward-line)
2626 (setq indent (current-indentation)))
2627 ;; Don't skip over whitespace for empty list items (marker and
2628 ;; whitespace only), just move to end of whitespace.
2629 (if (save-excursion
2630 (beginning-of-line)
2631 (looking-at (concat markdown-regex-list "[ \t]*$")))
2632 (goto-char (match-end 3))
2633 (skip-chars-backward " \t\n"))
2634 (end-of-line)
2635 (point)))
2637 (defun markdown-cur-list-item-bounds ()
2638 "Return bounds for list item at point.
2639 Return a list of the following form:
2641 (begin end indent nonlist-indent marker checkbox match)
2643 The named components are:
2645 - begin: Position of beginning of list item, including leading indentation.
2646 - end: Position of the end of the list item, including list item text.
2647 - indent: Number of characters of indentation before list marker (an integer).
2648 - nonlist-indent: Number characters of indentation, list
2649 marker, and whitespace following list marker (an integer).
2650 - marker: String containing the list marker and following whitespace
2651 (e.g., \"- \" or \"* \").
2652 - checkbox: String containing the GFM checkbox portion, if any,
2653 including any trailing whitespace before the text
2654 begins (e.g., \"[x] \").
2655 - match: match data for markdown-regex-list
2657 As an example, for the following unordered list item
2659 - item
2661 the returned list would be
2663 (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
2665 If the point is not inside a list item, return nil."
2666 (car (get-text-property (point-at-bol) 'markdown-list-item)))
2668 (defun markdown-list-item-at-point-p ()
2669 "Return t if there is a list item at the point and nil otherwise."
2670 (save-match-data (markdown-cur-list-item-bounds)))
2672 (defun markdown-prev-list-item-bounds ()
2673 "Return bounds of previous item in the same list of any level.
2674 The return value has the same form as that of
2675 `markdown-cur-list-item-bounds'."
2676 (save-excursion
2677 (let ((cur-bounds (markdown-cur-list-item-bounds))
2678 (beginning-of-list (save-excursion (markdown-beginning-of-list)))
2679 stop)
2680 (when cur-bounds
2681 (goto-char (nth 0 cur-bounds))
2682 (while (and (not stop) (not (bobp))
2683 (re-search-backward markdown-regex-list
2684 beginning-of-list t))
2685 (unless (or (looking-at markdown-regex-hr)
2686 (markdown-code-block-at-point-p))
2687 (setq stop (point))))
2688 (markdown-cur-list-item-bounds)))))
2690 (defun markdown-next-list-item-bounds ()
2691 "Return bounds of next item in the same list of any level.
2692 The return value has the same form as that of
2693 `markdown-cur-list-item-bounds'."
2694 (save-excursion
2695 (let ((cur-bounds (markdown-cur-list-item-bounds))
2696 (end-of-list (save-excursion (markdown-end-of-list)))
2697 stop)
2698 (when cur-bounds
2699 (goto-char (nth 0 cur-bounds))
2700 (end-of-line)
2701 (while (and (not stop) (not (eobp))
2702 (re-search-forward markdown-regex-list
2703 end-of-list t))
2704 (unless (or (looking-at markdown-regex-hr)
2705 (markdown-code-block-at-point-p))
2706 (setq stop (point))))
2707 (when stop
2708 (markdown-cur-list-item-bounds))))))
2710 (defun markdown-beginning-of-list ()
2711 "Move point to beginning of list at point, if any."
2712 (interactive)
2713 (let ((orig-point (point))
2714 (list-begin (save-excursion
2715 (markdown-search-backward-baseline)
2716 ;; Stop at next list item, regardless of the indentation.
2717 (markdown-next-list-item (point-max))
2718 (when (looking-at markdown-regex-list)
2719 (point)))))
2720 (when (and list-begin (<= list-begin orig-point))
2721 (goto-char list-begin))))
2723 (defun markdown-end-of-list ()
2724 "Move point to end of list at point, if any."
2725 (interactive)
2726 (let ((start (point))
2727 (end (save-excursion
2728 (when (markdown-beginning-of-list)
2729 ;; Items can't have nonlist-indent <= 1, so this
2730 ;; moves past all list items.
2731 (markdown-next-list-item 1)
2732 (skip-syntax-backward "-")
2733 (unless (eobp) (forward-char 1))
2734 (point)))))
2735 (when (and end (>= end start))
2736 (goto-char end))))
2738 (defun markdown-up-list ()
2739 "Move point to beginning of parent list item."
2740 (interactive)
2741 (let ((cur-bounds (markdown-cur-list-item-bounds)))
2742 (when cur-bounds
2743 (markdown-prev-list-item (1- (nth 3 cur-bounds)))
2744 (let ((up-bounds (markdown-cur-list-item-bounds)))
2745 (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds)))
2746 (point))))))
2748 (defun markdown-bounds-of-thing-at-point (thing)
2749 "Call `bounds-of-thing-at-point' for THING with slight modifications.
2750 Does not include trailing newlines when THING is 'line. Handles the
2751 end of buffer case by setting both endpoints equal to the value of
2752 `point-max', since an empty region will trigger empty markup insertion.
2753 Return bounds of form (beg . end) if THING is found, or nil otherwise."
2754 (let* ((bounds (bounds-of-thing-at-point thing))
2755 (a (car bounds))
2756 (b (cdr bounds)))
2757 (when bounds
2758 (when (eq thing 'line)
2759 (cond ((and (eobp) (markdown-cur-line-blank-p))
2760 (setq a b))
2761 ((char-equal (char-before b) ?\^J)
2762 (setq b (1- b)))))
2763 (cons a b))))
2765 (defun markdown-reference-definition (reference)
2766 "Find out whether Markdown REFERENCE is defined.
2767 REFERENCE should not include the square brackets.
2768 When REFERENCE is defined, return a list of the form (text start end)
2769 containing the definition text itself followed by the start and end
2770 locations of the text. Otherwise, return nil.
2771 Leave match data for `markdown-regex-reference-definition'
2772 intact additional processing."
2773 (let ((reference (downcase reference)))
2774 (save-excursion
2775 (goto-char (point-min))
2776 (catch 'found
2777 (while (re-search-forward markdown-regex-reference-definition nil t)
2778 (when (string= reference (downcase (match-string-no-properties 2)))
2779 (throw 'found
2780 (list (match-string-no-properties 5)
2781 (match-beginning 5) (match-end 5)))))))))
2783 (defun markdown-get-defined-references ()
2784 "Return a list of all defined reference labels (not including square brackets)."
2785 (save-excursion
2786 (goto-char (point-min))
2787 (let (refs)
2788 (while (re-search-forward markdown-regex-reference-definition nil t)
2789 (let ((target (match-string-no-properties 2)))
2790 (cl-pushnew target refs :test #'equal)))
2791 (reverse refs))))
2793 (defun markdown-get-used-uris ()
2794 "Return a list of all used URIs in the buffer."
2795 (save-excursion
2796 (goto-char (point-min))
2797 (let (uris)
2798 (while (re-search-forward
2799 (concat "\\(?:" markdown-regex-link-inline
2800 "\\|" markdown-regex-angle-uri
2801 "\\|" markdown-regex-uri
2802 "\\|" markdown-regex-email
2803 "\\)")
2804 nil t)
2805 (unless (or (markdown-inline-code-at-point-p)
2806 (markdown-code-block-at-point-p))
2807 (cl-pushnew (or (match-string-no-properties 6)
2808 (match-string-no-properties 10)
2809 (match-string-no-properties 12)
2810 (match-string-no-properties 13))
2811 uris :test #'equal)))
2812 (reverse uris))))
2814 (defun markdown-inline-code-at-pos (pos)
2815 "Return non-nil if there is an inline code fragment at POS.
2816 Return nil otherwise. Set match data according to
2817 `markdown-match-code' upon success.
2818 This function searches the block for a code fragment that
2819 contains the point using `markdown-match-code'. We do this
2820 because `thing-at-point-looking-at' does not work reliably with
2821 `markdown-regex-code'.
2823 The match data is set as follows:
2824 Group 1 matches the opening backquotes.
2825 Group 2 matches the code fragment itself, without backquotes.
2826 Group 3 matches the closing backquotes."
2827 (save-excursion
2828 (goto-char pos)
2829 (let ((old-point (point))
2830 (end-of-block (progn (markdown-end-of-text-block) (point)))
2831 found)
2832 (markdown-beginning-of-text-block)
2833 (while (and (markdown-match-code end-of-block)
2834 (setq found t)
2835 (< (match-end 0) old-point)))
2836 (and found ; matched something
2837 (<= (match-beginning 0) old-point) ; match contains old-point
2838 (>= (match-end 0) old-point)))))
2840 (defun markdown-inline-code-at-pos-p (pos)
2841 "Return non-nil if there is an inline code fragment at POS.
2842 Like `markdown-inline-code-at-pos`, but preserves match data."
2843 (save-match-data (markdown-inline-code-at-pos pos)))
2845 (defun markdown-inline-code-at-point ()
2846 "Return non-nil if the point is at an inline code fragment.
2847 See `markdown-inline-code-at-pos' for details."
2848 (markdown-inline-code-at-pos (point)))
2850 (defun markdown-inline-code-at-point-p ()
2851 "Return non-nil if there is inline code at the point.
2852 This is a predicate function counterpart to
2853 `markdown-inline-code-at-point' which does not modify the match
2854 data. See `markdown-code-block-at-point-p' for code blocks."
2855 (save-match-data (markdown-inline-code-at-pos (point))))
2857 (make-obsolete 'markdown-code-at-point-p 'markdown-inline-code-at-point-p "v2.2")
2859 (defun markdown--code-block-at-pos-no-syntax (pos)
2860 "Return match data list if there may be a code block at POS.
2861 This includes pre blocks, tilde-fenced code blocks, and GFM
2862 quoted code blocks. Return nil otherwise. This function does not
2863 use text properties, which have not yet been set during the
2864 syntax propertization phase."
2865 (setq pos (save-excursion (goto-char pos) (point-at-bol)))
2866 (let (match)
2867 (cond
2868 ;; Indented code blocks
2869 ((looking-at markdown-regex-pre)
2870 (let ((start (save-excursion
2871 (markdown-search-backward-baseline) (point)))
2872 (end (save-excursion
2873 (while (and (or (looking-at-p markdown-regex-pre)
2874 (markdown-cur-line-blank-p))
2875 (not (eobp)))
2876 (forward-line))
2877 (point))))
2878 (list start end start start start end end end)))
2879 ;; Fenced code blocks
2880 ((setq match (markdown-get-enclosing-fenced-block-construct pos))
2881 match))))
2883 (defun markdown-code-block-at-pos (pos)
2884 "Return match data list if there is a code block at POS.
2885 This includes pre blocks, tilde-fenced code blocks, and GFM
2886 quoted code blocks. Return nil otherwise. This function uses
2887 cached text properties at the beginning of the line position for
2888 performance reasons, but therefore it must run after the syntax
2889 propertization phase."
2890 (setq pos (save-excursion (goto-char pos) (point-at-bol)))
2891 (or (get-text-property pos 'markdown-pre)
2892 ;;(markdown-get-enclosing-fenced-block-construct pos)
2893 (when (markdown-range-properties-exist
2894 pos pos '(markdown-gfm-block-begin
2895 markdown-gfm-code
2896 markdown-gfm-block-end
2897 markdown-tilde-fence-begin
2898 markdown-fenced-code
2899 markdown-tilde-fence-end
2900 markdown-yaml-metadata-begin
2901 markdown-yaml-metadata-section
2902 markdown-yaml-metadata-end))
2903 (markdown-get-enclosing-fenced-block-construct pos))
2904 ;; polymode removes text properties set by markdown-mode, so
2905 ;; check if `poly-markdown-mode' is active and whether the
2906 ;; `chunkmode' property is non-nil at POS.
2907 (and (bound-and-true-p poly-markdown-mode)
2908 (get-text-property pos 'chunkmode))))
2910 ;; Function was renamed to emphasize that it does not modify match-data.
2911 (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p)
2913 (defun markdown-code-block-at-point-p ()
2914 "Return non-nil if there is a code block at the point.
2915 This includes pre blocks, tilde-fenced code blocks, and GFM
2916 quoted code blocks. This function does not modify the match
2917 data. See `markdown-inline-code-at-point-p' for inline code."
2918 (save-match-data (markdown-code-block-at-pos (point))))
2920 (defun markdown-heading-at-point ()
2921 "Return non-nil if there is a heading at the point.
2922 Set match data for `markdown-regex-header'."
2923 (let ((match-data (get-text-property (point) 'markdown-heading)))
2924 (when match-data
2925 (set-match-data match-data)
2926 t)))
2928 (defun markdown-pipe-at-bol-p ()
2929 "Return non-nil if the line begins with a pipe symbol.
2930 This may be useful for tables and Pandoc's line_blocks extension."
2931 (char-equal (char-after (point-at-bol)) ?|))
2934 ;;; Markdown Font Lock Matching Functions =====================================
2936 (defun markdown-range-property-any (begin end prop prop-values)
2937 "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
2938 Also returns t if PROP is a list containing one of the PROP-VALUES.
2939 Return nil otherwise."
2940 (let (props)
2941 (catch 'found
2942 (dolist (loc (number-sequence begin end))
2943 (when (setq props (get-text-property loc prop))
2944 (cond ((listp props)
2945 ;; props is a list, check for membership
2946 (dolist (val prop-values)
2947 (when (memq val props) (throw 'found loc))))
2949 ;; props is a scalar, check for equality
2950 (dolist (val prop-values)
2951 (when (eq val props) (throw 'found loc))))))))))
2953 (defun markdown-range-properties-exist (begin end props)
2954 (cl-loop
2955 for loc in (number-sequence begin end)
2956 with result = nil
2957 while (not
2958 (setq result
2959 (cl-some (lambda (prop) (get-text-property loc prop)) props)))
2960 finally return result))
2962 (defun markdown-match-inline-generic (regex last &optional faceless)
2963 "Match inline REGEX from the point to LAST.
2964 When FACELESS is non-nil, do not return matches where faces have been applied."
2965 (when (re-search-forward regex last t)
2966 (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
2967 (face (and faceless (text-property-not-all
2968 (match-beginning 0) (match-end 0) 'face nil))))
2969 (cond
2970 ;; In code block: move past it and recursively search again
2971 (bounds
2972 (when (< (goto-char (cl-second bounds)) last)
2973 (markdown-match-inline-generic regex last faceless)))
2974 ;; When faces are found in the match range, skip over the match and
2975 ;; recursively search again.
2976 (face
2977 (when (< (goto-char (match-end 0)) last)
2978 (markdown-match-inline-generic regex last faceless)))
2979 ;; Keep match data and return t when in bounds.
2981 (<= (match-end 0) last))))))
2983 (defun markdown-match-code (last)
2984 "Match inline code fragments from point to LAST."
2985 (unless (bobp)
2986 (backward-char 1))
2987 (when (markdown-search-until-condition
2988 (lambda ()
2989 (and
2990 ;; Advance point in case of failure, but without exceeding last.
2991 (goto-char (min (1+ (match-beginning 1)) last))
2992 (not (markdown-in-comment-p (match-beginning 1)))
2993 (not (markdown-in-comment-p (match-end 1)))
2994 (not (markdown-code-block-at-pos (match-beginning 1)))))
2995 markdown-regex-code last t)
2996 (set-match-data (list (match-beginning 1) (match-end 1)
2997 (match-beginning 2) (match-end 2)
2998 (match-beginning 3) (match-end 3)
2999 (match-beginning 4) (match-end 4)))
3000 (goto-char (min (1+ (match-end 0)) last (point-max)))
3003 (defun markdown-match-bold (last)
3004 "Match inline bold from the point to LAST."
3005 (when (markdown-match-inline-generic markdown-regex-bold last)
3006 (let ((begin (match-beginning 2))
3007 (end (match-end 2)))
3008 (if (or (markdown-inline-code-at-pos-p begin)
3009 (markdown-inline-code-at-pos-p end)
3010 (markdown-in-comment-p)
3011 (markdown-range-property-any
3012 begin begin 'face '(markdown-url-face
3013 markdown-plain-url-face))
3014 (markdown-range-property-any
3015 begin end 'face '(markdown-hr-face
3016 markdown-math-face)))
3017 (progn (goto-char (min (1+ begin) last))
3018 (when (< (point) last)
3019 (markdown-match-italic last)))
3020 (set-match-data (list (match-beginning 2) (match-end 2)
3021 (match-beginning 3) (match-end 3)
3022 (match-beginning 4) (match-end 4)
3023 (match-beginning 5) (match-end 5)))
3024 t))))
3026 (defun markdown-match-italic (last)
3027 "Match inline italics from the point to LAST."
3028 (let ((regex (if (memq major-mode '(gfm-mode gfm-view-mode))
3029 markdown-regex-gfm-italic markdown-regex-italic)))
3030 (when (markdown-match-inline-generic regex last)
3031 (let ((begin (match-beginning 1))
3032 (end (match-end 1)))
3033 (if (or (markdown-inline-code-at-pos-p begin)
3034 (markdown-inline-code-at-pos-p end)
3035 (markdown-in-comment-p)
3036 (markdown-range-property-any
3037 begin begin 'face '(markdown-url-face
3038 markdown-plain-url-face))
3039 (markdown-range-property-any
3040 begin end 'face '(markdown-bold-face
3041 markdown-list-face
3042 markdown-hr-face
3043 markdown-math-face)))
3044 (progn (goto-char (min (1+ begin) last))
3045 (when (< (point) last)
3046 (markdown-match-italic last)))
3047 (set-match-data (list (match-beginning 1) (match-end 1)
3048 (match-beginning 2) (match-end 2)
3049 (match-beginning 3) (match-end 3)
3050 (match-beginning 4) (match-end 4)))
3051 t)))))
3053 (defun markdown-match-math-generic (regex last)
3054 "Match REGEX from point to LAST.
3055 REGEX is either `markdown-regex-math-inline-single' for matching
3056 $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
3057 (when (and markdown-enable-math (markdown-match-inline-generic regex last))
3058 (let ((begin (match-beginning 1)) (end (match-end 1)))
3059 (prog1
3060 (if (or (markdown-range-property-any
3061 begin end 'face
3062 '(markdown-inline-code-face markdown-bold-face))
3063 (markdown-range-properties-exist
3064 begin end
3065 (markdown-get-fenced-block-middle-properties)))
3066 (markdown-match-math-generic regex last)
3068 (goto-char (1+ (match-end 0)))))))
3070 (defun markdown-match-list-items (last)
3071 "Match list items from point to LAST."
3072 (let* ((first (point))
3073 (pos first)
3074 (prop 'markdown-list-item)
3075 (bounds (car (get-text-property pos prop))))
3076 (while
3077 (and (or (null (setq bounds (car (get-text-property pos prop))))
3078 (< (cl-first bounds) pos))
3079 (< (point) last)
3080 (setq pos (next-single-property-change pos prop nil last))
3081 (goto-char pos)))
3082 (when bounds
3083 (set-match-data (cl-seventh bounds))
3084 ;; Step at least one character beyond point. Otherwise
3085 ;; `font-lock-fontify-keywords-region' infloops.
3086 (goto-char (min (1+ (max (point-at-eol) first))
3087 (point-max)))
3088 t)))
3090 (defun markdown-match-math-single (last)
3091 "Match single quoted $..$ math from point to LAST."
3092 (markdown-match-math-generic markdown-regex-math-inline-single last))
3094 (defun markdown-match-math-double (last)
3095 "Match double quoted $$..$$ math from point to LAST."
3096 (markdown-match-math-generic markdown-regex-math-inline-double last))
3098 (defun markdown-match-math-display (last)
3099 "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
3100 (markdown-match-math-generic markdown-regex-math-display last))
3102 (defun markdown-match-propertized-text (property last)
3103 "Match text with PROPERTY from point to LAST.
3104 Restore match data previously stored in PROPERTY."
3105 (let ((saved (get-text-property (point) property))
3106 pos)
3107 (unless saved
3108 (setq pos (next-single-property-change (point) property nil last))
3109 (setq saved (get-text-property pos property)))
3110 (when saved
3111 (set-match-data saved)
3112 ;; Step at least one character beyond point. Otherwise
3113 ;; `font-lock-fontify-keywords-region' infloops.
3114 (goto-char (min (1+ (max (match-end 0) (point)))
3115 (point-max)))
3116 saved)))
3118 (defun markdown-match-pre-blocks (last)
3119 "Match preformatted blocks from point to LAST.
3120 Use data stored in 'markdown-pre text property during syntax
3121 analysis."
3122 (markdown-match-propertized-text 'markdown-pre last))
3124 (defun markdown-match-gfm-code-blocks (last)
3125 "Match GFM quoted code blocks from point to LAST.
3126 Use data stored in 'markdown-gfm-code text property during syntax
3127 analysis."
3128 (markdown-match-propertized-text 'markdown-gfm-code last))
3130 (defun markdown-match-gfm-open-code-blocks (last)
3131 (markdown-match-propertized-text 'markdown-gfm-block-begin last))
3133 (defun markdown-match-gfm-close-code-blocks (last)
3134 (markdown-match-propertized-text 'markdown-gfm-block-end last))
3136 (defun markdown-match-fenced-code-blocks (last)
3137 "Match fenced code blocks from the point to LAST."
3138 (markdown-match-propertized-text 'markdown-fenced-code last))
3140 (defun markdown-match-fenced-start-code-block (last)
3141 (markdown-match-propertized-text 'markdown-tilde-fence-begin last))
3143 (defun markdown-match-fenced-end-code-block (last)
3144 (markdown-match-propertized-text 'markdown-tilde-fence-end last))
3146 (defun markdown-match-blockquotes (last)
3147 "Match blockquotes from point to LAST.
3148 Use data stored in 'markdown-blockquote text property during syntax
3149 analysis."
3150 (markdown-match-propertized-text 'markdown-blockquote last))
3152 (defun markdown-match-hr (last)
3153 "Match horizontal rules comments from the point to LAST."
3154 (markdown-match-propertized-text 'markdown-hr last))
3156 (defun markdown-match-comments (last)
3157 "Match HTML comments from the point to LAST."
3158 (when (and (skip-syntax-forward "^<" last))
3159 (let ((beg (point)))
3160 (when (and (skip-syntax-forward "^>" last) (< (point) last))
3161 (forward-char)
3162 (set-match-data (list beg (point)))
3163 t))))
3165 (defun markdown-match-generic-links (last ref)
3166 "Match inline links from point to LAST.
3167 When REF is non-nil, match reference links instead of standard
3168 links with URLs.
3169 This function should only be used during font-lock, as it
3170 determines syntax based on the presence of faces for previously
3171 processed elements."
3172 ;; Search for the next potential link (not in a code block).
3173 (let ((prohibited-faces '(markdown-pre-face
3174 markdown-code-face
3175 markdown-inline-code-face
3176 markdown-comment-face))
3177 found)
3178 (while
3179 (and (not found) (< (point) last)
3180 (progn
3181 ;; Clear match data to test for a match after functions returns.
3182 (set-match-data nil)
3183 ;; Preliminary regular expression search so we can return
3184 ;; quickly upon failure. This doesn't handle malformed links
3185 ;; or nested square brackets well, so if it passes we back up
3186 ;; continue with a more precise search.
3187 (re-search-forward
3188 (if ref
3189 markdown-regex-link-reference
3190 markdown-regex-link-inline)
3191 last 'limit)))
3192 ;; Keep searching if this is in a code block, inline code, or a
3193 ;; comment, or if it is include syntax. The link text portion
3194 ;; (group 3) may contain inline code or comments, but the
3195 ;; markup, URL, and title should not be part of such elements.
3196 (if (or (markdown-range-property-any
3197 (match-beginning 0) (match-end 2) 'face prohibited-faces)
3198 (markdown-range-property-any
3199 (match-beginning 4) (match-end 0) 'face prohibited-faces)
3200 (and (char-equal (char-after (point-at-bol)) ?<)
3201 (char-equal (char-after (1+ (point-at-bol))) ?<)))
3202 (set-match-data nil)
3203 (setq found t))))
3204 ;; Match opening exclamation point (optional) and left bracket.
3205 (when (match-beginning 2)
3206 (let* ((bang (match-beginning 1))
3207 (first-begin (match-beginning 2))
3208 ;; Find end of block to prevent matching across blocks.
3209 (end-of-block (save-excursion
3210 (progn
3211 (goto-char (match-beginning 2))
3212 (markdown-end-of-text-block)
3213 (point))))
3214 ;; Move over balanced expressions to closing right bracket.
3215 ;; Catch unbalanced expression errors and return nil.
3216 (first-end (condition-case nil
3217 (and (goto-char first-begin)
3218 (scan-sexps (point) 1))
3219 (error nil)))
3220 ;; Continue with point at CONT-POINT upon failure.
3221 (cont-point (min (1+ first-begin) last))
3222 second-begin second-end url-begin url-end
3223 title-begin title-end)
3224 ;; When bracket found, in range, and followed by a left paren/bracket...
3225 (when (and first-end (< first-end end-of-block) (goto-char first-end)
3226 (char-equal (char-after (point)) (if ref ?\[ ?\()))
3227 ;; Scan across balanced expressions for closing parenthesis/bracket.
3228 (setq second-begin (point)
3229 second-end (condition-case nil
3230 (scan-sexps (point) 1)
3231 (error nil)))
3232 ;; Check that closing parenthesis/bracket is in range.
3233 (if (and second-end (<= second-end end-of-block) (<= second-end last))
3234 (progn
3235 ;; Search for (optional) title inside closing parenthesis
3236 (when (and (not ref) (search-forward "\"" second-end t))
3237 (setq title-begin (1- (point))
3238 title-end (and (goto-char second-end)
3239 (search-backward "\"" (1+ title-begin) t))
3240 title-end (and title-end (1+ title-end))))
3241 ;; Store URL/reference range
3242 (setq url-begin (1+ second-begin)
3243 url-end (1- (or title-begin second-end)))
3244 ;; Set match data, move point beyond link, and return
3245 (set-match-data
3246 (list (or bang first-begin) second-end ; 0 - all
3247 bang (and bang (1+ bang)) ; 1 - bang
3248 first-begin (1+ first-begin) ; 2 - markup
3249 (1+ first-begin) (1- first-end) ; 3 - link text
3250 (1- first-end) first-end ; 4 - markup
3251 second-begin (1+ second-begin) ; 5 - markup
3252 url-begin url-end ; 6 - url/reference
3253 title-begin title-end ; 7 - title
3254 (1- second-end) second-end)) ; 8 - markup
3255 ;; Nullify cont-point and leave point at end and
3256 (setq cont-point nil)
3257 (goto-char second-end))
3258 ;; If no closing parenthesis in range, update continuation point
3259 (setq cont-point (min end-of-block second-begin))))
3260 (cond
3261 ;; On failure, continue searching at cont-point
3262 ((and cont-point (< cont-point last))
3263 (goto-char cont-point)
3264 (markdown-match-generic-links last ref))
3265 ;; No more text, return nil
3266 ((and cont-point (= cont-point last))
3267 nil)
3268 ;; Return t if a match occurred
3269 (t t)))))
3271 (defun markdown-match-angle-uris (last)
3272 "Match angle bracket URIs from point to LAST."
3273 (when (markdown-match-inline-generic markdown-regex-angle-uri last)
3274 (goto-char (1+ (match-end 0)))))
3276 (defun markdown-match-plain-uris (last)
3277 "Match plain URIs from point to LAST."
3278 (when (markdown-match-inline-generic markdown-regex-uri last t)
3279 (goto-char (1+ (match-end 0)))))
3281 (defvar markdown-conditional-search-function #'re-search-forward
3282 "Conditional search function used in `markdown-search-until-condition'.
3283 Made into a variable to allow for dynamic let-binding.")
3285 (defun markdown-search-until-condition (condition &rest args)
3286 (let (ret)
3287 (while (and (not ret) (apply markdown-conditional-search-function args))
3288 (setq ret (funcall condition)))
3289 ret))
3291 (defun markdown-match-generic-metadata (regexp last)
3292 "Match metadata declarations specified by REGEXP from point to LAST.
3293 These declarations must appear inside a metadata block that begins at
3294 the beginning of the buffer and ends with a blank line (or the end of
3295 the buffer)."
3296 (let* ((first (point))
3297 (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
3298 (block-begin (goto-char 1))
3299 (block-end (re-search-forward end-re nil t)))
3300 (if (and block-end (> first block-end))
3301 ;; Don't match declarations if there is no metadata block or if
3302 ;; the point is beyond the block. Move point to point-max to
3303 ;; prevent additional searches and return return nil since nothing
3304 ;; was found.
3305 (progn (goto-char (point-max)) nil)
3306 ;; If a block was found that begins before LAST and ends after
3307 ;; point, search for declarations inside it. If the starting is
3308 ;; before the beginning of the block, start there. Otherwise,
3309 ;; move back to FIRST.
3310 (goto-char (if (< first block-begin) block-begin first))
3311 (if (re-search-forward regexp (min last block-end) t)
3312 ;; If a metadata declaration is found, set match-data and return t.
3313 (let ((key-beginning (match-beginning 1))
3314 (key-end (match-end 1))
3315 (markup-begin (match-beginning 2))
3316 (markup-end (match-end 2))
3317 (value-beginning (match-beginning 3)))
3318 (set-match-data (list key-beginning (point) ; complete metadata
3319 key-beginning key-end ; key
3320 markup-begin markup-end ; markup
3321 value-beginning (point))) ; value
3323 ;; Otherwise, move the point to last and return nil
3324 (goto-char last)
3325 nil))))
3327 (defun markdown-match-declarative-metadata (last)
3328 "Match declarative metadata from the point to LAST."
3329 (markdown-match-generic-metadata markdown-regex-declarative-metadata last))
3331 (defun markdown-match-pandoc-metadata (last)
3332 "Match Pandoc metadata from the point to LAST."
3333 (markdown-match-generic-metadata markdown-regex-pandoc-metadata last))
3335 (defun markdown-match-yaml-metadata-begin (last)
3336 (markdown-match-propertized-text 'markdown-yaml-metadata-begin last))
3338 (defun markdown-match-yaml-metadata-end (last)
3339 (markdown-match-propertized-text 'markdown-yaml-metadata-end last))
3341 (defun markdown-match-yaml-metadata-key (last)
3342 (markdown-match-propertized-text 'markdown-metadata-key last))
3344 (defun markdown-match-wiki-link (last)
3345 "Match wiki links from point to LAST."
3346 (when (and markdown-enable-wiki-links
3347 (not markdown-wiki-link-fontify-missing)
3348 (markdown-match-inline-generic markdown-regex-wiki-link last))
3349 (let ((begin (match-beginning 1)) (end (match-end 1)))
3350 (if (or (markdown-in-comment-p begin)
3351 (markdown-in-comment-p end)
3352 (markdown-inline-code-at-pos-p begin)
3353 (markdown-inline-code-at-pos-p end)
3354 (markdown-code-block-at-pos begin))
3355 (progn (goto-char (min (1+ begin) last))
3356 (when (< (point) last)
3357 (markdown-match-wiki-link last)))
3358 (set-match-data (list begin end))
3359 t))))
3361 (defun markdown-match-inline-attributes (last)
3362 "Match inline attributes from point to LAST."
3363 (when (markdown-match-inline-generic markdown-regex-inline-attributes last)
3364 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3365 (markdown-inline-code-at-pos-p (match-end 0))
3366 (markdown-in-comment-p))
3367 t)))
3369 (defun markdown-match-leanpub-sections (last)
3370 "Match Leanpub section markers from point to LAST."
3371 (when (markdown-match-inline-generic markdown-regex-leanpub-sections last)
3372 (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
3373 (markdown-inline-code-at-pos-p (match-end 0))
3374 (markdown-in-comment-p))
3375 t)))
3377 (defun markdown-match-includes (last)
3378 "Match include statements from point to LAST.
3379 Sets match data for the following seven groups:
3380 Group 1: opening two angle brackets
3381 Group 2: opening title delimiter (optional)
3382 Group 3: title text (optional)
3383 Group 4: closing title delimiter (optional)
3384 Group 5: opening filename delimiter
3385 Group 6: filename
3386 Group 7: closing filename delimiter"
3387 (when (markdown-match-inline-generic markdown-regex-include last)
3388 (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
3389 (markdown-in-comment-p (match-end 0))
3390 (markdown-code-block-at-pos (match-beginning 0))))))
3391 (cond
3392 ;; Parentheses and maybe square brackets, but no curly braces:
3393 ;; match optional title in square brackets and file in parentheses.
3394 ((and valid (match-beginning 5)
3395 (not (match-beginning 8)))
3396 (set-match-data (list (match-beginning 1) (match-end 7)
3397 (match-beginning 1) (match-end 1)
3398 (match-beginning 2) (match-end 2)
3399 (match-beginning 3) (match-end 3)
3400 (match-beginning 4) (match-end 4)
3401 (match-beginning 5) (match-end 5)
3402 (match-beginning 6) (match-end 6)
3403 (match-beginning 7) (match-end 7))))
3404 ;; Only square brackets present: match file in square brackets.
3405 ((and valid (match-beginning 2)
3406 (not (match-beginning 5))
3407 (not (match-beginning 7)))
3408 (set-match-data (list (match-beginning 1) (match-end 4)
3409 (match-beginning 1) (match-end 1)
3410 nil nil
3411 nil nil
3412 nil nil
3413 (match-beginning 2) (match-end 2)
3414 (match-beginning 3) (match-end 3)
3415 (match-beginning 4) (match-end 4))))
3416 ;; Only curly braces present: match file in curly braces.
3417 ((and valid (match-beginning 8)
3418 (not (match-beginning 2))
3419 (not (match-beginning 5)))
3420 (set-match-data (list (match-beginning 1) (match-end 10)
3421 (match-beginning 1) (match-end 1)
3422 nil nil
3423 nil nil
3424 nil nil
3425 (match-beginning 8) (match-end 8)
3426 (match-beginning 9) (match-end 9)
3427 (match-beginning 10) (match-end 10))))
3429 ;; Not a valid match, move to next line and search again.
3430 (forward-line)
3431 (when (< (point) last)
3432 (setq valid (markdown-match-includes last)))))
3433 valid)))
3435 (defun markdown-match-html-tag (last)
3436 "Match HTML tags from point to LAST."
3437 (when (and markdown-enable-html
3438 (markdown-match-inline-generic markdown-regex-html-tag last t))
3439 (set-match-data (list (match-beginning 0) (match-end 0)
3440 (match-beginning 1) (match-end 1)
3441 (match-beginning 2) (match-end 2)
3442 (match-beginning 9) (match-end 9)))
3446 ;;; Markdown Font Fontification Functions =====================================
3448 (defun markdown--first-displayable (seq)
3449 "Return the first displayable character or string in SEQ.
3450 SEQ may be an atom or a sequence."
3451 (let ((seq (if (listp seq) seq (list seq))))
3452 (cond ((stringp (car seq))
3453 (cl-find-if
3454 (lambda (str)
3455 (and (mapcar #'char-displayable-p (string-to-list str))))
3456 seq))
3457 ((characterp (car seq))
3458 (cl-find-if #'char-displayable-p seq)))))
3460 (defun markdown--marginalize-string (level)
3461 "Generate atx markup string of given LEVEL for left margin."
3462 (let ((margin-left-space-count
3463 (- markdown-marginalize-headers-margin-width level)))
3464 (concat (make-string margin-left-space-count ? )
3465 (make-string level ?#))))
3467 (defun markdown-marginalize-update-current ()
3468 "Update the window configuration to create a left margin."
3469 ;; Emacs 25 or later is needed for window-font-width and default-font-width.
3470 (if (and (fboundp 'window-font-width) (fboundp 'default-font-width))
3471 (let* ((header-delimiter-font-width
3472 (window-font-width nil 'markdown-header-delimiter-face))
3473 (margin-pixel-width (* markdown-marginalize-headers-margin-width
3474 header-delimiter-font-width))
3475 (margin-char-width (/ margin-pixel-width (default-font-width))))
3476 (set-window-margins nil margin-char-width))
3477 ;; As a fallback, simply set margin based on character count.
3478 (set-window-margins nil markdown-marginalize-headers-margin-width)))
3480 (defun markdown-fontify-headings (last)
3481 "Add text properties to headings from point to LAST."
3482 (when (markdown-match-propertized-text 'markdown-heading last)
3483 (let* ((level (markdown-outline-level))
3484 (heading-face
3485 (intern (format "markdown-header-face-%d" level)))
3486 (heading-props `(face ,heading-face))
3487 (left-markup-props
3488 `(face markdown-header-delimiter-face
3489 ,@(cond
3490 (markdown-hide-markup
3491 `(display ""))
3492 (markdown-marginalize-headers
3493 `(display ((margin left-margin)
3494 ,(markdown--marginalize-string level)))))))
3495 (right-markup-props
3496 `(face markdown-header-delimiter-face
3497 ,@(when markdown-hide-markup `(display ""))))
3498 (rule-props `(face markdown-header-rule-face
3499 ,@(when markdown-hide-markup `(display "")))))
3500 (if (match-end 1)
3501 ;; Setext heading
3502 (progn (add-text-properties
3503 (match-beginning 1) (match-end 1) heading-props)
3504 (if (= level 1)
3505 (add-text-properties
3506 (match-beginning 2) (match-end 2) rule-props)
3507 (add-text-properties
3508 (match-beginning 3) (match-end 3) rule-props)))
3509 ;; atx heading
3510 (add-text-properties
3511 (match-beginning 4) (match-end 4) left-markup-props)
3512 (add-text-properties
3513 (match-beginning 5) (match-end 5) heading-props)
3514 (when (match-end 6)
3515 (add-text-properties
3516 (match-beginning 6) (match-end 6) right-markup-props))))
3519 (defun markdown-fontify-tables (last)
3520 (when (and (re-search-forward "|" last t)
3521 (markdown-table-at-point-p))
3522 (font-lock-append-text-property
3523 (line-beginning-position) (min (1+ (line-end-position)) (point-max))
3524 'face 'markdown-table-face)
3525 (forward-line 1)
3528 (defun markdown-fontify-blockquotes (last)
3529 "Apply font-lock properties to blockquotes from point to LAST."
3530 (when (markdown-match-blockquotes last)
3531 (let ((display-string
3532 (markdown--first-displayable markdown-blockquote-display-char)))
3533 (add-text-properties
3534 (match-beginning 1) (match-end 1)
3535 (if markdown-hide-markup
3536 `(face markdown-blockquote-face display ,display-string)
3537 `(face markdown-markup-face)))
3538 (font-lock-append-text-property
3539 (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face)
3540 t)))
3542 (defun markdown-fontify-list-items (last)
3543 "Apply font-lock properties to list markers from point to LAST."
3544 (when (markdown-match-list-items last)
3545 (let* ((indent (length (match-string-no-properties 1)))
3546 (level (/ indent 4)) ;; level = 0, 1, 2, ...
3547 (bullet (nth (mod level (length markdown-list-item-bullets))
3548 markdown-list-item-bullets)))
3549 (add-text-properties
3550 (match-beginning 2) (match-end 2) '(face markdown-list-face))
3551 (when markdown-hide-markup
3552 (cond
3553 ;; Unordered lists
3554 ((string-match-p "[\\*\\+-]" (match-string 2))
3555 (add-text-properties
3556 (match-beginning 2) (match-end 2) `(display ,bullet)))
3557 ;; Definition lists
3558 ((string-equal ":" (match-string 2))
3559 (let ((display-string
3560 (char-to-string (markdown--first-displayable
3561 markdown-definition-display-char))))
3562 (add-text-properties (match-beginning 2) (match-end 2)
3563 `(display ,display-string)))))))
3566 (defun markdown-fontify-hrs (last)
3567 "Add text properties to horizontal rules from point to LAST."
3568 (when (markdown-match-hr last)
3569 (let ((hr-char (markdown--first-displayable markdown-hr-display-char)))
3570 (add-text-properties
3571 (match-beginning 0) (match-end 0)
3572 `(face markdown-hr-face
3573 font-lock-multiline t
3574 ,@(when (and markdown-hide-markup hr-char)
3575 `(display ,(make-string
3576 (window-body-width) hr-char)))))
3577 t)))
3579 (defun markdown-fontify-sub-superscripts (last)
3580 "Apply text properties to sub- and superscripts from point to LAST."
3581 (when (markdown-search-until-condition
3582 (lambda () (and (not (markdown-code-block-at-point-p))
3583 (not (markdown-inline-code-at-point-p))
3584 (not (markdown-in-comment-p))))
3585 markdown-regex-sub-superscript last t)
3586 (let* ((subscript-p (string= (match-string 2) "~"))
3587 (props
3588 (if subscript-p
3589 (car markdown-sub-superscript-display)
3590 (cdr markdown-sub-superscript-display)))
3591 (mp (list 'face 'markdown-markup-face
3592 'invisible 'markdown-markup)))
3593 (when markdown-hide-markup
3594 (put-text-property (match-beginning 3) (match-end 3)
3595 'display props))
3596 (add-text-properties (match-beginning 2) (match-end 2) mp)
3597 (add-text-properties (match-beginning 4) (match-end 4) mp)
3598 t)))
3601 ;;; Syntax Table ==============================================================
3603 (defvar markdown-mode-syntax-table
3604 (let ((tab (make-syntax-table text-mode-syntax-table)))
3605 (modify-syntax-entry ?\" "." tab)
3606 tab)
3607 "Syntax table for `markdown-mode'.")
3610 ;;; Element Insertion =========================================================
3612 (defun markdown-ensure-blank-line-before ()
3613 "If previous line is not already blank, insert a blank line before point."
3614 (unless (bolp) (insert "\n"))
3615 (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n")))
3617 (defun markdown-ensure-blank-line-after ()
3618 "If following line is not already blank, insert a blank line after point.
3619 Return the point where it was originally."
3620 (save-excursion
3621 (unless (eolp) (insert "\n"))
3622 (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
3624 (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end)
3625 "Insert the strings S1 and S2, wrapping around region or THING.
3626 If a region is specified by the optional BEG and END arguments,
3627 wrap the strings S1 and S2 around that region.
3628 If there is an active region, wrap the strings S1 and S2 around
3629 the region. If there is not an active region but the point is at
3630 THING, wrap that thing (which defaults to word). Otherwise, just
3631 insert S1 and S2 and place the point in between. Return the
3632 bounds of the entire wrapped string, or nil if nothing was wrapped
3633 and S1 and S2 were only inserted."
3634 (let (a b bounds new-point)
3635 (cond
3636 ;; Given region
3637 ((and beg end)
3638 (setq a beg
3639 b end
3640 new-point (+ (point) (length s1))))
3641 ;; Active region
3642 ((markdown-use-region-p)
3643 (setq a (region-beginning)
3644 b (region-end)
3645 new-point (+ (point) (length s1))))
3646 ;; Thing (word) at point
3647 ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word)))
3648 (setq a (car bounds)
3649 b (cdr bounds)
3650 new-point (+ (point) (length s1))))
3651 ;; No active region and no word
3653 (setq a (point)
3654 b (point))))
3655 (goto-char b)
3656 (insert s2)
3657 (goto-char a)
3658 (insert s1)
3659 (when new-point (goto-char new-point))
3660 (if (= a b)
3662 (setq b (+ b (length s1) (length s2)))
3663 (cons a b))))
3665 (defun markdown-point-after-unwrap (cur prefix suffix)
3666 "Return desired position of point after an unwrapping operation.
3667 CUR gives the position of the point before the operation.
3668 Additionally, two cons cells must be provided. PREFIX gives the
3669 bounds of the prefix string and SUFFIX gives the bounds of the
3670 suffix string."
3671 (cond ((< cur (cdr prefix)) (car prefix))
3672 ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix))))
3673 ((<= cur (cdr suffix))
3674 (- cur (+ (- (cdr prefix) (car prefix))
3675 (- cur (car suffix)))))
3676 (t cur)))
3678 (defun markdown-unwrap-thing-at-point (regexp all text)
3679 "Remove prefix and suffix of thing at point and reposition the point.
3680 When the thing at point matches REGEXP, replace the subexpression
3681 ALL with the string in subexpression TEXT. Reposition the point
3682 in an appropriate location accounting for the removal of prefix
3683 and suffix strings. Return new bounds of string from group TEXT.
3684 When REGEXP is nil, assumes match data is already set."
3685 (when (or (null regexp)
3686 (thing-at-point-looking-at regexp))
3687 (let ((cur (point))
3688 (prefix (cons (match-beginning all) (match-beginning text)))
3689 (suffix (cons (match-end text) (match-end all)))
3690 (bounds (cons (match-beginning text) (match-end text))))
3691 ;; Replace the thing at point
3692 (replace-match (match-string text) t t nil all)
3693 ;; Reposition the point
3694 (goto-char (markdown-point-after-unwrap cur prefix suffix))
3695 ;; Adjust bounds
3696 (setq bounds (cons (car prefix)
3697 (- (cdr bounds) (- (cdr prefix) (car prefix))))))))
3699 (defun markdown-unwrap-things-in-region (beg end regexp all text)
3700 "Remove prefix and suffix of all things in region from BEG to END.
3701 When a thing in the region matches REGEXP, replace the
3702 subexpression ALL with the string in subexpression TEXT.
3703 Return a cons cell containing updated bounds for the region."
3704 (save-excursion
3705 (goto-char beg)
3706 (let ((removed 0) len-all len-text)
3707 (while (re-search-forward regexp (- end removed) t)
3708 (setq len-all (length (match-string-no-properties all)))
3709 (setq len-text (length (match-string-no-properties text)))
3710 (setq removed (+ removed (- len-all len-text)))
3711 (replace-match (match-string text) t t nil all))
3712 (cons beg (- end removed)))))
3714 (defun markdown-insert-hr (arg)
3715 "Insert or replace a horizonal rule.
3716 By default, use the first element of `markdown-hr-strings'. When
3717 ARG is non-nil, as when given a prefix, select a different
3718 element as follows. When prefixed with \\[universal-argument],
3719 use the last element of `markdown-hr-strings' instead. When
3720 prefixed with an integer from 1 to the length of
3721 `markdown-hr-strings', use the element in that position instead."
3722 (interactive "*P")
3723 (when (thing-at-point-looking-at markdown-regex-hr)
3724 (delete-region (match-beginning 0) (match-end 0)))
3725 (markdown-ensure-blank-line-before)
3726 (cond ((equal arg '(4))
3727 (insert (car (reverse markdown-hr-strings))))
3728 ((and (integerp arg) (> arg 0)
3729 (<= arg (length markdown-hr-strings)))
3730 (insert (nth (1- arg) markdown-hr-strings)))
3732 (insert (car markdown-hr-strings))))
3733 (markdown-ensure-blank-line-after))
3735 (defun markdown-insert-bold ()
3736 "Insert markup to make a region or word bold.
3737 If there is an active region, make the region bold. If the point
3738 is at a non-bold word, make the word bold. If the point is at a
3739 bold word or phrase, remove the bold markup. Otherwise, simply
3740 insert bold delimiters and place the point in between them."
3741 (interactive)
3742 (let ((delim (if markdown-bold-underscore "__" "**")))
3743 (if (markdown-use-region-p)
3744 ;; Active region
3745 (let ((bounds (markdown-unwrap-things-in-region
3746 (region-beginning) (region-end)
3747 markdown-regex-bold 2 4)))
3748 (markdown-wrap-or-insert delim delim nil (car bounds) (cdr bounds)))
3749 ;; Bold markup removal, bold word at point, or empty markup insertion
3750 (if (thing-at-point-looking-at markdown-regex-bold)
3751 (markdown-unwrap-thing-at-point nil 2 4)
3752 (markdown-wrap-or-insert delim delim 'word nil nil)))))
3754 (defun markdown-insert-italic ()
3755 "Insert markup to make a region or word italic.
3756 If there is an active region, make the region italic. If the point
3757 is at a non-italic word, make the word italic. If the point is at an
3758 italic word or phrase, remove the italic markup. Otherwise, simply
3759 insert italic delimiters and place the point in between them."
3760 (interactive)
3761 (let ((delim (if markdown-italic-underscore "_" "*")))
3762 (if (markdown-use-region-p)
3763 ;; Active region
3764 (let ((bounds (markdown-unwrap-things-in-region
3765 (region-beginning) (region-end)
3766 markdown-regex-italic 1 3)))
3767 (markdown-wrap-or-insert delim delim nil (car bounds) (cdr bounds)))
3768 ;; Italic markup removal, italic word at point, or empty markup insertion
3769 (if (thing-at-point-looking-at markdown-regex-italic)
3770 (markdown-unwrap-thing-at-point nil 1 3)
3771 (markdown-wrap-or-insert delim delim 'word nil nil)))))
3773 (defun markdown-insert-strike-through ()
3774 "Insert markup to make a region or word strikethrough.
3775 If there is an active region, make the region strikethrough. If the point
3776 is at a non-bold word, make the word strikethrough. If the point is at a
3777 strikethrough word or phrase, remove the strikethrough markup. Otherwise,
3778 simply insert bold delimiters and place the point in between them."
3779 (interactive)
3780 (let ((delim "~~"))
3781 (if (markdown-use-region-p)
3782 ;; Active region
3783 (let ((bounds (markdown-unwrap-things-in-region
3784 (region-beginning) (region-end)
3785 markdown-regex-strike-through 2 4)))
3786 (markdown-wrap-or-insert delim delim nil (car bounds) (cdr bounds)))
3787 ;; Strikethrough markup removal, strikethrough word at point, or empty markup insertion
3788 (if (thing-at-point-looking-at markdown-regex-strike-through)
3789 (markdown-unwrap-thing-at-point nil 2 4)
3790 (markdown-wrap-or-insert delim delim 'word nil nil)))))
3792 (defun markdown-insert-code ()
3793 "Insert markup to make a region or word an inline code fragment.
3794 If there is an active region, make the region an inline code
3795 fragment. If the point is at a word, make the word an inline
3796 code fragment. Otherwise, simply insert code delimiters and
3797 place the point in between them."
3798 (interactive)
3799 (if (markdown-use-region-p)
3800 ;; Active region
3801 (let ((bounds (markdown-unwrap-things-in-region
3802 (region-beginning) (region-end)
3803 markdown-regex-code 1 3)))
3804 (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds)))
3805 ;; Code markup removal, code markup for word, or empty markup insertion
3806 (if (markdown-inline-code-at-point)
3807 (markdown-unwrap-thing-at-point nil 0 2)
3808 (markdown-wrap-or-insert "`" "`" 'word nil nil))))
3810 (defun markdown-insert-kbd ()
3811 "Insert markup to wrap region or word in <kbd> tags.
3812 If there is an active region, use the region. If the point is at
3813 a word, use the word. Otherwise, simply insert <kbd> tags and
3814 place the point in between them."
3815 (interactive)
3816 (if (markdown-use-region-p)
3817 ;; Active region
3818 (let ((bounds (markdown-unwrap-things-in-region
3819 (region-beginning) (region-end)
3820 markdown-regex-kbd 0 2)))
3821 (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds)))
3822 ;; Markup removal, markup for word, or empty markup insertion
3823 (if (thing-at-point-looking-at markdown-regex-kbd)
3824 (markdown-unwrap-thing-at-point nil 0 2)
3825 (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil))))
3827 (defun markdown-insert-inline-link (text url &optional title)
3828 "Insert an inline link with TEXT pointing to URL.
3829 Optionally, the user can provide a TITLE."
3830 (let ((cur (point)))
3831 (setq title (and title (concat " \"" title "\"")))
3832 (insert (concat "[" text "](" url title ")"))
3833 (cond ((not text) (goto-char (+ 1 cur)))
3834 ((not url) (goto-char (+ 3 (length text) cur))))))
3836 (defun markdown-insert-inline-image (text url &optional title)
3837 "Insert an inline link with alt TEXT pointing to URL.
3838 Optionally, also provide a TITLE."
3839 (let ((cur (point)))
3840 (setq title (and title (concat " \"" title "\"")))
3841 (insert (concat "![" text "](" url title ")"))
3842 (cond ((not text) (goto-char (+ 2 cur)))
3843 ((not url) (goto-char (+ 4 (length text) cur))))))
3845 (defun markdown-insert-reference-link (text label &optional url title)
3846 "Insert a reference link and, optionally, a reference definition.
3847 The link TEXT will be inserted followed by the optional LABEL.
3848 If a URL is given, also insert a definition for the reference
3849 LABEL according to `markdown-reference-location'. If a TITLE is
3850 given, it will be added to the end of the reference definition
3851 and will be used to populate the title attribute when converted
3852 to XHTML. If URL is nil, insert only the link portion (for
3853 example, when a reference label is already defined)."
3854 (insert (concat "[" text "][" label "]"))
3855 (when url
3856 (markdown-insert-reference-definition
3857 (if (string-equal label "") text label)
3858 url title)))
3860 (defun markdown-insert-reference-image (text label &optional url title)
3861 "Insert a reference image and, optionally, a reference definition.
3862 The alt TEXT will be inserted followed by the optional LABEL.
3863 If a URL is given, also insert a definition for the reference
3864 LABEL according to `markdown-reference-location'. If a TITLE is
3865 given, it will be added to the end of the reference definition
3866 and will be used to populate the title attribute when converted
3867 to XHTML. If URL is nil, insert only the link portion (for
3868 example, when a reference label is already defined)."
3869 (insert (concat "![" text "][" label "]"))
3870 (when url
3871 (markdown-insert-reference-definition
3872 (if (string-equal label "") text label)
3873 url title)))
3875 (defun markdown-insert-reference-definition (label &optional url title)
3876 "Add definition for reference LABEL with URL and TITLE.
3877 LABEL is a Markdown reference label without square brackets.
3878 URL and TITLE are optional. When given, the TITLE will
3879 be used to populate the title attribute when converted to XHTML."
3880 ;; END specifies where to leave the point upon return
3881 (let ((end (point)))
3882 (cl-case markdown-reference-location
3883 (end (goto-char (point-max)))
3884 (immediately (markdown-end-of-text-block))
3885 (subtree (markdown-end-of-subtree))
3886 (header (markdown-end-of-defun)))
3887 ;; Skip backwards over local variables. This logic is similar to the one
3888 ;; used in ‘hack-local-variables’.
3889 (when (and enable-local-variables (eobp))
3890 (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move)
3891 (when (let ((case-fold-search t))
3892 (search-forward "Local Variables:" nil :move))
3893 (beginning-of-line 0)
3894 (when (eq (char-before) ?\n) (backward-char))))
3895 (unless (or (markdown-cur-line-blank-p)
3896 (thing-at-point-looking-at markdown-regex-reference-definition))
3897 (insert "\n"))
3898 (insert "\n[" label "]: ")
3899 (if url
3900 (insert url)
3901 ;; When no URL is given, leave point at END following the colon
3902 (setq end (point)))
3903 (when (> (length title) 0)
3904 (insert " \"" title "\""))
3905 (unless (looking-at-p "\n")
3906 (insert "\n"))
3907 (goto-char end)
3908 (when url
3909 (message
3910 (markdown--substitute-command-keys
3911 "Reference [%s] was defined, press \\[markdown-do] to jump there")
3912 label))))
3914 (define-obsolete-function-alias
3915 'markdown-insert-inline-link-dwim 'markdown-insert-link "v2.3")
3916 (define-obsolete-function-alias
3917 'markdown-insert-reference-link-dwim 'markdown-insert-link "v2.3")
3919 (defun markdown--insert-link-or-image (image)
3920 "Interactively insert new or update an existing link or image.
3921 When IMAGE is non-nil, insert an image. Otherwise, insert a link.
3922 This is an internal function called by
3923 `markdown-insert-link' and `markdown-insert-image'."
3924 (cl-multiple-value-bind (begin end text uri ref title)
3925 (if (markdown-use-region-p)
3926 ;; Use region as either link text or URL as appropriate.
3927 (let ((region (buffer-substring-no-properties
3928 (region-beginning) (region-end))))
3929 (if (string-match markdown-regex-uri region)
3930 ;; Region contains a URL; use it as such.
3931 (list (region-beginning) (region-end)
3932 nil (match-string 0 region) nil nil)
3933 ;; Region doesn't contain a URL, so use it as text.
3934 (list (region-beginning) (region-end)
3935 region nil nil nil)))
3936 ;; Extract and use properties of existing link, if any.
3937 (markdown-link-at-pos (point)))
3938 (let* ((ref (when ref (concat "[" ref "]")))
3939 (defined-refs (append
3940 (mapcar (lambda (ref) (concat "[" ref "]"))
3941 (markdown-get-defined-references))))
3942 (used-uris (markdown-get-used-uris))
3943 (uri-or-ref (completing-read
3944 "URL or [reference]: "
3945 (append defined-refs used-uris)
3946 nil nil (or uri ref)))
3947 (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref)
3948 (match-string 1 uri-or-ref))
3949 ((string-equal "" uri-or-ref)
3950 "")))
3951 (uri (unless ref uri-or-ref))
3952 (text-prompt (if image
3953 "Alt text: "
3954 (if ref
3955 "Link text: "
3956 "Link text (blank for plain URL): ")))
3957 (text (read-string text-prompt text))
3958 (text (if (= (length text) 0) nil text))
3959 (plainp (and uri (not text)))
3960 (implicitp (string-equal ref ""))
3961 (ref (if implicitp text ref))
3962 (definedp (and ref (markdown-reference-definition ref)))
3963 (ref-url (unless (or uri definedp)
3964 (completing-read "Reference URL: " used-uris)))
3965 (title (unless (or plainp definedp)
3966 (read-string "Title (tooltip text, optional): " title)))
3967 (title (if (= (length title) 0) nil title)))
3968 (when (and image implicitp)
3969 (user-error "Reference required: implicit image references are invalid"))
3970 (when (and begin end)
3971 (delete-region begin end))
3972 (cond
3973 ((and (not image) uri text)
3974 (markdown-insert-inline-link text uri title))
3975 ((and image uri text)
3976 (markdown-insert-inline-image text uri title))
3977 ((and ref text)
3978 (if image
3979 (markdown-insert-reference-image text (unless implicitp ref) nil title)
3980 (markdown-insert-reference-link text (unless implicitp ref) nil title))
3981 (unless definedp
3982 (markdown-insert-reference-definition ref ref-url title)))
3983 ((and (not image) uri)
3984 (markdown-insert-uri uri))))))
3986 (defun markdown-insert-link ()
3987 "Insert new or update an existing link, with interactive prompts.
3988 If the point is at an existing link or URL, update the link text,
3989 URL, reference label, and/or title. Otherwise, insert a new link.
3990 The type of link inserted (inline, reference, or plain URL)
3991 depends on which values are provided:
3993 * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
3994 * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
3995 * If only TEXT is given, insert an implicit reference link: [TEXT][].
3996 * If only a URL is given, insert a plain link: <URL>.
3998 In other words, to create an implicit reference link, leave the
3999 URL prompt empty and to create a plain URL link, leave the link
4000 text empty.
4002 If there is an active region, use the text as the default URL, if
4003 it seems to be a URL, or link text value otherwise.
4005 If a given reference is not defined, this function will
4006 additionally prompt for the URL and optional title. In this case,
4007 the reference definition is placed at the location determined by
4008 `markdown-reference-location'.
4010 Through updating the link, this function can be used to convert a
4011 link of one type (inline, reference, or plain) to another type by
4012 selectively adding or removing information via the prompts."
4013 (interactive)
4014 (markdown--insert-link-or-image nil))
4016 (defun markdown-insert-image ()
4017 "Insert new or update an existing image, with interactive prompts.
4018 If the point is at an existing image, update the alt text, URL,
4019 reference label, and/or title. Otherwise, insert a new image.
4020 The type of image inserted (inline or reference) depends on which
4021 values are provided:
4023 * If a URL and ALT-TEXT are given, insert an inline image:
4024 ![ALT-TEXT](URL).
4025 * If [REF] and ALT-TEXT are given, insert a reference image:
4026 ![ALT-TEXT][REF].
4028 If there is an active region, use the text as the default URL, if
4029 it seems to be a URL, or alt text value otherwise.
4031 If a given reference is not defined, this function will
4032 additionally prompt for the URL and optional title. In this case,
4033 the reference definition is placed at the location determined by
4034 `markdown-reference-location'.
4036 Through updating the image, this function can be used to convert an
4037 image of one type (inline or reference) to another type by
4038 selectively adding or removing information via the prompts."
4039 (interactive)
4040 (markdown--insert-link-or-image t))
4042 (defun markdown-insert-uri (&optional uri)
4043 "Insert markup for an inline URI.
4044 If there is an active region, use it as the URI. If the point is
4045 at a URI, wrap it with angle brackets. If the point is at an
4046 inline URI, remove the angle brackets. Otherwise, simply insert
4047 angle brackets place the point between them."
4048 (interactive)
4049 (if (markdown-use-region-p)
4050 ;; Active region
4051 (let ((bounds (markdown-unwrap-things-in-region
4052 (region-beginning) (region-end)
4053 markdown-regex-angle-uri 0 2)))
4054 (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds)))
4055 ;; Markup removal, URI at point, new URI, or empty markup insertion
4056 (if (thing-at-point-looking-at markdown-regex-angle-uri)
4057 (markdown-unwrap-thing-at-point nil 0 2)
4058 (if uri
4059 (insert "<" uri ">")
4060 (markdown-wrap-or-insert "<" ">" 'url nil nil)))))
4062 (defun markdown-insert-wiki-link ()
4063 "Insert a wiki link of the form [[WikiLink]].
4064 If there is an active region, use the region as the link text.
4065 If the point is at a word, use the word as the link text. If
4066 there is no active region and the point is not at word, simply
4067 insert link markup."
4068 (interactive)
4069 (if (markdown-use-region-p)
4070 ;; Active region
4071 (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end))
4072 ;; Markup removal, wiki link at at point, or empty markup insertion
4073 (if (thing-at-point-looking-at markdown-regex-wiki-link)
4074 (if (or markdown-wiki-link-alias-first
4075 (null (match-string 5)))
4076 (markdown-unwrap-thing-at-point nil 1 3)
4077 (markdown-unwrap-thing-at-point nil 1 5))
4078 (markdown-wrap-or-insert "[[" "]]"))))
4080 (defun markdown-remove-header ()
4081 "Remove header markup if point is at a header.
4082 Return bounds of remaining header text if a header was removed
4083 and nil otherwise."
4084 (interactive "*")
4085 (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2)
4086 (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1)))
4088 (defun markdown-insert-header (&optional level text setext)
4089 "Insert or replace header markup.
4090 The level of the header is specified by LEVEL and header text is
4091 given by TEXT. LEVEL must be an integer from 1 and 6, and the
4092 default value is 1.
4093 When TEXT is nil, the header text is obtained as follows.
4094 If there is an active region, it is used as the header text.
4095 Otherwise, the current line will be used as the header text.
4096 If there is not an active region and the point is at a header,
4097 remove the header markup and replace with level N header.
4098 Otherwise, insert empty header markup and place the point in
4099 between.
4100 The style of the header will be atx (hash marks) unless
4101 SETEXT is non-nil, in which case a setext-style (underlined)
4102 header will be inserted."
4103 (interactive "p\nsHeader text: ")
4104 (setq level (min (max (or level 1) 1) (if setext 2 6)))
4105 ;; Determine header text if not given
4106 (when (null text)
4107 (if (markdown-use-region-p)
4108 ;; Active region
4109 (setq text (delete-and-extract-region (region-beginning) (region-end)))
4110 ;; No active region
4111 (markdown-remove-header)
4112 (setq text (delete-and-extract-region
4113 (line-beginning-position) (line-end-position)))
4114 (when (and setext (string-match-p "^[ \t]*$" text))
4115 (setq text (read-string "Header text: "))))
4116 (setq text (markdown-compress-whitespace-string text)))
4117 ;; Insertion with given text
4118 (markdown-ensure-blank-line-before)
4119 (let (hdr)
4120 (cond (setext
4121 (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=)))
4122 (insert text "\n" hdr))
4124 (setq hdr (make-string level ?#))
4125 (insert hdr " " text)
4126 (when (null markdown-asymmetric-header) (insert " " hdr)))))
4127 (markdown-ensure-blank-line-after)
4128 ;; Leave point at end of text
4129 (cond (setext
4130 (backward-char (1+ (string-width text))))
4131 ((null markdown-asymmetric-header)
4132 (backward-char (1+ level)))))
4134 (defun markdown-insert-header-dwim (&optional arg setext)
4135 "Insert or replace header markup.
4136 The level and type of the header are determined automatically by
4137 the type and level of the previous header, unless a prefix
4138 argument is given via ARG.
4139 With a numeric prefix valued 1 to 6, insert a header of the given
4140 level, with the type being determined automatically (note that
4141 only level 1 or 2 setext headers are possible).
4143 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
4144 promote the heading by one level.
4145 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
4146 demote the heading by one level.
4147 When SETEXT is non-nil, prefer setext-style headers when
4148 possible (levels one and two).
4150 When there is an active region, use it for the header text. When
4151 the point is at an existing header, change the type and level
4152 according to the rules above.
4153 Otherwise, if the line is not empty, create a header using the
4154 text on the current line as the header text.
4155 Finally, if the point is on a blank line, insert empty header
4156 markup (atx) or prompt for text (setext).
4157 See `markdown-insert-header' for more details about how the
4158 header text is determined."
4159 (interactive "*P")
4160 (let (level)
4161 (save-excursion
4162 (when (or (thing-at-point-looking-at markdown-regex-header)
4163 (re-search-backward markdown-regex-header nil t))
4164 ;; level of current or previous header
4165 (setq level (markdown-outline-level))
4166 ;; match group 1 indicates a setext header
4167 (setq setext (match-end 1))))
4168 ;; check prefix argument
4169 (cond
4170 ((and (equal arg '(4)) level (> level 1)) ;; C-u
4171 (cl-decf level))
4172 ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u
4173 (cl-incf level))
4174 (arg ;; numeric prefix
4175 (setq level (prefix-numeric-value arg))))
4176 ;; setext headers must be level one or two
4177 (and level (setq setext (and setext (<= level 2))))
4178 ;; insert the heading
4179 (markdown-insert-header level nil setext)))
4181 (defun markdown-insert-header-setext-dwim (&optional arg)
4182 "Insert or replace header markup, with preference for setext.
4183 See `markdown-insert-header-dwim' for details, including how ARG is handled."
4184 (interactive "*P")
4185 (markdown-insert-header-dwim arg t))
4187 (defun markdown-insert-header-atx-1 ()
4188 "Insert a first level atx-style (hash mark) header.
4189 See `markdown-insert-header'."
4190 (interactive "*")
4191 (markdown-insert-header 1 nil nil))
4193 (defun markdown-insert-header-atx-2 ()
4194 "Insert a level two atx-style (hash mark) header.
4195 See `markdown-insert-header'."
4196 (interactive "*")
4197 (markdown-insert-header 2 nil nil))
4199 (defun markdown-insert-header-atx-3 ()
4200 "Insert a level three atx-style (hash mark) header.
4201 See `markdown-insert-header'."
4202 (interactive "*")
4203 (markdown-insert-header 3 nil nil))
4205 (defun markdown-insert-header-atx-4 ()
4206 "Insert a level four atx-style (hash mark) header.
4207 See `markdown-insert-header'."
4208 (interactive "*")
4209 (markdown-insert-header 4 nil nil))
4211 (defun markdown-insert-header-atx-5 ()
4212 "Insert a level five atx-style (hash mark) header.
4213 See `markdown-insert-header'."
4214 (interactive "*")
4215 (markdown-insert-header 5 nil nil))
4217 (defun markdown-insert-header-atx-6 ()
4218 "Insert a sixth level atx-style (hash mark) header.
4219 See `markdown-insert-header'."
4220 (interactive "*")
4221 (markdown-insert-header 6 nil nil))
4223 (defun markdown-insert-header-setext-1 ()
4224 "Insert a setext-style (underlined) first-level header.
4225 See `markdown-insert-header'."
4226 (interactive "*")
4227 (markdown-insert-header 1 nil t))
4229 (defun markdown-insert-header-setext-2 ()
4230 "Insert a setext-style (underlined) second-level header.
4231 See `markdown-insert-header'."
4232 (interactive "*")
4233 (markdown-insert-header 2 nil t))
4235 (defun markdown-blockquote-indentation (loc)
4236 "Return string containing necessary indentation for a blockquote at LOC.
4237 Also see `markdown-pre-indentation'."
4238 (save-excursion
4239 (goto-char loc)
4240 (let* ((list-level (length (markdown-calculate-list-levels)))
4241 (indent ""))
4242 (dotimes (_ list-level indent)
4243 (setq indent (concat indent " "))))))
4245 (defun markdown-insert-blockquote ()
4246 "Start a blockquote section (or blockquote the region).
4247 If Transient Mark mode is on and a region is active, it is used as
4248 the blockquote text."
4249 (interactive)
4250 (if (markdown-use-region-p)
4251 (markdown-blockquote-region (region-beginning) (region-end))
4252 (markdown-ensure-blank-line-before)
4253 (insert (markdown-blockquote-indentation (point)) "> ")
4254 (markdown-ensure-blank-line-after)))
4256 (defun markdown-block-region (beg end prefix)
4257 "Format the region using a block prefix.
4258 Arguments BEG and END specify the beginning and end of the
4259 region. The characters PREFIX will appear at the beginning
4260 of each line."
4261 (save-excursion
4262 (let* ((end-marker (make-marker))
4263 (beg-marker (make-marker))
4264 (prefix-without-trailing-whitespace
4265 (replace-regexp-in-string (rx (+ blank) eos) "" prefix)))
4266 ;; Ensure blank line after and remove extra whitespace
4267 (goto-char end)
4268 (skip-syntax-backward "-")
4269 (set-marker end-marker (point))
4270 (delete-horizontal-space)
4271 (markdown-ensure-blank-line-after)
4272 ;; Ensure blank line before and remove extra whitespace
4273 (goto-char beg)
4274 (skip-syntax-forward "-")
4275 (delete-horizontal-space)
4276 (markdown-ensure-blank-line-before)
4277 (set-marker beg-marker (point))
4278 ;; Insert PREFIX before each line
4279 (goto-char beg-marker)
4280 (while (and (< (line-beginning-position) end-marker)
4281 (not (eobp)))
4282 ;; Don’t insert trailing whitespace.
4283 (insert (if (eolp) prefix-without-trailing-whitespace prefix))
4284 (forward-line)))))
4286 (defun markdown-blockquote-region (beg end)
4287 "Blockquote the region.
4288 Arguments BEG and END specify the beginning and end of the region."
4289 (interactive "*r")
4290 (markdown-block-region
4291 beg end (concat (markdown-blockquote-indentation
4292 (max (point-min) (1- beg))) "> ")))
4294 (defun markdown-pre-indentation (loc)
4295 "Return string containing necessary whitespace for a pre block at LOC.
4296 Also see `markdown-blockquote-indentation'."
4297 (save-excursion
4298 (goto-char loc)
4299 (let* ((list-level (length (markdown-calculate-list-levels)))
4300 indent)
4301 (dotimes (_ (1+ list-level) indent)
4302 (setq indent (concat indent " "))))))
4304 (defun markdown-insert-pre ()
4305 "Start a preformatted section (or apply to the region).
4306 If Transient Mark mode is on and a region is active, it is marked
4307 as preformatted text."
4308 (interactive)
4309 (if (markdown-use-region-p)
4310 (markdown-pre-region (region-beginning) (region-end))
4311 (markdown-ensure-blank-line-before)
4312 (insert (markdown-pre-indentation (point)))
4313 (markdown-ensure-blank-line-after)))
4315 (defun markdown-pre-region (beg end)
4316 "Format the region as preformatted text.
4317 Arguments BEG and END specify the beginning and end of the region."
4318 (interactive "*r")
4319 (let ((indent (markdown-pre-indentation (max (point-min) (1- beg)))))
4320 (markdown-block-region beg end indent)))
4322 (defun markdown-electric-backquote (arg)
4323 "Insert a backquote.
4324 The numeric prefix argument ARG says how many times to repeat the insertion.
4325 Call `markdown-insert-gfm-code-block' interactively
4326 if three backquotes inserted at the beginning of line."
4327 (interactive "*P")
4328 (self-insert-command (prefix-numeric-value arg))
4329 (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil))
4330 (replace-match "")
4331 (call-interactively #'markdown-insert-gfm-code-block)))
4333 (defconst markdown-gfm-recognized-languages
4334 ;; To reproduce/update, evaluate the let-form in
4335 ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
4336 ;; but with appropriate use of a keyboard macro, indenting and filling it
4337 ;; properly is pretty fast.
4338 '("1C-Enterprise" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
4339 "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada" "Agda"
4340 "Alloy" "Alpine-Abuild" "Ant-Build-System" "ApacheConf" "Apex"
4341 "Apollo-Guidance-Computer" "AppleScript" "Arc" "Arduino" "AsciiDoc"
4342 "AspectJ" "Assembly" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Batchfile"
4343 "Befunge" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax" "Bluespec"
4344 "Boo" "Brainfuck" "Brightscript" "Bro" "C#" "C++" "C-ObjDump"
4345 "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV"
4346 "CWeb" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
4347 "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
4348 "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp"
4349 "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal"
4350 "Csound" "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython"
4351 "D-ObjDump" "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace"
4352 "Darcs-Patch" "Dart" "Diff" "Dockerfile" "Dogescript" "Dylan" "EBNF"
4353 "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Ecere-Projects" "Eiffel" "Elixir"
4354 "Elm" "Emacs-Lisp" "EmberScript" "Erlang" "F#" "FLUX" "Factor" "Fancy"
4355 "Fantom" "Filebench-WML" "Filterscript" "Formatted" "Forth" "Fortran"
4356 "FreeMarker" "Frege" "G-code" "GAMS" "GAP" "GCC-Machine-Description"
4357 "GDB" "GDScript" "GLSL" "GN" "Game-Maker-Language" "Genie" "Genshi"
4358 "Gentoo-Ebuild" "Gentoo-Eclass" "Gettext-Catalog" "Gherkin" "Glyph"
4359 "Gnuplot" "Go" "Golo" "Gosu" "Grace" "Gradle" "Grammatical-Framework"
4360 "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy"
4361 "Groovy-Server-Pages" "HCL" "HLSL" "HTML" "HTML+Django" "HTML+ECR"
4362 "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTTP" "Hack" "Haml" "Handlebars"
4363 "Harbour" "Haskell" "Haxe" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI"
4364 "IRC-log" "Idris" "Inform-7" "Inno-Setup" "Io" "Ioke" "Isabelle"
4365 "Isabelle-ROOT" "JFlex" "JSON" "JSON5" "JSONLD" "JSONiq" "JSX"
4366 "Jasmin" "Java" "Java-Server-Pages" "JavaScript" "Jison" "Jison-Lex"
4367 "Jolie" "Julia" "Jupyter-Notebook" "KRL" "KiCad" "Kit" "Kotlin" "LFE"
4368 "LLVM" "LOLCODE" "LSL" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
4369 "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
4370 "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell"
4371 "LiveScript" "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4"
4372 "M4Sugar" "MAXScript" "MQL4" "MQL5" "MTML" "MUF" "Makefile" "Mako"
4373 "Markdown" "Marko" "Mask" "Mathematica" "Matlab" "Maven-POM" "Max"
4374 "MediaWiki" "Mercury" "Meson" "Metal" "MiniD" "Mirah" "Modelica"
4375 "Modula-2" "Module-Management-System" "Monkey" "Moocode" "MoonScript"
4376 "Myghty" "NCL" "NL" "NSIS" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
4377 "NewLisp" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
4378 "ObjDump" "Objective-C" "Objective-C++" "Objective-J" "Omgrofl" "Opa"
4379 "Opal" "OpenCL" "OpenEdge-ABL" "OpenRC-runscript" "OpenSCAD"
4380 "OpenType-Feature-File" "Org" "Ox" "Oxygene" "Oz" "P4" "PAWN" "PHP"
4381 "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus" "Parrot"
4382 "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pep8"
4383 "Perl" "Perl6" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "Pod"
4384 "PogoScript" "Pony" "PostScript" "PowerBuilder" "PowerShell"
4385 "Processing" "Prolog" "Propeller-Spin" "Protocol-Buffer" "Public-Key"
4386 "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
4387 "Python-console" "Python-traceback" "QML" "QMake" "RAML" "RDoc"
4388 "REALbasic" "REXX" "RHTML" "RMarkdown" "RPM-Spec" "RUNOFF" "Racket"
4389 "Ragel" "Rascal" "Raw-token-data" "Reason" "Rebol" "Red" "Redcode"
4390 "Regular-Expression" "Ren'Py" "RenderScript" "RobotFramework" "Roff"
4391 "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
4392 "SRecode-Template" "STON" "SVG" "Sage" "SaltStack" "Sass" "Scala"
4393 "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
4394 "Shen" "Slash" "Slim" "Smali" "Smalltalk" "Smarty" "SourcePawn"
4395 "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Stata"
4396 "Stylus" "SubRip-Text" "Sublime-Text-Config" "SuperCollider" "Swift"
4397 "SystemVerilog" "TI-Program" "TLA" "TOML" "TXL" "Tcl" "Tcsh" "TeX"
4398 "Tea" "Terra" "Text" "Textile" "Thrift" "Turing" "Turtle" "Twig"
4399 "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
4400 "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VCL" "VHDL" "Vala"
4401 "Verilog" "Vim-script" "Visual-Basic" "Volt" "Vue"
4402 "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language"
4403 "WebAssembly" "WebIDL" "World-of-Warcraft-Addon-Data" "X10" "XC"
4404 "XCompose" "XML" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" "Xtend"
4405 "YAML" "YANG" "Yacc" "Zephir" "Zimpl" "desktop" "eC" "edn" "fish"
4406 "mupad" "nesC" "ooc" "reStructuredText" "wisp" "xBase")
4407 "Language specifiers recognized by GitHub's syntax highlighting features.")
4409 (defvar markdown-gfm-used-languages nil
4410 "Language names used in GFM code blocks.")
4411 (make-variable-buffer-local 'markdown-gfm-used-languages)
4413 (defun markdown-trim-whitespace (str)
4414 (markdown-replace-regexp-in-string
4415 "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str))
4417 (defun markdown-clean-language-string (str)
4418 (markdown-replace-regexp-in-string
4419 "{\\.?\\|}" "" (markdown-trim-whitespace str)))
4421 (defun markdown-validate-language-string (widget)
4422 (let ((str (widget-value widget)))
4423 (unless (string= str (markdown-clean-language-string str))
4424 (widget-put widget :error (format "Invalid language spec: '%s'" str))
4425 widget)))
4427 (defun markdown-gfm-get-corpus ()
4428 "Create corpus of recognized GFM code block languages for the given buffer."
4429 (let ((given-corpus (append markdown-gfm-additional-languages
4430 markdown-gfm-recognized-languages)))
4431 (append
4432 markdown-gfm-used-languages
4433 (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus)
4434 given-corpus))))
4436 (defun markdown-gfm-add-used-language (lang)
4437 "Clean LANG and add to list of used languages."
4438 (setq markdown-gfm-used-languages
4439 (cons lang (remove lang markdown-gfm-used-languages))))
4441 (defcustom markdown-spaces-after-code-fence 1
4442 "Number of space characters to insert after a code fence.
4443 \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
4444 opening code fence and an info string."
4445 :group 'markdown
4446 :type 'integer
4447 :safe #'natnump
4448 :package-version '(markdown-mode . "2.3"))
4450 (defun markdown-insert-gfm-code-block (&optional lang edit)
4451 "Insert GFM code block for language LANG.
4452 If LANG is nil, the language will be queried from user. If a
4453 region is active, wrap this region with the markup instead. If
4454 the region boundaries are not on empty lines, these are added
4455 automatically in order to have the correct markup. When EDIT is
4456 non-nil (e.g., when \\[universal-argument] is given), edit the
4457 code block in an indirect buffer after insertion."
4458 (interactive
4459 (list (let ((completion-ignore-case nil))
4460 (condition-case nil
4461 (markdown-clean-language-string
4462 (completing-read
4463 "Programming language: "
4464 (markdown-gfm-get-corpus)
4465 nil 'confirm (car markdown-gfm-used-languages)
4466 'markdown-gfm-language-history))
4467 (quit "")))
4468 current-prefix-arg))
4469 (unless (string= lang "") (markdown-gfm-add-used-language lang))
4470 (when (> (length lang) 0)
4471 (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s)
4472 lang)))
4473 (if (markdown-use-region-p)
4474 (let* ((b (region-beginning)) (e (region-end)) end
4475 (indent (progn (goto-char b) (current-indentation))))
4476 (goto-char e)
4477 ;; if we're on a blank line, don't newline, otherwise the ```
4478 ;; should go on its own line
4479 (unless (looking-back "\n" nil)
4480 (newline))
4481 (indent-to indent)
4482 (insert "```")
4483 (markdown-ensure-blank-line-after)
4484 (setq end (point))
4485 (goto-char b)
4486 ;; if we're on a blank line, insert the quotes here, otherwise
4487 ;; add a new line first
4488 (unless (looking-at-p "\n")
4489 (newline)
4490 (forward-line -1))
4491 (markdown-ensure-blank-line-before)
4492 (indent-to indent)
4493 (insert "```" lang)
4494 (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end))
4495 (let ((indent (current-indentation)) start-bol)
4496 (delete-horizontal-space :backward-only)
4497 (markdown-ensure-blank-line-before)
4498 (indent-to indent)
4499 (setq start-bol (point-at-bol))
4500 (insert "```" lang "\n")
4501 (indent-to indent)
4502 (unless edit (insert ?\n))
4503 (indent-to indent)
4504 (insert "```")
4505 (markdown-ensure-blank-line-after)
4506 (markdown-syntax-propertize-fenced-block-constructs start-bol (point)))
4507 (end-of-line 0)
4508 (when edit (markdown-edit-code-block))))
4510 (defun markdown-code-block-lang (&optional pos-prop)
4511 "Return the language name for a GFM or tilde fenced code block.
4512 The beginning of the block may be described by POS-PROP,
4513 a cons of (pos . prop) giving the position and property
4514 at the beginning of the block."
4515 (or pos-prop
4516 (setq pos-prop
4517 (markdown-max-of-seq
4518 #'car
4519 (cl-remove-if
4520 #'null
4521 (cl-mapcar
4522 #'markdown-find-previous-prop
4523 (markdown-get-fenced-block-begin-properties))))))
4524 (when pos-prop
4525 (goto-char (car pos-prop))
4526 (set-match-data (get-text-property (point) (cdr pos-prop)))
4527 ;; Note: Hard-coded group number assumes tilde
4528 ;; and GFM fenced code regexp groups agree.
4529 (let ((begin (match-beginning 3))
4530 (end (match-end 3)))
4531 (when (and begin end)
4532 ;; Fix language strings beginning with periods, like ".ruby".
4533 (when (eq (char-after begin) ?.)
4534 (setq begin (1+ begin)))
4535 (buffer-substring-no-properties begin end)))))
4537 (defun markdown-gfm-parse-buffer-for-languages (&optional buffer)
4538 (with-current-buffer (or buffer (current-buffer))
4539 (save-excursion
4540 (goto-char (point-min))
4541 (cl-loop
4542 with prop = 'markdown-gfm-block-begin
4543 for pos-prop = (markdown-find-next-prop prop)
4544 while pos-prop
4545 for lang = (markdown-code-block-lang pos-prop)
4546 do (progn (when lang (markdown-gfm-add-used-language lang))
4547 (goto-char (next-single-property-change (point) prop)))))))
4550 ;;; Footnotes ==================================================================
4552 (defun markdown-footnote-counter-inc ()
4553 "Increment `markdown-footnote-counter' and return the new value."
4554 (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet.
4555 (save-excursion
4556 (goto-char (point-min))
4557 (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:")
4558 (point-max) t)
4559 (let ((fn (string-to-number (match-string 1))))
4560 (when (> fn markdown-footnote-counter)
4561 (setq markdown-footnote-counter fn))))))
4562 (cl-incf markdown-footnote-counter))
4564 (defun markdown-insert-footnote ()
4565 "Insert footnote with a new number and move point to footnote definition."
4566 (interactive)
4567 (let ((fn (markdown-footnote-counter-inc)))
4568 (insert (format "[^%d]" fn))
4569 (markdown-footnote-text-find-new-location)
4570 (markdown-ensure-blank-line-before)
4571 (unless (markdown-cur-line-blank-p)
4572 (insert "\n"))
4573 (insert (format "[^%d]: " fn))
4574 (markdown-ensure-blank-line-after)))
4576 (defun markdown-footnote-text-find-new-location ()
4577 "Position the point at the proper location for a new footnote text."
4578 (cond
4579 ((eq markdown-footnote-location 'end) (goto-char (point-max)))
4580 ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block))
4581 ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree))
4582 ((eq markdown-footnote-location 'header) (markdown-end-of-defun))))
4584 (defun markdown-footnote-kill ()
4585 "Kill the footnote at point.
4586 The footnote text is killed (and added to the kill ring), the
4587 footnote marker is deleted. Point has to be either at the
4588 footnote marker or in the footnote text."
4589 (interactive)
4590 (let ((marker-pos nil)
4591 (skip-deleting-marker nil)
4592 (starting-footnote-text-positions
4593 (markdown-footnote-text-positions)))
4594 (when starting-footnote-text-positions
4595 ;; We're starting in footnote text, so mark our return position and jump
4596 ;; to the marker if possible.
4597 (let ((marker-pos (markdown-footnote-find-marker
4598 (cl-first starting-footnote-text-positions))))
4599 (if marker-pos
4600 (goto-char (1- marker-pos))
4601 ;; If there isn't a marker, we still want to kill the text.
4602 (setq skip-deleting-marker t))))
4603 ;; Either we didn't start in the text, or we started in the text and jumped
4604 ;; to the marker. We want to assume we're at the marker now and error if
4605 ;; we're not.
4606 (unless skip-deleting-marker
4607 (let ((marker (markdown-footnote-delete-marker)))
4608 (unless marker
4609 (error "Not at a footnote"))
4610 ;; Even if we knew the text position before, it changed when we deleted
4611 ;; the label.
4612 (setq marker-pos (cl-second marker))
4613 (let ((new-text-pos (markdown-footnote-find-text (cl-first marker))))
4614 (unless new-text-pos
4615 (error "No text for footnote `%s'" (cl-first marker)))
4616 (goto-char new-text-pos))))
4617 (let ((pos (markdown-footnote-kill-text)))
4618 (goto-char (if starting-footnote-text-positions
4620 marker-pos)))))
4622 (defun markdown-footnote-delete-marker ()
4623 "Delete a footnote marker at point.
4624 Returns a list (ID START) containing the footnote ID and the
4625 start position of the marker before deletion. If no footnote
4626 marker was deleted, this function returns NIL."
4627 (let ((marker (markdown-footnote-marker-positions)))
4628 (when marker
4629 (delete-region (cl-second marker) (cl-third marker))
4630 (butlast marker))))
4632 (defun markdown-footnote-kill-text ()
4633 "Kill footnote text at point.
4634 Returns the start position of the footnote text before deletion,
4635 or NIL if point was not inside a footnote text.
4637 The killed text is placed in the kill ring (without the footnote
4638 number)."
4639 (let ((fn (markdown-footnote-text-positions)))
4640 (when fn
4641 (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn))))
4642 (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text)
4643 (kill-new (match-string 1 text))
4644 (when (and (markdown-cur-line-blank-p)
4645 (markdown-prev-line-blank-p)
4646 (not (bobp)))
4647 (delete-region (1- (point)) (point)))
4648 (cl-second fn)))))
4650 (defun markdown-footnote-goto-text ()
4651 "Jump to the text of the footnote at point."
4652 (interactive)
4653 (let ((fn (car (markdown-footnote-marker-positions))))
4654 (unless fn
4655 (user-error "Not at a footnote marker"))
4656 (let ((new-pos (markdown-footnote-find-text fn)))
4657 (unless new-pos
4658 (error "No definition found for footnote `%s'" fn))
4659 (goto-char new-pos))))
4661 (defun markdown-footnote-return ()
4662 "Return from a footnote to its footnote number in the main text."
4663 (interactive)
4664 (let ((fn (save-excursion
4665 (car (markdown-footnote-text-positions)))))
4666 (unless fn
4667 (user-error "Not in a footnote"))
4668 (let ((new-pos (markdown-footnote-find-marker fn)))
4669 (unless new-pos
4670 (error "Footnote marker `%s' not found" fn))
4671 (goto-char new-pos))))
4673 (defun markdown-footnote-find-marker (id)
4674 "Find the location of the footnote marker with ID.
4675 The actual buffer position returned is the position directly
4676 following the marker's closing bracket. If no marker is found,
4677 NIL is returned."
4678 (save-excursion
4679 (goto-char (point-min))
4680 (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t)
4681 (skip-chars-backward "^]")
4682 (point))))
4684 (defun markdown-footnote-find-text (id)
4685 "Find the location of the text of footnote ID.
4686 The actual buffer position returned is the position of the first
4687 character of the text, after the footnote's identifier. If no
4688 footnote text is found, NIL is returned."
4689 (save-excursion
4690 (goto-char (point-min))
4691 (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t)
4692 (skip-chars-forward "[ \t]")
4693 (point))))
4695 (defun markdown-footnote-marker-positions ()
4696 "Return the position and ID of the footnote marker point is on.
4697 The return value is a list (ID START END). If point is not on a
4698 footnote, NIL is returned."
4699 ;; first make sure we're at a footnote marker
4700 (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position))
4701 (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]")))
4702 (save-excursion
4703 ;; move point between [ and ^:
4704 (if (looking-at-p "\\[")
4705 (forward-char 1)
4706 (skip-chars-backward "^["))
4707 (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]"))
4708 (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
4710 (defun markdown-footnote-text-positions ()
4711 "Return the start and end positions of the footnote text point is in.
4712 The exact return value is a list of three elements: (ID START END).
4713 The start position is the position of the opening bracket
4714 of the footnote id. The end position is directly after the
4715 newline that ends the footnote. If point is not in a footnote,
4716 NIL is returned instead."
4717 (save-excursion
4718 (let (result)
4719 (move-beginning-of-line 1)
4720 ;; Try to find the label. If we haven't found the label and we're at a blank
4721 ;; or indented line, back up if possible.
4722 (while (and
4723 (not (and (looking-at markdown-regex-footnote-definition)
4724 (setq result (list (match-string 1) (point)))))
4725 (and (not (bobp))
4726 (or (markdown-cur-line-blank-p)
4727 (>= (current-indentation) 4))))
4728 (forward-line -1))
4729 (when result
4730 ;; Advance if there is a next line that is either blank or indented.
4731 ;; (Need to check if we're on the last line, because
4732 ;; markdown-next-line-blank-p returns true for last line in buffer.)
4733 (while (and (/= (line-end-position) (point-max))
4734 (or (markdown-next-line-blank-p)
4735 (>= (markdown-next-line-indent) 4)))
4736 (forward-line))
4737 ;; Move back while the current line is blank.
4738 (while (markdown-cur-line-blank-p)
4739 (forward-line -1))
4740 ;; Advance to capture this line and a single trailing newline (if there
4741 ;; is one).
4742 (forward-line)
4743 (append result (list (point)))))))
4745 (defun markdown-get-defined-footnotes ()
4746 "Return a list of all defined footnotes.
4747 Result is an alist of pairs (MARKER . LINE), where MARKER is the
4748 footnote marker, a string, and LINE is the line number containing
4749 the footnote definition.
4751 For example, suppose the following footnotes are defined at positions
4752 448 and 475:
4754 \[^1]: First footnote here.
4755 \[^marker]: Second footnote.
4757 Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
4758 (save-excursion
4759 (goto-char (point-min))
4760 (let (footnotes)
4761 (while (markdown-search-until-condition
4762 (lambda () (and (not (markdown-code-block-at-point-p))
4763 (not (markdown-inline-code-at-point-p))
4764 (not (markdown-in-comment-p))))
4765 markdown-regex-footnote-definition nil t)
4766 (let ((marker (match-string-no-properties 1))
4767 (pos (match-beginning 0)))
4768 (unless (zerop (length marker))
4769 (cl-pushnew (cons marker pos) footnotes :test #'equal))))
4770 (reverse footnotes))))
4773 ;;; Element Removal ===========================================================
4775 (defun markdown-kill-thing-at-point ()
4776 "Kill thing at point and add important text, without markup, to kill ring.
4777 Possible things to kill include (roughly in order of precedence):
4778 inline code, headers, horizonal rules, links (add link text to
4779 kill ring), images (add alt text to kill ring), angle uri, email
4780 addresses, bold, italics, reference definition (add URI to kill
4781 ring), footnote markers and text (kill both marker and text, add
4782 text to kill ring), and list items."
4783 (interactive "*")
4784 (let (val)
4785 (cond
4786 ;; Inline code
4787 ((markdown-inline-code-at-point)
4788 (kill-new (match-string 2))
4789 (delete-region (match-beginning 0) (match-end 0)))
4790 ;; ATX header
4791 ((thing-at-point-looking-at markdown-regex-header-atx)
4792 (kill-new (match-string 2))
4793 (delete-region (match-beginning 0) (match-end 0)))
4794 ;; Setext header
4795 ((thing-at-point-looking-at markdown-regex-header-setext)
4796 (kill-new (match-string 1))
4797 (delete-region (match-beginning 0) (match-end 0)))
4798 ;; Horizonal rule
4799 ((thing-at-point-looking-at markdown-regex-hr)
4800 (kill-new (match-string 0))
4801 (delete-region (match-beginning 0) (match-end 0)))
4802 ;; Inline link or image (add link or alt text to kill ring)
4803 ((thing-at-point-looking-at markdown-regex-link-inline)
4804 (kill-new (match-string 3))
4805 (delete-region (match-beginning 0) (match-end 0)))
4806 ;; Reference link or image (add link or alt text to kill ring)
4807 ((thing-at-point-looking-at markdown-regex-link-reference)
4808 (kill-new (match-string 3))
4809 (delete-region (match-beginning 0) (match-end 0)))
4810 ;; Angle URI (add URL to kill ring)
4811 ((thing-at-point-looking-at markdown-regex-angle-uri)
4812 (kill-new (match-string 2))
4813 (delete-region (match-beginning 0) (match-end 0)))
4814 ;; Email address in angle brackets (add email address to kill ring)
4815 ((thing-at-point-looking-at markdown-regex-email)
4816 (kill-new (match-string 1))
4817 (delete-region (match-beginning 0) (match-end 0)))
4818 ;; Wiki link (add alias text to kill ring)
4819 ((and markdown-enable-wiki-links
4820 (thing-at-point-looking-at markdown-regex-wiki-link))
4821 (kill-new (markdown-wiki-link-alias))
4822 (delete-region (match-beginning 1) (match-end 1)))
4823 ;; Bold
4824 ((thing-at-point-looking-at markdown-regex-bold)
4825 (kill-new (match-string 4))
4826 (delete-region (match-beginning 2) (match-end 2)))
4827 ;; Italics
4828 ((thing-at-point-looking-at markdown-regex-italic)
4829 (kill-new (match-string 3))
4830 (delete-region (match-beginning 1) (match-end 1)))
4831 ;; Strikethrough
4832 ((thing-at-point-looking-at markdown-regex-strike-through)
4833 (kill-new (match-string 4))
4834 (delete-region (match-beginning 2) (match-end 2)))
4835 ;; Footnote marker (add footnote text to kill ring)
4836 ((thing-at-point-looking-at markdown-regex-footnote)
4837 (markdown-footnote-kill))
4838 ;; Footnote text (add footnote text to kill ring)
4839 ((setq val (markdown-footnote-text-positions))
4840 (markdown-footnote-kill))
4841 ;; Reference definition (add URL to kill ring)
4842 ((thing-at-point-looking-at markdown-regex-reference-definition)
4843 (kill-new (match-string 5))
4844 (delete-region (match-beginning 0) (match-end 0)))
4845 ;; List item
4846 ((setq val (markdown-cur-list-item-bounds))
4847 (kill-new (delete-and-extract-region (cl-first val) (cl-second val))))
4849 (user-error "Nothing found at point to kill")))))
4852 ;;; Indentation ====================================================================
4854 (defun markdown-indent-find-next-position (cur-pos positions)
4855 "Return the position after the index of CUR-POS in POSITIONS.
4856 Positions are calculated by `markdown-calc-indents'."
4857 (while (and positions
4858 (not (equal cur-pos (car positions))))
4859 (setq positions (cdr positions)))
4860 (or (cadr positions) 0))
4862 (define-obsolete-function-alias 'markdown-exdent-find-next-position
4863 'markdown-outdent-find-next-position "v2.3")
4865 (defun markdown-outdent-find-next-position (cur-pos positions)
4866 "Return the maximal element that precedes CUR-POS from POSITIONS.
4867 Positions are calculated by `markdown-calc-indents'."
4868 (let ((result 0))
4869 (dolist (i positions)
4870 (when (< i cur-pos)
4871 (setq result (max result i))))
4872 result))
4874 (defun markdown-indent-line ()
4875 "Indent the current line using some heuristics.
4876 If the _previous_ command was either `markdown-enter-key' or
4877 `markdown-cycle', then we should cycle to the next
4878 reasonable indentation position. Otherwise, we could have been
4879 called directly by `markdown-enter-key', by an initial call of
4880 `markdown-cycle', or indirectly by `auto-fill-mode'. In
4881 these cases, indent to the default position.
4882 Positions are calculated by `markdown-calc-indents'."
4883 (interactive)
4884 (let ((positions (markdown-calc-indents))
4885 (point-pos (current-column))
4886 (_ (back-to-indentation))
4887 (cur-pos (current-column)))
4888 (if (not (equal this-command 'markdown-cycle))
4889 (indent-line-to (car positions))
4890 (setq positions (sort (delete-dups positions) '<))
4891 (let* ((next-pos (markdown-indent-find-next-position cur-pos positions))
4892 (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0)))
4893 (indent-line-to next-pos)
4894 (move-to-column new-point-pos)))))
4896 (defun markdown-calc-indents ()
4897 "Return a list of indentation columns to cycle through.
4898 The first element in the returned list should be considered the
4899 default indentation level. This function does not worry about
4900 duplicate positions, which are handled up by calling functions."
4901 (let (pos prev-line-pos positions)
4903 ;; Indentation of previous line
4904 (setq prev-line-pos (markdown-prev-line-indent))
4905 (setq positions (cons prev-line-pos positions))
4907 ;; Indentation of previous non-list-marker text
4908 (when (setq pos (save-excursion
4909 (forward-line -1)
4910 (when (looking-at markdown-regex-list)
4911 (- (match-end 3) (match-beginning 0)))))
4912 (setq positions (cons pos positions)))
4914 ;; Indentation required for a pre block in current context
4915 (setq pos (length (markdown-pre-indentation (point))))
4916 (setq positions (cons pos positions))
4918 ;; Indentation of the previous line + tab-width
4919 (if prev-line-pos
4920 (setq positions (cons (+ prev-line-pos tab-width) positions))
4921 (setq positions (cons tab-width positions)))
4923 ;; Indentation of the previous line - tab-width
4924 (if (and prev-line-pos (> prev-line-pos tab-width))
4925 (setq positions (cons (- prev-line-pos tab-width) positions)))
4927 ;; Indentation of all preceeding list markers (when in a list)
4928 (when (setq pos (markdown-calculate-list-levels))
4929 (setq positions (append pos positions)))
4931 ;; First column
4932 (setq positions (cons 0 positions))
4934 ;; Return reversed list
4935 (reverse positions)))
4937 (defun markdown-enter-key ()
4938 "Handle RET depending on the context.
4939 If the point is at a table, move to the next row. Otherwise,
4940 indent according to value of `markdown-indent-on-enter'.
4941 When it is nil, simply call `newline'. Otherwise, indent the next line
4942 following RET using `markdown-indent-line'. Furthermore, when it
4943 is set to 'indent-and-new-item and the point is in a list item,
4944 start a new item with the same indentation. If the point is in an
4945 empty list item, remove it (so that pressing RET twice when in a
4946 list simply adds a blank line)."
4947 (interactive)
4948 (cond
4949 ;; Table
4950 ((markdown-table-at-point-p)
4951 (call-interactively #'markdown-table-next-row))
4952 ;; Indent non-table text
4953 (markdown-indent-on-enter
4954 (let (bounds)
4955 (if (and (memq markdown-indent-on-enter '(indent-and-new-item))
4956 (setq bounds (markdown-cur-list-item-bounds)))
4957 (let ((beg (cl-first bounds))
4958 (end (cl-second bounds))
4959 (length (cl-fourth bounds)))
4960 ;; Point is in a list item
4961 (if (= (- end beg) length)
4962 ;; Delete blank list
4963 (progn
4964 (delete-region beg end)
4965 (newline)
4966 (markdown-indent-line))
4967 (call-interactively #'markdown-insert-list-item)))
4968 ;; Point is not in a list
4969 (newline)
4970 (markdown-indent-line))))
4971 ;; Insert a raw newline
4972 (t (newline))))
4974 (define-obsolete-function-alias 'markdown-exdent-or-delete
4975 'markdown-outdent-or-delete "v2.3")
4977 (defun markdown-outdent-or-delete (arg)
4978 "Handle BACKSPACE by cycling through indentation points.
4979 When BACKSPACE is pressed, if there is only whitespace
4980 before the current point, then outdent the line one level.
4981 Otherwise, do normal delete by repeating
4982 `backward-delete-char-untabify' ARG times."
4983 (interactive "*p")
4984 (if (use-region-p)
4985 (backward-delete-char-untabify arg)
4986 (let ((cur-pos (current-column))
4987 (start-of-indention (save-excursion
4988 (back-to-indentation)
4989 (current-column)))
4990 (positions (markdown-calc-indents)))
4991 (if (and (> cur-pos 0) (= cur-pos start-of-indention))
4992 (indent-line-to (markdown-outdent-find-next-position cur-pos positions))
4993 (backward-delete-char-untabify arg)))))
4995 (defun markdown-find-leftmost-column (beg end)
4996 "Find the leftmost column in the region from BEG to END."
4997 (let ((mincol 1000))
4998 (save-excursion
4999 (goto-char beg)
5000 (while (< (point) end)
5001 (back-to-indentation)
5002 (unless (looking-at-p "[ \t]*$")
5003 (setq mincol (min mincol (current-column))))
5004 (forward-line 1)
5006 mincol))
5008 (defun markdown-indent-region (beg end arg)
5009 "Indent the region from BEG to END using some heuristics.
5010 When ARG is non-nil, outdent the region instead.
5011 See `markdown-indent-line' and `markdown-indent-line'."
5012 (interactive "*r\nP")
5013 (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
5014 (leftmostcol (markdown-find-leftmost-column beg end))
5015 (next-pos (if arg
5016 (markdown-outdent-find-next-position leftmostcol positions)
5017 (markdown-indent-find-next-position leftmostcol positions))))
5018 (indent-rigidly beg end (- next-pos leftmostcol))
5019 (setq deactivate-mark nil)))
5021 (define-obsolete-function-alias 'markdown-exdent-region
5022 'markdown-outdent-region "v2.3")
5024 (defun markdown-outdent-region (beg end)
5025 "Call `markdown-indent-region' on region from BEG to END with prefix."
5026 (interactive "*r")
5027 (markdown-indent-region beg end t))
5030 ;;; Markup Completion =========================================================
5032 (defconst markdown-complete-alist
5033 '((markdown-regex-header-atx . markdown-complete-atx)
5034 (markdown-regex-header-setext . markdown-complete-setext)
5035 (markdown-regex-hr . markdown-complete-hr))
5036 "Association list of form (regexp . function) for markup completion.")
5038 (defun markdown-incomplete-atx-p ()
5039 "Return t if ATX header markup is incomplete and nil otherwise.
5040 Assumes match data is available for `markdown-regex-header-atx'.
5041 Checks that the number of trailing hash marks equals the number of leading
5042 hash marks, that there is only a single space before and after the text,
5043 and that there is no extraneous whitespace in the text."
5045 ;; Number of starting and ending hash marks differs
5046 (not (= (length (match-string 1)) (length (match-string 3))))
5047 ;; When the header text is not empty...
5048 (and (> (length (match-string 2)) 0)
5049 ;; ...if there are extra leading, trailing, or interior spaces
5050 (or (not (= (match-beginning 2) (1+ (match-end 1))))
5051 (not (= (match-beginning 3) (1+ (match-end 2))))
5052 (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
5053 ;; When the header text is empty...
5054 (and (= (length (match-string 2)) 0)
5055 ;; ...if there are too many or too few spaces
5056 (not (= (match-beginning 3) (+ (match-end 1) 2))))))
5058 (defun markdown-complete-atx ()
5059 "Complete and normalize ATX headers.
5060 Add or remove hash marks to the end of the header to match the
5061 beginning. Ensure that there is only a single space between hash
5062 marks and header text. Removes extraneous whitespace from header text.
5063 Assumes match data is available for `markdown-regex-header-atx'.
5064 Return nil if markup was complete and non-nil if markup was completed."
5065 (when (markdown-incomplete-atx-p)
5066 (let* ((new-marker (make-marker))
5067 (new-marker (set-marker new-marker (match-end 2))))
5068 ;; Hash marks and spacing at end
5069 (goto-char (match-end 2))
5070 (delete-region (match-end 2) (match-end 3))
5071 (insert " " (match-string 1))
5072 ;; Remove extraneous whitespace from title
5073 (replace-match (markdown-compress-whitespace-string (match-string 2))
5074 t t nil 2)
5075 ;; Spacing at beginning
5076 (goto-char (match-end 1))
5077 (delete-region (match-end 1) (match-beginning 2))
5078 (insert " ")
5079 ;; Leave point at end of text
5080 (goto-char new-marker))))
5082 (defun markdown-incomplete-setext-p ()
5083 "Return t if setext header markup is incomplete and nil otherwise.
5084 Assumes match data is available for `markdown-regex-header-setext'.
5085 Checks that length of underline matches text and that there is no
5086 extraneous whitespace in the text."
5087 (or (not (= (length (match-string 1)) (length (match-string 2))))
5088 (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
5090 (defun markdown-complete-setext ()
5091 "Complete and normalize setext headers.
5092 Add or remove underline characters to match length of header
5093 text. Removes extraneous whitespace from header text. Assumes
5094 match data is available for `markdown-regex-header-setext'.
5095 Return nil if markup was complete and non-nil if markup was completed."
5096 (when (markdown-incomplete-setext-p)
5097 (let* ((text (markdown-compress-whitespace-string (match-string 1)))
5098 (char (char-after (match-beginning 2)))
5099 (level (if (char-equal char ?-) 2 1)))
5100 (goto-char (match-beginning 0))
5101 (delete-region (match-beginning 0) (match-end 0))
5102 (markdown-insert-header level text t)
5103 t)))
5105 (defun markdown-incomplete-hr-p ()
5106 "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
5107 Assumes match data is available for `markdown-regex-hr'."
5108 (not (member (match-string 0) markdown-hr-strings)))
5110 (defun markdown-complete-hr ()
5111 "Complete horizontal rules.
5112 If horizontal rule string is a member of `markdown-hr-strings',
5113 do nothing. Otherwise, replace with the car of
5114 `markdown-hr-strings'.
5115 Assumes match data is available for `markdown-regex-hr'.
5116 Return nil if markup was complete and non-nil if markup was completed."
5117 (when (markdown-incomplete-hr-p)
5118 (replace-match (car markdown-hr-strings))
5121 (defun markdown-complete ()
5122 "Complete markup of object near point or in region when active.
5123 Handle all objects in `markdown-complete-alist', in order.
5124 See `markdown-complete-at-point' and `markdown-complete-region'."
5125 (interactive "*")
5126 (if (markdown-use-region-p)
5127 (markdown-complete-region (region-beginning) (region-end))
5128 (markdown-complete-at-point)))
5130 (defun markdown-complete-at-point ()
5131 "Complete markup of object near point.
5132 Handle all elements of `markdown-complete-alist' in order."
5133 (interactive "*")
5134 (let ((list markdown-complete-alist) found changed)
5135 (while list
5136 (let ((regexp (eval (caar list)))
5137 (function (cdar list)))
5138 (setq list (cdr list))
5139 (when (thing-at-point-looking-at regexp)
5140 (setq found t)
5141 (setq changed (funcall function))
5142 (setq list nil))))
5143 (if found
5144 (or changed (user-error "Markup at point is complete"))
5145 (user-error "Nothing to complete at point"))))
5147 (defun markdown-complete-region (beg end)
5148 "Complete markup of objects in region from BEG to END.
5149 Handle all objects in `markdown-complete-alist', in order. Each
5150 match is checked to ensure that a previous regexp does not also
5151 match."
5152 (interactive "*r")
5153 (let ((end-marker (set-marker (make-marker) end))
5154 previous)
5155 (dolist (element markdown-complete-alist)
5156 (let ((regexp (eval (car element)))
5157 (function (cdr element)))
5158 (goto-char beg)
5159 (while (re-search-forward regexp end-marker 'limit)
5160 (when (match-string 0)
5161 ;; Make sure this is not a match for any of the preceding regexps.
5162 ;; This prevents mistaking an HR for a Setext subheading.
5163 (let (match)
5164 (save-match-data
5165 (dolist (prev-regexp previous)
5166 (or match (setq match (looking-back prev-regexp nil)))))
5167 (unless match
5168 (save-excursion (funcall function))))))
5169 (cl-pushnew regexp previous :test #'equal)))
5170 previous))
5172 (defun markdown-complete-buffer ()
5173 "Complete markup for all objects in the current buffer."
5174 (interactive "*")
5175 (markdown-complete-region (point-min) (point-max)))
5178 ;;; Markup Cycling ============================================================
5180 (defun markdown-cycle-atx (arg &optional remove)
5181 "Cycle ATX header markup.
5182 Promote header (decrease level) when ARG is 1 and demote
5183 header (increase level) if arg is -1. When REMOVE is non-nil,
5184 remove the header when the level reaches zero and stop cycling
5185 when it reaches six. Otherwise, perform a proper cycling through
5186 levels one through six. Assumes match data is available for
5187 `markdown-regex-header-atx'."
5188 (let* ((old-level (length (match-string 1)))
5189 (new-level (+ old-level arg))
5190 (text (match-string 2)))
5191 (when (not remove)
5192 (setq new-level (% new-level 6))
5193 (setq new-level (cond ((= new-level 0) 6)
5194 ((< new-level 0) (+ new-level 6))
5195 (t new-level))))
5196 (cond
5197 ((= new-level 0)
5198 (markdown-unwrap-thing-at-point nil 0 2))
5199 ((<= new-level 6)
5200 (goto-char (match-beginning 0))
5201 (delete-region (match-beginning 0) (match-end 0))
5202 (markdown-insert-header new-level text nil)))))
5204 (defun markdown-cycle-setext (arg &optional remove)
5205 "Cycle setext header markup.
5206 Promote header (increase level) when ARG is 1 and demote
5207 header (decrease level or remove) if arg is -1. When demoting a
5208 level-two setext header, replace with a level-three atx header.
5209 When REMOVE is non-nil, remove the header when the level reaches
5210 zero. Otherwise, cycle back to a level six atx header. Assumes
5211 match data is available for `markdown-regex-header-setext'."
5212 (let* ((char (char-after (match-beginning 2)))
5213 (old-level (if (char-equal char ?=) 1 2))
5214 (new-level (+ old-level arg)))
5215 (when (and (not remove) (= new-level 0))
5216 (setq new-level 6))
5217 (cond
5218 ((= new-level 0)
5219 (markdown-unwrap-thing-at-point nil 0 1))
5220 ((<= new-level 2)
5221 (markdown-insert-header new-level nil t))
5222 ((<= new-level 6)
5223 (markdown-insert-header new-level nil nil)))))
5225 (defun markdown-cycle-hr (arg &optional remove)
5226 "Cycle string used for horizontal rule from `markdown-hr-strings'.
5227 When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
5228 backwards (promote). When REMOVE is non-nil, remove the hr instead
5229 of cycling when the end of the list is reached.
5230 Assumes match data is available for `markdown-regex-hr'."
5231 (let* ((strings (if (= arg -1)
5232 (reverse markdown-hr-strings)
5233 markdown-hr-strings))
5234 (tail (member (match-string 0) strings))
5235 (new (or (cadr tail)
5236 (if remove
5237 (if (= arg 1)
5239 (car tail))
5240 (car strings)))))
5241 (replace-match new)))
5243 (defun markdown-cycle-bold ()
5244 "Cycle bold markup between underscores and asterisks.
5245 Assumes match data is available for `markdown-regex-bold'."
5246 (save-excursion
5247 (let* ((old-delim (match-string 3))
5248 (new-delim (if (string-equal old-delim "**") "__" "**")))
5249 (replace-match new-delim t t nil 3)
5250 (replace-match new-delim t t nil 5))))
5252 (defun markdown-cycle-italic ()
5253 "Cycle italic markup between underscores and asterisks.
5254 Assumes match data is available for `markdown-regex-italic'."
5255 (save-excursion
5256 (let* ((old-delim (match-string 2))
5257 (new-delim (if (string-equal old-delim "*") "_" "*")))
5258 (replace-match new-delim t t nil 2)
5259 (replace-match new-delim t t nil 4))))
5262 ;;; Keymap ====================================================================
5264 (defun markdown--style-map-prompt ()
5265 "Return a formatted prompt for Markdown markup insertion."
5266 (when markdown-enable-prefix-prompts
5267 (concat
5268 "Markdown: "
5269 (propertize "bold" 'face 'markdown-bold-face) ", "
5270 (propertize "italic" 'face 'markdown-italic-face) ", "
5271 (propertize "code" 'face 'markdown-inline-code-face) ", "
5272 (propertize "C = GFM code" 'face 'markdown-code-face) ", "
5273 (propertize "pre" 'face 'markdown-pre-face) ", "
5274 (propertize "footnote" 'face 'markdown-footnote-text-face) ", "
5275 (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", "
5276 (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", "
5277 (propertize "- = hr" 'face 'markdown-hr-face) ", "
5278 "C-h = more")))
5280 (defun markdown--command-map-prompt ()
5281 "Return prompt for Markdown buffer-wide commands."
5282 (when markdown-enable-prefix-prompts
5283 (concat
5284 "Command: "
5285 (propertize "m" 'face 'markdown-bold-face) "arkdown, "
5286 (propertize "p" 'face 'markdown-bold-face) "review, "
5287 (propertize "o" 'face 'markdown-bold-face) "pen, "
5288 (propertize "e" 'face 'markdown-bold-face) "xport, "
5289 "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, "
5290 (propertize "c" 'face 'markdown-bold-face) "heck refs, "
5291 "C-h = more")))
5293 (defvar markdown-mode-style-map
5294 (let ((map (make-keymap (markdown--style-map-prompt))))
5295 (define-key map (kbd "1") 'markdown-insert-header-atx-1)
5296 (define-key map (kbd "2") 'markdown-insert-header-atx-2)
5297 (define-key map (kbd "3") 'markdown-insert-header-atx-3)
5298 (define-key map (kbd "4") 'markdown-insert-header-atx-4)
5299 (define-key map (kbd "5") 'markdown-insert-header-atx-5)
5300 (define-key map (kbd "6") 'markdown-insert-header-atx-6)
5301 (define-key map (kbd "!") 'markdown-insert-header-setext-1)
5302 (define-key map (kbd "@") 'markdown-insert-header-setext-2)
5303 (define-key map (kbd "b") 'markdown-insert-bold)
5304 (define-key map (kbd "c") 'markdown-insert-code)
5305 (define-key map (kbd "C") 'markdown-insert-gfm-code-block)
5306 (define-key map (kbd "f") 'markdown-insert-footnote)
5307 (define-key map (kbd "h") 'markdown-insert-header-dwim)
5308 (define-key map (kbd "H") 'markdown-insert-header-setext-dwim)
5309 (define-key map (kbd "i") 'markdown-insert-italic)
5310 (define-key map (kbd "k") 'markdown-insert-kbd)
5311 (define-key map (kbd "l") 'markdown-insert-link)
5312 (define-key map (kbd "p") 'markdown-insert-pre)
5313 (define-key map (kbd "P") 'markdown-pre-region)
5314 (define-key map (kbd "q") 'markdown-insert-blockquote)
5315 (define-key map (kbd "s") 'markdown-insert-strike-through)
5316 (define-key map (kbd "Q") 'markdown-blockquote-region)
5317 (define-key map (kbd "w") 'markdown-insert-wiki-link)
5318 (define-key map (kbd "-") 'markdown-insert-hr)
5319 (define-key map (kbd "[") 'markdown-insert-gfm-checkbox)
5320 ;; Deprecated keys that may be removed in a future version
5321 (define-key map (kbd "e") 'markdown-insert-italic)
5322 map)
5323 "Keymap for Markdown text styling commands.")
5325 (defvar markdown-mode-command-map
5326 (let ((map (make-keymap (markdown--command-map-prompt))))
5327 (define-key map (kbd "m") 'markdown-other-window)
5328 (define-key map (kbd "p") 'markdown-preview)
5329 (define-key map (kbd "e") 'markdown-export)
5330 (define-key map (kbd "v") 'markdown-export-and-preview)
5331 (define-key map (kbd "o") 'markdown-open)
5332 (define-key map (kbd "l") 'markdown-live-preview-mode)
5333 (define-key map (kbd "w") 'markdown-kill-ring-save)
5334 (define-key map (kbd "c") 'markdown-check-refs)
5335 (define-key map (kbd "n") 'markdown-cleanup-list-numbers)
5336 (define-key map (kbd "]") 'markdown-complete-buffer)
5337 (define-key map (kbd "^") 'markdown-table-sort-lines)
5338 (define-key map (kbd "|") 'markdown-table-convert-region)
5339 (define-key map (kbd "t") 'markdown-table-transpose)
5340 map)
5341 "Keymap for Markdown buffer-wide commands.")
5343 (defvar markdown-mode-map
5344 (let ((map (make-keymap)))
5345 ;; Markup insertion & removal
5346 (define-key map (kbd "C-c C-s") markdown-mode-style-map)
5347 (define-key map (kbd "C-c C-l") 'markdown-insert-link)
5348 (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point)
5349 ;; Promotion, demotion, and cycling
5350 (define-key map (kbd "C-c C--") 'markdown-promote)
5351 (define-key map (kbd "C-c C-=") 'markdown-demote)
5352 (define-key map (kbd "C-c C-]") 'markdown-complete)
5353 ;; Following and doing things
5354 (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point)
5355 (define-key map (kbd "C-c C-d") 'markdown-do)
5356 (define-key map (kbd "C-c '") 'markdown-edit-code-block)
5357 ;; Indentation
5358 (define-key map (kbd "C-m") 'markdown-enter-key)
5359 (define-key map (kbd "DEL") 'markdown-outdent-or-delete)
5360 (define-key map (kbd "C-c >") 'markdown-indent-region)
5361 (define-key map (kbd "C-c <") 'markdown-outdent-region)
5362 ;; Visibility cycling
5363 (define-key map (kbd "TAB") 'markdown-cycle)
5364 (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
5365 (define-key map (kbd "<S-tab>") 'markdown-shifttab)
5366 (define-key map (kbd "<backtab>") 'markdown-shifttab)
5367 ;; Heading and list navigation
5368 (define-key map (kbd "C-c C-n") 'markdown-outline-next)
5369 (define-key map (kbd "C-c C-p") 'markdown-outline-previous)
5370 (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level)
5371 (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level)
5372 (define-key map (kbd "C-c C-u") 'markdown-outline-up)
5373 ;; Buffer-wide commands
5374 (define-key map (kbd "C-c C-c") markdown-mode-command-map)
5375 ;; Subtree, list, and table editing
5376 (define-key map (kbd "C-c <up>") 'markdown-move-up)
5377 (define-key map (kbd "C-c <down>") 'markdown-move-down)
5378 (define-key map (kbd "C-c <left>") 'markdown-promote)
5379 (define-key map (kbd "C-c <right>") 'markdown-demote)
5380 (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row)
5381 (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row)
5382 (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column)
5383 (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column)
5384 (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree)
5385 (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree)
5386 (define-key map (kbd "M-RET") 'markdown-insert-list-item)
5387 (define-key map (kbd "C-c C-j") 'markdown-insert-list-item)
5388 ;; Paragraphs (Markdown context aware)
5389 (define-key map [remap backward-paragraph] 'markdown-backward-paragraph)
5390 (define-key map [remap forward-paragraph] 'markdown-forward-paragraph)
5391 (define-key map [remap mark-paragraph] 'markdown-mark-paragraph)
5392 ;; Blocks (one or more paragraphs)
5393 (define-key map (kbd "C-M-{") 'markdown-backward-block)
5394 (define-key map (kbd "C-M-}") 'markdown-forward-block)
5395 (define-key map (kbd "C-c M-h") 'markdown-mark-block)
5396 (define-key map (kbd "C-x n b") 'markdown-narrow-to-block)
5397 ;; Pages (top-level sections)
5398 (define-key map [remap backward-page] 'markdown-backward-page)
5399 (define-key map [remap forward-page] 'markdown-forward-page)
5400 (define-key map [remap mark-page] 'markdown-mark-page)
5401 (define-key map [remap narrow-to-page] 'markdown-narrow-to-page)
5402 ;; Link Movement
5403 (define-key map (kbd "M-n") 'markdown-next-link)
5404 (define-key map (kbd "M-p") 'markdown-previous-link)
5405 ;; Toggling functionality
5406 (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math)
5407 (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively)
5408 (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images)
5409 (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding)
5410 (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding)
5411 ;; Alternative keys (in case of problems with the arrow keys)
5412 (define-key map (kbd "C-c C-x u") 'markdown-move-up)
5413 (define-key map (kbd "C-c C-x d") 'markdown-move-down)
5414 (define-key map (kbd "C-c C-x l") 'markdown-promote)
5415 (define-key map (kbd "C-c C-x r") 'markdown-demote)
5416 ;; Deprecated keys that may be removed in a future version
5417 (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l
5418 (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l
5419 (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l
5420 (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l
5421 (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote)
5422 (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link)
5423 (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1)
5424 (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2)
5425 (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3)
5426 (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4)
5427 (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5)
5428 (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6)
5429 (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1)
5430 (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2)
5431 (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim)
5432 (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim)
5433 (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2)
5434 (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1)
5435 (define-key map (kbd "C-c C-i") 'markdown-insert-image)
5436 (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j
5437 (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d
5438 (define-key map (kbd "C-c -") 'markdown-insert-hr)
5439 map)
5440 "Keymap for Markdown major mode.")
5442 (defvar markdown-mode-mouse-map
5443 (let ((map (make-sparse-keymap)))
5444 (define-key map [follow-link] 'mouse-face)
5445 (define-key map [mouse-2] 'markdown-follow-link-at-point)
5446 map)
5447 "Keymap for following links with mouse.")
5449 (defvar gfm-mode-map
5450 (let ((map (make-sparse-keymap)))
5451 (set-keymap-parent map markdown-mode-map)
5452 (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through)
5453 (define-key map "`" 'markdown-electric-backquote)
5454 map)
5455 "Keymap for `gfm-mode'.
5456 See also `markdown-mode-map'.")
5459 ;;; Menu ==================================================================
5461 (easy-menu-define markdown-mode-menu markdown-mode-map
5462 "Menu for Markdown mode"
5463 '("Markdown"
5464 "---"
5465 ("Movement"
5466 ["Jump" markdown-do]
5467 ["Follow Link" markdown-follow-thing-at-point]
5468 ["Next Link" markdown-next-link]
5469 ["Previous Link" markdown-previous-link]
5470 "---"
5471 ["Next Heading or List Item" markdown-outline-next]
5472 ["Previous Heading or List Item" markdown-outline-previous]
5473 ["Next at Same Level" markdown-outline-next-same-level]
5474 ["Previous at Same Level" markdown-outline-previous-same-level]
5475 ["Up to Parent" markdown-outline-up]
5476 "---"
5477 ["Forward Paragraph" markdown-forward-paragraph]
5478 ["Backward Paragraph" markdown-backward-paragraph]
5479 ["Forward Block" markdown-forward-block]
5480 ["Backward Block" markdown-backward-block])
5481 ("Show & Hide"
5482 ["Cycle Heading Visibility" markdown-cycle
5483 :enable (markdown-on-heading-p)]
5484 ["Cycle Heading Visibility (Global)" markdown-shifttab]
5485 "---"
5486 ["Narrow to Region" narrow-to-region]
5487 ["Narrow to Block" markdown-narrow-to-block]
5488 ["Narrow to Section" narrow-to-defun]
5489 ["Narrow to Subtree" markdown-narrow-to-subtree]
5490 ["Widen" widen (buffer-narrowed-p)]
5491 "---"
5492 ["Toggle Markup Hiding" markdown-toggle-markup-hiding
5493 :keys "C-c C-x C-m"
5494 :style radio
5495 :selected markdown-hide-markup])
5496 "---"
5497 ("Headings & Structure"
5498 ["Automatic Heading" markdown-insert-header-dwim
5499 :keys "C-c C-s h"]
5500 ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
5501 :keys "C-c C-s H"]
5502 ("Specific Heading (atx)"
5503 ["First Level atx" markdown-insert-header-atx-1
5504 :keys "C-c C-s 1"]
5505 ["Second Level atx" markdown-insert-header-atx-2
5506 :keys "C-c C-s 2"]
5507 ["Third Level atx" markdown-insert-header-atx-3
5508 :keys "C-c C-s 3"]
5509 ["Fourth Level atx" markdown-insert-header-atx-4
5510 :keys "C-c C-s 4"]
5511 ["Fifth Level atx" markdown-insert-header-atx-5
5512 :keys "C-c C-s 5"]
5513 ["Sixth Level atx" markdown-insert-header-atx-6
5514 :keys "C-c C-s 6"])
5515 ("Specific Heading (Setext)"
5516 ["First Level Setext" markdown-insert-header-setext-1
5517 :keys "C-c C-s !"]
5518 ["Second Level Setext" markdown-insert-header-setext-2
5519 :keys "C-c C-s @"])
5520 ["Horizontal Rule" markdown-insert-hr
5521 :keys "C-c C-s -"]
5522 "---"
5523 ["Move Subtree Up" markdown-move-up
5524 :keys "C-c <up>"]
5525 ["Move Subtree Down" markdown-move-down
5526 :keys "C-c <down>"]
5527 ["Promote Subtree" markdown-promote
5528 :keys "C-c <left>"]
5529 ["Demote Subtree" markdown-demote
5530 :keys "C-c <right>"])
5531 ("Region & Mark"
5532 ["Indent Region" markdown-indent-region]
5533 ["Outdent Region" markdown-outdent-region]
5534 "--"
5535 ["Mark Paragraph" mark-paragraph]
5536 ["Mark Block" markdown-mark-block]
5537 ["Mark Section" mark-defun]
5538 ["Mark Subtree" markdown-mark-subtree])
5539 ("Tables"
5540 ["Move Row Up" markdown-move-up
5541 :enable (markdown-table-at-point-p)
5542 :keys "C-c <up>"]
5543 ["Move Row Down" markdown-move-down
5544 :enable (markdown-table-at-point-p)
5545 :keys "C-c <down>"]
5546 ["Move Column Left" markdown-demote
5547 :enable (markdown-table-at-point-p)
5548 :keys "C-c <left>"]
5549 ["Move Column Right" markdown-promote
5550 :enable (markdown-table-at-point-p)
5551 :keys "C-c <right>"]
5552 ["Delete Row" markdown-table-delete-row
5553 :enable (markdown-table-at-point-p)]
5554 ["Insert Row" markdown-table-insert-row
5555 :enable (markdown-table-at-point-p)]
5556 ["Delete Column" markdown-table-delete-column
5557 :enable (markdown-table-at-point-p)]
5558 ["Insert Column" markdown-table-insert-column
5559 :enable (markdown-table-at-point-p)]
5560 "--"
5561 ["Convert Region to Table" markdown-table-convert-region]
5562 ["Sort Table Lines" markdown-table-sort-lines
5563 :enable (markdown-table-at-point-p)]
5564 ["Transpose Table" markdown-table-transpose
5565 :enable (markdown-table-at-point-p)])
5566 ("Lists"
5567 ["Insert List Item" markdown-insert-list-item]
5568 ["Move Subtree Up" markdown-move-up
5569 :keys "C-c <up>"]
5570 ["Move Subtree Down" markdown-move-down
5571 :keys "C-c <down>"]
5572 ["Indent Subtree" markdown-demote
5573 :keys "C-c <right>"]
5574 ["Outdent Subtree" markdown-promote
5575 :keys "C-c <left>"]
5576 ["Renumber List" markdown-cleanup-list-numbers]
5577 ["Insert Task List Item" markdown-insert-gfm-checkbox
5578 :keys "C-c C-x ["]
5579 ["Toggle Task List Item" markdown-toggle-gfm-checkbox
5580 :enable (markdown-gfm-task-list-item-at-point)
5581 :keys "C-c C-d"])
5582 ("Links & Images"
5583 ["Insert Link" markdown-insert-link]
5584 ["Insert Image" markdown-insert-image]
5585 ["Insert Footnote" markdown-insert-footnote
5586 :keys "C-c C-s f"]
5587 ["Insert Wiki Link" markdown-insert-wiki-link
5588 :keys "C-c C-s w"]
5589 "---"
5590 ["Check References" markdown-check-refs]
5591 ["Toggle URL Hiding" markdown-toggle-url-hiding
5592 :style radio
5593 :selected markdown-hide-urls]
5594 ["Toggle Inline Images" markdown-toggle-inline-images
5595 :keys "C-c C-x C-i"
5596 :style radio
5597 :selected markdown-inline-image-overlays]
5598 ["Toggle Wiki Links" markdown-toggle-wiki-links
5599 :style radio
5600 :selected markdown-enable-wiki-links])
5601 ("Styles"
5602 ["Bold" markdown-insert-bold]
5603 ["Italic" markdown-insert-italic]
5604 ["Code" markdown-insert-code]
5605 ["Strikethrough" markdown-insert-strike-through]
5606 ["Keyboard" markdown-insert-kbd]
5607 "---"
5608 ["Blockquote" markdown-insert-blockquote]
5609 ["Preformatted" markdown-insert-pre]
5610 ["GFM Code Block" markdown-insert-gfm-code-block]
5611 ["Edit Code Block" markdown-edit-code-block
5612 :enable (markdown-code-block-at-point-p)]
5613 "---"
5614 ["Blockquote Region" markdown-blockquote-region]
5615 ["Preformatted Region" markdown-pre-region]
5616 "---"
5617 ["Fontify Code Blocks Natively"
5618 markdown-toggle-fontify-code-blocks-natively
5619 :style radio
5620 :selected markdown-fontify-code-blocks-natively]
5621 ["LaTeX Math Support" markdown-toggle-math
5622 :style radio
5623 :selected markdown-enable-math])
5624 "---"
5625 ("Preview & Export"
5626 ["Compile" markdown-other-window]
5627 ["Preview" markdown-preview]
5628 ["Export" markdown-export]
5629 ["Export & View" markdown-export-and-preview]
5630 ["Open" markdown-open]
5631 ["Live Export" markdown-live-preview-mode
5632 :style radio
5633 :selected markdown-live-preview-mode]
5634 ["Kill ring save" markdown-kill-ring-save])
5635 ("Markup Completion and Cycling"
5636 ["Complete Markup" markdown-complete]
5637 ["Promote Element" markdown-promote
5638 :keys "C-c C--"]
5639 ["Demote Element" markdown-demote
5640 :keys "C-c C-="])
5641 "---"
5642 ["Kill Element" markdown-kill-thing-at-point]
5643 "---"
5644 ("Documentation"
5645 ["Version" markdown-show-version]
5646 ["Homepage" markdown-mode-info]
5647 ["Describe Mode" (describe-function 'markdown-mode)]
5648 ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
5651 ;;; imenu =====================================================================
5653 (defun markdown-imenu-create-nested-index ()
5654 "Create and return a nested imenu index alist for the current buffer.
5655 See `imenu-create-index-function' and `imenu--index-alist' for details."
5656 (let* ((root '(nil . nil))
5657 cur-alist
5658 (cur-level 0)
5659 (empty-heading "-")
5660 (self-heading ".")
5661 hashes pos level heading)
5662 (save-excursion
5663 ;; Headings
5664 (goto-char (point-min))
5665 (while (re-search-forward markdown-regex-header (point-max) t)
5666 (unless (markdown-code-block-at-point-p)
5667 (cond
5668 ((match-string-no-properties 2) ;; level 1 setext
5669 (setq heading (match-string-no-properties 1))
5670 (setq pos (match-beginning 1)
5671 level 1))
5672 ((match-string-no-properties 3) ;; level 2 setext
5673 (setq heading (match-string-no-properties 1))
5674 (setq pos (match-beginning 1)
5675 level 2))
5676 ((setq hashes (markdown-trim-whitespace
5677 (match-string-no-properties 4)))
5678 (setq heading (match-string-no-properties 5)
5679 pos (match-beginning 4)
5680 level (length hashes))))
5681 (let ((alist (list (cons heading pos))))
5682 (cond
5683 ((= cur-level level) ; new sibling
5684 (setcdr cur-alist alist)
5685 (setq cur-alist alist))
5686 ((< cur-level level) ; first child
5687 (dotimes (_ (- level cur-level 1))
5688 (setq alist (list (cons empty-heading alist))))
5689 (if cur-alist
5690 (let* ((parent (car cur-alist))
5691 (self-pos (cdr parent)))
5692 (setcdr parent (cons (cons self-heading self-pos) alist)))
5693 (setcdr root alist)) ; primogenitor
5694 (setq cur-alist alist)
5695 (setq cur-level level))
5696 (t ; new sibling of an ancestor
5697 (let ((sibling-alist (last (cdr root))))
5698 (dotimes (_ (1- level))
5699 (setq sibling-alist (last (cdar sibling-alist))))
5700 (setcdr sibling-alist alist)
5701 (setq cur-alist alist))
5702 (setq cur-level level))))))
5703 ;; Footnotes
5704 (let ((fn (markdown-get-defined-footnotes)))
5705 (if (or (zerop (length fn))
5706 (null markdown-add-footnotes-to-imenu))
5707 (cdr root)
5708 (nconc (cdr root) (list (cons "Footnotes" fn))))))))
5710 (defun markdown-imenu-create-flat-index ()
5711 "Create and return a flat imenu index alist for the current buffer.
5712 See `imenu-create-index-function' and `imenu--index-alist' for details."
5713 (let* ((empty-heading "-") index heading pos)
5714 (save-excursion
5715 ;; Headings
5716 (goto-char (point-min))
5717 (while (re-search-forward markdown-regex-header (point-max) t)
5718 (when (and (not (markdown-code-block-at-point-p))
5719 (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin)))
5720 (cond
5721 ((setq heading (match-string-no-properties 1))
5722 (setq pos (match-beginning 1)))
5723 ((setq heading (match-string-no-properties 5))
5724 (setq pos (match-beginning 4))))
5725 (or (> (length heading) 0)
5726 (setq heading empty-heading))
5727 (setq index (append index (list (cons heading pos))))))
5728 ;; Footnotes
5729 (when markdown-add-footnotes-to-imenu
5730 (nconc index (markdown-get-defined-footnotes)))
5731 index)))
5734 ;;; References ================================================================
5736 (defun markdown-reference-goto-definition ()
5737 "Jump to the definition of the reference at point or create it."
5738 (interactive)
5739 (when (thing-at-point-looking-at markdown-regex-link-reference)
5740 (let* ((text (match-string-no-properties 3))
5741 (reference (match-string-no-properties 6))
5742 (target (downcase (if (string= reference "") text reference)))
5743 (loc (cadr (save-match-data (markdown-reference-definition target)))))
5744 (if loc
5745 (goto-char loc)
5746 (goto-char (match-beginning 0))
5747 (markdown-insert-reference-definition target)))))
5749 (defun markdown-reference-find-links (reference)
5750 "Return a list of all links for REFERENCE.
5751 REFERENCE should not include the surrounding square brackets.
5752 Elements of the list have the form (text start line), where
5753 text is the link text, start is the location at the beginning of
5754 the link, and line is the line number on which the link appears."
5755 (let* ((ref-quote (regexp-quote reference))
5756 (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
5757 ref-quote ref-quote))
5758 links)
5759 (save-excursion
5760 (goto-char (point-min))
5761 (while (re-search-forward regexp nil t)
5762 (let* ((text (or (match-string-no-properties 1)
5763 (match-string-no-properties 2)))
5764 (start (match-beginning 0))
5765 (line (markdown-line-number-at-pos)))
5766 (cl-pushnew (list text start line) links :test #'equal))))
5767 links))
5769 (defmacro markdown-for-all-refs (f)
5770 `(let ((result))
5771 (save-excursion
5772 (goto-char (point-min))
5773 (while
5774 (re-search-forward markdown-regex-link-reference nil t)
5775 (let* ((text (match-string-no-properties 3))
5776 (reference (match-string-no-properties 6))
5777 (target (downcase (if (string= reference "") text reference))))
5778 (,f text target result))))
5779 (reverse result)))
5781 (defmacro markdown-collect-always (_ target result)
5782 `(cl-pushnew ,target ,result :test #'equal))
5784 (defmacro markdown-collect-undefined (text target result)
5785 `(unless (markdown-reference-definition target)
5786 (let ((entry (assoc ,target ,result)))
5787 (if (not entry)
5788 (cl-pushnew
5789 (cons ,target (list (cons ,text (markdown-line-number-at-pos))))
5790 ,result :test #'equal)
5791 (setcdr entry
5792 (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos)))))))))
5794 (defun markdown-get-all-refs ()
5795 "Return a list of all Markdown references."
5796 (markdown-for-all-refs markdown-collect-always))
5798 (defun markdown-get-undefined-refs ()
5799 "Return a list of undefined Markdown references.
5800 Result is an alist of pairs (reference . occurrences), where
5801 occurrences is itself another alist of pairs (label . line-number).
5802 For example, an alist corresponding to [Nice editor][Emacs] at line 12,
5803 \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
5804 \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
5805 (markdown-for-all-refs markdown-collect-undefined))
5807 (defconst markdown-reference-check-buffer
5808 "*Undefined references for %buffer%*"
5809 "Pattern for name of buffer for listing undefined references.
5810 The string %buffer% will be replaced by the corresponding
5811 `markdown-mode' buffer name.")
5813 (defun markdown-reference-check-buffer (&optional buffer-name)
5814 "Name and return buffer for reference checking.
5815 BUFFER-NAME is the name of the main buffer being visited."
5816 (or buffer-name (setq buffer-name (buffer-name)))
5817 (let ((refbuf (get-buffer-create (markdown-replace-regexp-in-string
5818 "%buffer%" buffer-name
5819 markdown-reference-check-buffer))))
5820 (with-current-buffer refbuf
5821 (when view-mode
5822 (View-exit-and-edit))
5823 (use-local-map button-buffer-map)
5824 (erase-buffer))
5825 refbuf))
5827 (defconst markdown-reference-links-buffer
5828 "*Reference links for %buffer%*"
5829 "Pattern for name of buffer for listing references.
5830 The string %buffer% will be replaced by the corresponding buffer name.")
5832 (defun markdown-reference-links-buffer (&optional buffer-name)
5833 "Name, setup, and return a buffer for listing links.
5834 BUFFER-NAME is the name of the main buffer being visited."
5835 (or buffer-name (setq buffer-name (buffer-name)))
5836 (let ((linkbuf (get-buffer-create (markdown-replace-regexp-in-string
5837 "%buffer%" buffer-name
5838 markdown-reference-links-buffer))))
5839 (with-current-buffer linkbuf
5840 (when view-mode
5841 (View-exit-and-edit))
5842 (use-local-map button-buffer-map)
5843 (erase-buffer))
5844 linkbuf))
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 '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 (message (button-get b 'buffer))
5871 (switch-to-buffer-other-window (button-get b 'target-buffer))
5872 ;; use call-interactively to silence compiler
5873 (let ((current-prefix-arg (button-get b 'target-line)))
5874 (call-interactively 'goto-line))))
5876 ;; Jumps to a particular link at location given by 'target-char
5877 ;; property in buffer given by 'target-buffer property.
5878 (define-button-type 'markdown-location-button
5879 'help-echo "mouse-1, RET: jump to location of link"
5880 'follow-link t
5881 'face 'bold
5882 'action (lambda (b)
5883 (let ((target (button-get b 'target-buffer))
5884 (loc (button-get b 'target-char)))
5885 (kill-buffer-and-window)
5886 (switch-to-buffer target)
5887 (goto-char loc))))
5889 (defun markdown-insert-undefined-reference-button (reference oldbuf)
5890 "Insert a button for creating REFERENCE in buffer OLDBUF.
5891 REFERENCE should be a list of the form (reference . occurrences),
5892 as by `markdown-get-undefined-refs'."
5893 (let ((label (car reference)))
5894 ;; Create a reference button
5895 (insert-button label
5896 :type 'markdown-undefined-reference-button
5897 'target-buffer oldbuf
5898 'target-line (cdr (car (cdr reference))))
5899 (insert " (")
5900 (dolist (occurrence (cdr reference))
5901 (let ((line (cdr occurrence)))
5902 ;; Create a line number button
5903 (insert-button (number-to-string line)
5904 :type 'markdown-goto-line-button
5905 'target-buffer oldbuf
5906 'target-line line)
5907 (insert " ")))
5908 (delete-char -1)
5909 (insert ")")
5910 (newline)))
5912 (defun markdown-insert-link-button (link oldbuf)
5913 "Insert a button for jumping to LINK in buffer OLDBUF.
5914 LINK should be a list of the form (text char line) containing
5915 the link text, location, and line number."
5916 (let ((label (cl-first link))
5917 (char (cl-second link))
5918 (line (cl-third link)))
5919 ;; Create a reference button
5920 (insert-button label
5921 :type 'markdown-location-button
5922 'target-buffer oldbuf
5923 'target-char char)
5924 (insert (format " (line %d)\n" line))))
5926 (defun markdown-reference-goto-link (&optional reference)
5927 "Jump to the location of the first use of REFERENCE."
5928 (interactive)
5929 (unless reference
5930 (if (thing-at-point-looking-at markdown-regex-reference-definition)
5931 (setq reference (match-string-no-properties 2))
5932 (user-error "No reference definition at point")))
5933 (let ((links (markdown-reference-find-links reference)))
5934 (cond ((= (length links) 1)
5935 (goto-char (cadr (car links))))
5936 ((> (length links) 1)
5937 (let ((oldbuf (current-buffer))
5938 (linkbuf (markdown-reference-links-buffer)))
5939 (with-current-buffer linkbuf
5940 (insert "Links using reference " reference ":\n\n")
5941 (dolist (link (reverse links))
5942 (markdown-insert-link-button link oldbuf)))
5943 (view-buffer-other-window linkbuf)
5944 (goto-char (point-min))
5945 (forward-line 2)))
5947 (error "No links for reference %s" reference)))))
5949 (defun markdown-check-refs (&optional silent)
5950 "Show all undefined Markdown references in current `markdown-mode' buffer.
5951 If SILENT is non-nil, do not message anything when no undefined
5952 references found.
5953 Links which have empty reference definitions are considered to be
5954 defined."
5955 (interactive "P")
5956 (when (not (memq major-mode '(markdown-mode gfm-mode)))
5957 (user-error "Not available in current mode"))
5958 (let ((oldbuf (current-buffer))
5959 (refs (markdown-get-undefined-refs))
5960 (refbuf (markdown-reference-check-buffer)))
5961 (if (null refs)
5962 (progn
5963 (when (not silent)
5964 (message "No undefined references found"))
5965 (kill-buffer refbuf))
5966 (with-current-buffer refbuf
5967 (insert "The following references are undefined:\n\n")
5968 (dolist (ref refs)
5969 (markdown-insert-undefined-reference-button ref oldbuf))
5970 (view-buffer-other-window refbuf)
5971 (goto-char (point-min))
5972 (forward-line 2)))))
5975 ;;; Lists =====================================================================
5977 (defun markdown-insert-list-item (&optional arg)
5978 "Insert a new list item.
5979 If the point is inside unordered list, insert a bullet mark. If
5980 the point is inside ordered list, insert the next number followed
5981 by a period. Use the previous list item to determine the amount
5982 of whitespace to place before and after list markers.
5984 With a \\[universal-argument] prefix (i.e., when ARG is (4)),
5985 decrease the indentation by one level.
5987 With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
5988 increase the indentation by one level."
5989 (interactive "p")
5990 (let (bounds cur-indent marker indent new-indent new-loc)
5991 (save-match-data
5992 ;; Look for a list item on current or previous non-blank line
5993 (save-excursion
5994 (while (and (not (setq bounds (markdown-cur-list-item-bounds)))
5995 (not (bobp))
5996 (markdown-cur-line-blank-p))
5997 (forward-line -1)))
5998 (when bounds
5999 (cond ((save-excursion
6000 (skip-chars-backward " \t")
6001 (looking-at-p markdown-regex-list))
6002 (beginning-of-line)
6003 (insert "\n")
6004 (forward-line -1))
6005 ((not (markdown-cur-line-blank-p))
6006 (newline)))
6007 (setq new-loc (point)))
6008 ;; Look ahead for a list item on next non-blank line
6009 (unless bounds
6010 (save-excursion
6011 (while (and (null bounds)
6012 (not (eobp))
6013 (markdown-cur-line-blank-p))
6014 (forward-line)
6015 (setq bounds (markdown-cur-list-item-bounds))))
6016 (when bounds
6017 (setq new-loc (point))
6018 (unless (markdown-cur-line-blank-p)
6019 (newline))))
6020 (if (not bounds)
6021 ;; When not in a list, start a new unordered one
6022 (progn
6023 (unless (markdown-cur-line-blank-p)
6024 (insert "\n"))
6025 (insert markdown-unordered-list-item-prefix))
6026 ;; Compute indentation and marker for new list item
6027 (setq cur-indent (nth 2 bounds))
6028 (setq marker (nth 4 bounds))
6029 ;; If current item is a GFM checkbox, insert new unchecked checkbox.
6030 (when (nth 5 bounds)
6031 (setq marker
6032 (concat marker
6033 (replace-regexp-in-string "[Xx]" " " (nth 5 bounds)))))
6034 (cond
6035 ;; Dedent: decrement indentation, find previous marker.
6036 ((= arg 4)
6037 (setq indent (max (- cur-indent 4) 0))
6038 (let ((prev-bounds
6039 (save-excursion
6040 (goto-char (nth 0 bounds))
6041 (when (markdown-up-list)
6042 (markdown-cur-list-item-bounds)))))
6043 (when prev-bounds
6044 (setq marker (nth 4 prev-bounds)))))
6045 ;; Indent: increment indentation by 4, use same marker.
6046 ((= arg 16) (setq indent (+ cur-indent 4)))
6047 ;; Same level: keep current indentation and marker.
6048 (t (setq indent cur-indent)))
6049 (setq new-indent (make-string indent 32))
6050 (goto-char new-loc)
6051 (cond
6052 ;; Ordered list
6053 ((string-match-p "[0-9]" marker)
6054 (if (= arg 16) ;; starting a new column indented one more level
6055 (insert (concat new-indent "1. "))
6056 ;; Don't use previous match-data
6057 (set-match-data nil)
6058 ;; travel up to the last item and pick the correct number. If
6059 ;; the argument was nil, "new-indent = cur-indent" is the same,
6060 ;; so we don't need special treatment. Neat.
6061 (save-excursion
6062 (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)")))
6063 (>= (forward-line -1) 0))))
6064 (let* ((old-prefix (match-string 1))
6065 (old-spacing (match-string 2))
6066 (new-prefix (if old-prefix
6067 (int-to-string (1+ (string-to-number old-prefix)))
6068 "1"))
6069 (space-adjust (- (length old-prefix) (length new-prefix)))
6070 (new-spacing (if (and (match-string 2)
6071 (not (string-match-p "\t" old-spacing))
6072 (< space-adjust 0)
6073 (> space-adjust (- 1 (length (match-string 2)))))
6074 (substring (match-string 2) 0 space-adjust)
6075 (or old-spacing ". "))))
6076 (insert (concat new-indent new-prefix new-spacing)))))
6077 ;; Unordered list, GFM task list, or ordered list with hash mark
6078 ((string-match-p "[\\*\\+-]\\|#\\." marker)
6079 (insert new-indent marker))))
6080 ;; Propertize the newly inserted list item now
6081 (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol)))))
6083 (defun markdown-move-list-item-up ()
6084 "Move the current list item up in the list when possible.
6085 In nested lists, move child items with the parent item."
6086 (interactive)
6087 (let (cur prev old)
6088 (when (setq cur (markdown-cur-list-item-bounds))
6089 (setq old (point))
6090 (goto-char (nth 0 cur))
6091 (if (markdown-prev-list-item (nth 3 cur))
6092 (progn
6093 (setq prev (markdown-cur-list-item-bounds))
6094 (condition-case nil
6095 (progn
6096 (transpose-regions (nth 0 prev) (nth 1 prev)
6097 (nth 0 cur) (nth 1 cur) t)
6098 (goto-char (+ (nth 0 prev) (- old (nth 0 cur)))))
6099 ;; Catch error in case regions overlap.
6100 (error (goto-char old))))
6101 (goto-char old)))))
6103 (defun markdown-move-list-item-down ()
6104 "Move the current list item down in the list when possible.
6105 In nested lists, move child items with the parent item."
6106 (interactive)
6107 (let (cur next old)
6108 (when (setq cur (markdown-cur-list-item-bounds))
6109 (setq old (point))
6110 (if (markdown-next-list-item (nth 3 cur))
6111 (progn
6112 (setq next (markdown-cur-list-item-bounds))
6113 (condition-case nil
6114 (progn
6115 (transpose-regions (nth 0 cur) (nth 1 cur)
6116 (nth 0 next) (nth 1 next) nil)
6117 (goto-char (+ old (- (nth 1 next) (nth 1 cur)))))
6118 ;; Catch error in case regions overlap.
6119 (error (goto-char old))))
6120 (goto-char old)))))
6122 (defun markdown-demote-list-item (&optional bounds)
6123 "Indent (or demote) the current list item.
6124 Optionally, BOUNDS of the current list item may be provided if available.
6125 In nested lists, demote child items as well."
6126 (interactive)
6127 (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
6128 (save-excursion
6129 (let* ((item-start (set-marker (make-marker) (nth 0 bounds)))
6130 (item-end (set-marker (make-marker) (nth 1 bounds)))
6131 (list-start (progn (markdown-beginning-of-list)
6132 (set-marker (make-marker) (point))))
6133 (list-end (progn (markdown-end-of-list)
6134 (set-marker (make-marker) (point)))))
6135 (goto-char item-start)
6136 (while (< (point) item-end)
6137 (unless (markdown-cur-line-blank-p)
6138 (insert (make-string markdown-list-indent-width ? )))
6139 (forward-line))
6140 (markdown-syntax-propertize-list-items list-start list-end)))))
6142 (defun markdown-promote-list-item (&optional bounds)
6143 "Unindent (or promote) the current list item.
6144 Optionally, BOUNDS of the current list item may be provided if available.
6145 In nested lists, demote child items as well."
6146 (interactive)
6147 (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
6148 (save-excursion
6149 (save-match-data
6150 (let ((item-start (set-marker (make-marker) (nth 0 bounds)))
6151 (item-end (set-marker (make-marker) (nth 1 bounds)))
6152 (list-start (progn (markdown-beginning-of-list)
6153 (set-marker (make-marker) (point))))
6154 (list-end (progn (markdown-end-of-list)
6155 (set-marker (make-marker) (point))))
6156 num regexp)
6157 (goto-char item-start)
6158 (when (looking-at (format "^[ ]\\{1,%d\\}"
6159 markdown-list-indent-width))
6160 (setq num (- (match-end 0) (match-beginning 0)))
6161 (setq regexp (format "^[ ]\\{1,%d\\}" num))
6162 (while (and (< (point) item-end)
6163 (re-search-forward regexp item-end t))
6164 (replace-match "" nil nil)
6165 (forward-line))
6166 (markdown-syntax-propertize-list-items list-start list-end)))))))
6168 (defun markdown-cleanup-list-numbers-level (&optional pfx)
6169 "Update the numbering for level PFX (as a string of spaces).
6171 Assume that the previously found match was for a numbered item in
6172 a list."
6173 (let ((cpfx pfx)
6174 (idx 0)
6175 (continue t)
6176 (step t)
6177 (sep nil))
6178 (while (and continue (not (eobp)))
6179 (setq step t)
6180 (cond
6181 ((looking-at "^\\([\s-]*\\)[0-9]+\\. ")
6182 (setq cpfx (match-string-no-properties 1))
6183 (cond
6184 ((string= cpfx pfx)
6185 (save-excursion
6186 (replace-match
6187 (concat pfx (number-to-string (setq idx (1+ idx))) ". ")))
6188 (setq sep nil))
6189 ;; indented a level
6190 ((string< pfx cpfx)
6191 (setq sep (markdown-cleanup-list-numbers-level cpfx))
6192 (setq step nil))
6193 ;; exit the loop
6195 (setq step nil)
6196 (setq continue nil))))
6198 ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
6199 (setq cpfx (match-string-no-properties 1))
6200 (cond
6201 ;; reset if separated before
6202 ((string= cpfx pfx) (when sep (setq idx 0)))
6203 ((string< cpfx pfx)
6204 (setq step nil)
6205 (setq continue nil))))
6206 (t (setq sep t)))
6208 (when step
6209 (beginning-of-line)
6210 (setq continue (= (forward-line) 0))))
6211 sep))
6213 (defun markdown-cleanup-list-numbers ()
6214 "Update the numbering of ordered lists."
6215 (interactive)
6216 (save-excursion
6217 (goto-char (point-min))
6218 (markdown-cleanup-list-numbers-level "")))
6221 ;;; Movement ==================================================================
6223 (defun markdown-beginning-of-defun (&optional arg)
6224 "`beginning-of-defun-function' for Markdown.
6225 This is used to find the beginning of the defun and should behave
6226 like ‘beginning-of-defun’, returning non-nil if it found the
6227 beginning of a defun. It moves the point backward, right before a
6228 heading which defines a defun. When ARG is non-nil, repeat that
6229 many times. When ARG is negative, move forward to the ARG-th
6230 following section."
6231 (or arg (setq arg 1))
6232 (when (< arg 0) (end-of-line))
6233 ;; Adjust position for setext headings.
6234 (when (and (thing-at-point-looking-at markdown-regex-header-setext)
6235 (not (= (point) (match-beginning 0)))
6236 (not (markdown-code-block-at-point-p)))
6237 (goto-char (match-end 0)))
6238 (let (found)
6239 ;; Move backward with positive argument.
6240 (while (and (not (bobp)) (> arg 0))
6241 (setq found nil)
6242 (while (and (not found)
6243 (not (bobp))
6244 (re-search-backward markdown-regex-header nil 'move))
6245 (when (not (markdown-code-block-at-pos (match-beginning 0))))
6246 (setq found (match-beginning 0)))
6247 (setq arg (1- arg)))
6248 ;; Move forward with negative argument.
6249 (while (and (not (eobp)) (< arg 0))
6250 (setq found nil)
6251 (while (and (not found)
6252 (not (eobp))
6253 (re-search-forward markdown-regex-header nil 'move))
6254 (when (not (markdown-code-block-at-pos (match-beginning 0))))
6255 (setq found (match-beginning 0)))
6256 (setq arg (1+ arg)))
6257 (when found
6258 (beginning-of-line)
6259 t)))
6261 (defun markdown-end-of-defun ()
6262 "`end-of-defun-function’ for Markdown.
6263 This is used to find the end of the defun at point.
6264 It is called with no argument, right after calling ‘beginning-of-defun-raw’,
6265 so it can assume that point is at the beginning of the defun body.
6266 It should move point to the first position after the defun."
6267 (or (eobp) (forward-char 1))
6268 (let (found)
6269 (while (and (not found)
6270 (not (eobp))
6271 (re-search-forward markdown-regex-header nil 'move))
6272 (when (not (markdown-code-block-at-pos (match-beginning 0)))
6273 (setq found (match-beginning 0))))
6274 (when found
6275 (goto-char found)
6276 (skip-syntax-backward "-"))))
6278 (make-obsolete 'markdown-beginning-of-block 'markdown-beginning-of-text-block "v2.2")
6280 (defun markdown-beginning-of-text-block ()
6281 "Move backward to previous beginning of a plain text block.
6282 This function simply looks for blank lines without considering
6283 the surrounding context in light of Markdown syntax. For that, see
6284 `markdown-backward-block'."
6285 (interactive)
6286 (let ((start (point)))
6287 (if (re-search-backward markdown-regex-block-separator nil t)
6288 (goto-char (match-end 0))
6289 (goto-char (point-min)))
6290 (when (and (= start (point)) (not (bobp)))
6291 (forward-line -1)
6292 (if (re-search-backward markdown-regex-block-separator nil t)
6293 (goto-char (match-end 0))
6294 (goto-char (point-min))))))
6296 (make-obsolete 'markdown-end-of-block 'markdown-end-of-text-block "v2.2")
6298 (defun markdown-end-of-text-block ()
6299 "Move forward to next beginning of a plain text block.
6300 This function simply looks for blank lines without considering
6301 the surrounding context in light of Markdown syntax. For that, see
6302 `markdown-forward-block'."
6303 (interactive)
6304 (beginning-of-line)
6305 (skip-chars-forward " \t\n")
6306 (when (= (point) (point-min))
6307 (forward-char))
6308 (if (re-search-forward markdown-regex-block-separator nil t)
6309 (goto-char (match-end 0))
6310 (goto-char (point-max)))
6311 (skip-chars-backward " \t\n")
6312 (forward-line))
6314 (defun markdown-backward-paragraph (&optional arg)
6315 "Move the point to the start of the current paragraph.
6316 With argument ARG, do it ARG times; a negative argument ARG = -N
6317 means move forward N blocks."
6318 (interactive "^p")
6319 (or arg (setq arg 1))
6320 (if (< arg 0)
6321 (markdown-forward-paragraph (- arg))
6322 (dotimes (_ arg)
6323 ;; Skip over whitespace in between paragraphs when moving backward.
6324 (skip-chars-backward " \t\n")
6325 (beginning-of-line)
6326 ;; Skip over code block endings.
6327 (when (markdown-range-properties-exist
6328 (point-at-bol) (point-at-eol)
6329 '(markdown-gfm-block-end
6330 markdown-tilde-fence-end))
6331 (forward-line -1))
6332 ;; Skip over blank lines inside blockquotes.
6333 (while (and (not (eobp))
6334 (looking-at markdown-regex-blockquote)
6335 (= (length (match-string 3)) 0))
6336 (forward-line -1))
6337 ;; Proceed forward based on the type of block of paragraph.
6338 (let (bounds skip)
6339 (cond
6340 ;; Blockquotes
6341 ((looking-at markdown-regex-blockquote)
6342 (while (and (not (bobp))
6343 (looking-at markdown-regex-blockquote)
6344 (> (length (match-string 3)) 0)) ;; not blank
6345 (forward-line -1))
6346 (forward-line))
6347 ;; List items
6348 ((setq bounds (markdown-cur-list-item-bounds))
6349 (goto-char (nth 0 bounds)))
6350 ;; Other
6352 (while (and (not (bobp))
6353 (not skip)
6354 (not (markdown-cur-line-blank-p))
6355 (not (looking-at markdown-regex-blockquote))
6356 (not (markdown-range-properties-exist
6357 (point-at-bol) (point-at-eol)
6358 '(markdown-gfm-block-end
6359 markdown-tilde-fence-end))))
6360 (setq skip (markdown-range-properties-exist
6361 (point-at-bol) (point-at-eol)
6362 '(markdown-gfm-block-begin
6363 markdown-tilde-fence-begin)))
6364 (forward-line -1))
6365 (unless (bobp)
6366 (forward-line 1))))))))
6368 (defun markdown-forward-paragraph (&optional arg)
6369 "Move forward to the next end of a paragraph.
6370 With argument ARG, do it ARG times; a negative argument ARG = -N
6371 means move backward N blocks."
6372 (interactive "^p")
6373 (or arg (setq arg 1))
6374 (if (< arg 0)
6375 (markdown-backward-paragraph (- arg))
6376 (dotimes (_ arg)
6377 ;; Skip whitespace in between paragraphs.
6378 (when (markdown-cur-line-blank-p)
6379 (skip-syntax-forward "-")
6380 (beginning-of-line))
6381 ;; Proceed forward based on the type of block.
6382 (let (bounds skip)
6383 (cond
6384 ;; Blockquotes
6385 ((looking-at markdown-regex-blockquote)
6386 ;; Skip over blank lines inside blockquotes.
6387 (while (and (not (eobp))
6388 (looking-at markdown-regex-blockquote)
6389 (= (length (match-string 3)) 0))
6390 (forward-line))
6391 ;; Move to end of quoted text block
6392 (while (and (not (eobp))
6393 (looking-at markdown-regex-blockquote)
6394 (> (length (match-string 3)) 0)) ;; not blank
6395 (forward-line)))
6396 ;; List items
6397 ((and (markdown-cur-list-item-bounds)
6398 (setq bounds (markdown-next-list-item-bounds)))
6399 (goto-char (nth 0 bounds)))
6400 ;; Other
6402 (forward-line)
6403 (while (and (not (eobp))
6404 (not skip)
6405 (not (markdown-cur-line-blank-p))
6406 (not (looking-at markdown-regex-blockquote))
6407 (not (markdown-range-properties-exist
6408 (point-at-bol) (point-at-eol)
6409 '(markdown-gfm-block-begin
6410 markdown-tilde-fence-begin))))
6411 (setq skip (markdown-range-properties-exist
6412 (point-at-bol) (point-at-eol)
6413 '(markdown-gfm-block-end
6414 markdown-tilde-fence-end)))
6415 (forward-line))))))))
6417 (defun markdown-backward-block (&optional arg)
6418 "Move the point to the start of the current Markdown block.
6419 Moves across complete code blocks, list items, and blockquotes,
6420 but otherwise stops at blank lines, headers, and horizontal
6421 rules. With argument ARG, do it ARG times; a negative argument
6422 ARG = -N means move forward N blocks."
6423 (interactive "^p")
6424 (or arg (setq arg 1))
6425 (if (< arg 0)
6426 (markdown-forward-block (- arg))
6427 (dotimes (_ arg)
6428 ;; Skip over whitespace in between blocks when moving backward,
6429 ;; unless at a block boundary with no whitespace.
6430 (skip-syntax-backward "-")
6431 (beginning-of-line)
6432 ;; Proceed forward based on the type of block.
6433 (cond
6434 ;; Code blocks
6435 ((and (markdown-code-block-at-pos (point)) ;; this line
6436 (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line
6437 (forward-line -1)
6438 (while (and (markdown-code-block-at-point-p) (not (bobp)))
6439 (forward-line -1))
6440 (forward-line))
6441 ;; Headings
6442 ((markdown-heading-at-point)
6443 (goto-char (match-beginning 0)))
6444 ;; Horizontal rules
6445 ((looking-at markdown-regex-hr))
6446 ;; Blockquotes
6447 ((looking-at markdown-regex-blockquote)
6448 (forward-line -1)
6449 (while (and (looking-at markdown-regex-blockquote)
6450 (not (bobp)))
6451 (forward-line -1))
6452 (forward-line))
6453 ;; List items
6454 ((markdown-cur-list-item-bounds)
6455 (markdown-beginning-of-list))
6456 ;; Other
6458 ;; Move forward in case it is a one line regular paragraph.
6459 (unless (markdown-next-line-blank-p)
6460 (forward-line))
6461 (unless (markdown-prev-line-blank-p)
6462 (markdown-backward-paragraph)))))))
6464 (defun markdown-forward-block (&optional arg)
6465 "Move forward to the next end of a Markdown block.
6466 Moves across complete code blocks, list items, and blockquotes,
6467 but otherwise stops at blank lines, headers, and horizontal
6468 rules. With argument ARG, do it ARG times; a negative argument
6469 ARG = -N means move backward N blocks."
6470 (interactive "^p")
6471 (or arg (setq arg 1))
6472 (if (< arg 0)
6473 (markdown-backward-block (- arg))
6474 (dotimes (_ arg)
6475 ;; Skip over whitespace in between blocks when moving forward.
6476 (if (markdown-cur-line-blank-p)
6477 (skip-syntax-forward "-")
6478 (beginning-of-line))
6479 ;; Proceed forward based on the type of block.
6480 (cond
6481 ;; Code blocks
6482 ((markdown-code-block-at-point-p)
6483 (forward-line)
6484 (while (and (markdown-code-block-at-point-p) (not (eobp)))
6485 (forward-line)))
6486 ;; Headings
6487 ((looking-at markdown-regex-header)
6488 (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
6489 (forward-line))
6490 ;; Horizontal rules
6491 ((looking-at markdown-regex-hr)
6492 (forward-line))
6493 ;; Blockquotes
6494 ((looking-at markdown-regex-blockquote)
6495 (forward-line)
6496 (while (and (looking-at markdown-regex-blockquote) (not (eobp)))
6497 (forward-line)))
6498 ;; List items
6499 ((markdown-cur-list-item-bounds)
6500 (markdown-end-of-list)
6501 (forward-line))
6502 ;; Other
6503 (t (markdown-forward-paragraph))))
6504 (skip-syntax-backward "-")
6505 (unless (eobp)
6506 (forward-char 1))))
6508 (defun markdown-backward-page (&optional count)
6509 "Move backward to boundary of the current toplevel section.
6510 With COUNT, repeat, or go forward if negative."
6511 (interactive "p")
6512 (or count (setq count 1))
6513 (if (< count 0)
6514 (markdown-forward-page (- count))
6515 (skip-syntax-backward "-")
6516 (or (markdown-back-to-heading-over-code-block t t)
6517 (goto-char (point-min)))
6518 (when (looking-at markdown-regex-header)
6519 (let ((level (markdown-outline-level)))
6520 (when (> level 1) (markdown-up-heading level))
6521 (when (> count 1)
6522 (condition-case nil
6523 (markdown-backward-same-level (1- count))
6524 (error (goto-char (point-min)))))))))
6526 (defun markdown-forward-page (&optional count)
6527 "Move forward to boundary of the current toplevel section.
6528 With COUNT, repeat, or go backward if negative."
6529 (interactive "p")
6530 (or count (setq count 1))
6531 (if (< count 0)
6532 (markdown-backward-page (- count))
6533 (if (markdown-back-to-heading-over-code-block t t)
6534 (let ((level (markdown-outline-level)))
6535 (when (> level 1) (markdown-up-heading level))
6536 (condition-case nil
6537 (markdown-forward-same-level count)
6538 (error (goto-char (point-max)))))
6539 (markdown-next-visible-heading 1))))
6541 (defun markdown-next-link ()
6542 "Jump to next inline, reference, or wiki link.
6543 If successful, return point. Otherwise, return nil.
6544 See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
6545 (interactive)
6546 (let ((opoint (point)))
6547 (when (or (markdown-link-p) (markdown-wiki-link-p))
6548 ;; At a link already, move past it.
6549 (goto-char (+ (match-end 0) 1)))
6550 ;; Search for the next wiki link and move to the beginning.
6551 (while (and (re-search-forward (markdown-make-regex-link-generic) nil t)
6552 (markdown-code-block-at-point-p)
6553 (< (point) (point-max))))
6554 (if (and (not (eq (point) opoint))
6555 (or (markdown-link-p) (markdown-wiki-link-p)))
6556 ;; Group 1 will move past non-escape character in wiki link regexp.
6557 ;; Go to beginning of group zero for all other link types.
6558 (goto-char (or (match-beginning 1) (match-beginning 0)))
6559 (goto-char opoint)
6560 nil)))
6562 (defun markdown-previous-link ()
6563 "Jump to previous wiki link.
6564 If successful, return point. Otherwise, return nil.
6565 See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
6566 (interactive)
6567 (let ((opoint (point)))
6568 (while (and (re-search-backward (markdown-make-regex-link-generic) nil t)
6569 (markdown-code-block-at-point-p)
6570 (> (point) (point-min))))
6571 (if (and (not (eq (point) opoint))
6572 (or (markdown-link-p) (markdown-wiki-link-p)))
6573 (goto-char (or (match-beginning 1) (match-beginning 0)))
6574 (goto-char opoint)
6575 nil)))
6578 ;;; Outline ===================================================================
6580 (defun markdown-move-heading-common (move-fn &optional arg adjust)
6581 "Wrapper for `outline-mode' functions to skip false positives.
6582 MOVE-FN is a function and ARG is its argument. For example,
6583 headings inside preformatted code blocks may match
6584 `outline-regexp' but should not be considered as headings.
6585 When ADJUST is non-nil, adjust the point for interactive calls
6586 to avoid leaving the point at invisible markup. This adjustment
6587 generally should only be done for interactive calls, since other
6588 functions may expect the point to be at the beginning of the
6589 regular expression."
6590 (let ((prev -1) (start (point)))
6591 (if arg (funcall move-fn arg) (funcall move-fn))
6592 (while (and (/= prev (point)) (markdown-code-block-at-point-p))
6593 (setq prev (point))
6594 (if arg (funcall move-fn arg) (funcall move-fn)))
6595 ;; Adjust point for setext headings and invisible text.
6596 (save-match-data
6597 (when (and adjust (thing-at-point-looking-at markdown-regex-header))
6598 (if markdown-hide-markup
6599 ;; Move to beginning of heading text if markup is hidden.
6600 (goto-char (or (match-beginning 1) (match-beginning 5)))
6601 ;; Move to beginning of markup otherwise.
6602 (goto-char (or (match-beginning 1) (match-beginning 4))))))
6603 (if (= (point) start) nil (point))))
6605 (defun markdown-next-visible-heading (arg)
6606 "Move to the next visible heading line of any level.
6607 With argument, repeats or can move backward if negative. ARG is
6608 passed to `outline-next-visible-heading'."
6609 (interactive "p")
6610 (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust))
6612 (defun markdown-previous-visible-heading (arg)
6613 "Move to the previous visible heading line of any level.
6614 With argument, repeats or can move backward if negative. ARG is
6615 passed to `outline-previous-visible-heading'."
6616 (interactive "p")
6617 (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust))
6619 (defun markdown-next-heading ()
6620 "Move to the next heading line of any level."
6621 (markdown-move-heading-common #'outline-next-heading))
6623 (defun markdown-previous-heading ()
6624 "Move to the previous heading line of any level."
6625 (markdown-move-heading-common #'outline-previous-heading))
6627 (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error)
6628 "Move back to the beginning of the previous heading.
6629 Returns t if the point is at a heading, the location if a heading
6630 was found, and nil otherwise.
6631 Only visible heading lines are considered, unless INVISIBLE-OK is
6632 non-nil. Throw an error if there is no previous heading unless
6633 NO-ERROR is non-nil.
6634 Leaves match data intact for `markdown-regex-header'."
6635 (beginning-of-line)
6636 (or (and (markdown-heading-at-point)
6637 (not (markdown-code-block-at-point-p)))
6638 (let (found)
6639 (save-excursion
6640 (while (and (not found)
6641 (re-search-backward markdown-regex-header nil t))
6642 (when (and (or invisible-ok (not (outline-invisible-p)))
6643 (not (markdown-code-block-at-point-p)))
6644 (setq found (point))))
6645 (if (not found)
6646 (unless no-error (user-error "Before first heading"))
6647 (setq found (point))))
6648 (when found (goto-char found)))))
6650 (defun markdown-forward-same-level (arg)
6651 "Move forward to the ARG'th heading at same level as this one.
6652 Stop at the first and last headings of a superior heading."
6653 (interactive "p")
6654 (markdown-back-to-heading-over-code-block)
6655 (markdown-move-heading-common #'outline-forward-same-level arg 'adjust))
6657 (defun markdown-backward-same-level (arg)
6658 "Move backward to the ARG'th heading at same level as this one.
6659 Stop at the first and last headings of a superior heading."
6660 (interactive "p")
6661 (markdown-back-to-heading-over-code-block)
6662 (while (> arg 0)
6663 (let ((point-to-move-to
6664 (save-excursion
6665 (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust))))
6666 (if point-to-move-to
6667 (progn
6668 (goto-char point-to-move-to)
6669 (setq arg (1- arg)))
6670 (user-error "No previous same-level heading")))))
6672 (defun markdown-up-heading (arg)
6673 "Move to the visible heading line of which the present line is a subheading.
6674 With argument, move up ARG levels."
6675 (interactive "p")
6676 (and (called-interactively-p 'any)
6677 (not (eq last-command 'markdown-up-heading)) (push-mark))
6678 (markdown-move-heading-common #'outline-up-heading arg 'adjust))
6680 (defun markdown-back-to-heading (&optional invisible-ok)
6681 "Move to previous heading line, or beg of this line if it's a heading.
6682 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
6683 (markdown-move-heading-common #'outline-back-to-heading invisible-ok))
6685 (defalias 'markdown-end-of-heading 'outline-end-of-heading)
6687 (defun markdown-on-heading-p ()
6688 "Return non-nil if point is on a heading line."
6689 (get-text-property (point-at-bol) 'markdown-heading))
6691 (defun markdown-end-of-subtree (&optional invisible-OK)
6692 "Move to the end of the current subtree.
6693 Only visible heading lines are considered, unless INVISIBLE-OK is
6694 non-nil.
6695 Derived from `org-end-of-subtree'."
6696 (markdown-back-to-heading invisible-OK)
6697 (let ((first t)
6698 (level (markdown-outline-level)))
6699 (while (and (not (eobp))
6700 (or first (> (markdown-outline-level) level)))
6701 (setq first nil)
6702 (markdown-next-heading))
6703 (if (memq (preceding-char) '(?\n ?\^M))
6704 (progn
6705 ;; Go to end of line before heading
6706 (forward-char -1)
6707 (if (memq (preceding-char) '(?\n ?\^M))
6708 ;; leave blank line before heading
6709 (forward-char -1)))))
6710 (point))
6712 (defun markdown-outline-fix-visibility ()
6713 "Hide any false positive headings that should not be shown.
6714 For example, headings inside preformatted code blocks may match
6715 `outline-regexp' but should not be shown as headings when cycling.
6716 Also, the ending --- line in metadata blocks appears to be a
6717 setext header, but should not be folded."
6718 (save-excursion
6719 (goto-char (point-min))
6720 ;; Unhide any false positives in metadata blocks
6721 (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin)
6722 (let ((body (progn (forward-line)
6723 (markdown-text-property-at-point
6724 'markdown-yaml-metadata-section))))
6725 (when body
6726 (let ((end (progn (goto-char (cl-second body))
6727 (markdown-text-property-at-point
6728 'markdown-yaml-metadata-end))))
6729 (outline-flag-region (point-min) (1+ (cl-second end)) nil)))))
6730 ;; Hide any false positives in code blocks
6731 (unless (outline-on-heading-p)
6732 (outline-next-visible-heading 1))
6733 (while (< (point) (point-max))
6734 (when (markdown-code-block-at-point-p)
6735 (outline-flag-region (1- (point-at-bol)) (point-at-eol) t))
6736 (outline-next-visible-heading 1))))
6738 (defvar markdown-cycle-global-status 1)
6739 (defvar markdown-cycle-subtree-status nil)
6741 (defun markdown-next-preface ()
6742 (let (finish)
6743 (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
6744 nil 'move))
6745 (unless (markdown-code-block-at-point-p)
6746 (goto-char (match-beginning 0))
6747 (setq finish t))))
6748 (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
6749 (forward-char -1)))
6751 (defun markdown-show-entry ()
6752 (save-excursion
6753 (outline-back-to-heading t)
6754 (outline-flag-region (1- (point))
6755 (progn
6756 (markdown-next-preface)
6757 (if (= 1 (- (point-max) (point)))
6758 (point-max)
6759 (point)))
6760 nil)))
6762 ;; This function was originally derived from `org-cycle' from org.el.
6763 (defun markdown-cycle (&optional arg)
6764 "Visibility cycling for Markdown mode.
6765 If ARG is t, perform global visibility cycling. If the point is
6766 at an atx-style header, cycle visibility of the corresponding
6767 subtree. Otherwise, indent the current line or insert a tab,
6768 as appropriate, by calling `indent-for-tab-command'."
6769 (interactive "P")
6770 (cond
6772 ;; Global cycling
6773 ((eq arg t)
6774 (cond
6775 ;; Move from overview to contents
6776 ((and (eq last-command this-command)
6777 (eq markdown-cycle-global-status 2))
6778 (markdown-hide-sublevels 1)
6779 (message "CONTENTS")
6780 (setq markdown-cycle-global-status 3)
6781 (markdown-outline-fix-visibility))
6782 ;; Move from contents to all
6783 ((and (eq last-command this-command)
6784 (eq markdown-cycle-global-status 3))
6785 (markdown-show-all)
6786 (message "SHOW ALL")
6787 (setq markdown-cycle-global-status 1))
6788 ;; Defaults to overview
6790 (markdown-hide-body)
6791 (message "OVERVIEW")
6792 (setq markdown-cycle-global-status 2)
6793 (markdown-outline-fix-visibility))))
6795 ;; At a heading: rotate between three different views
6796 ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
6797 (markdown-back-to-heading)
6798 (let ((goal-column 0) eoh eol eos)
6799 ;; Determine boundaries
6800 (save-excursion
6801 (markdown-back-to-heading)
6802 (save-excursion
6803 (beginning-of-line 2)
6804 (while (and (not (eobp)) ;; this is like `next-line'
6805 (get-char-property (1- (point)) 'invisible))
6806 (beginning-of-line 2)) (setq eol (point)))
6807 (markdown-end-of-heading) (setq eoh (point))
6808 (markdown-end-of-subtree t)
6809 (skip-chars-forward " \t\n")
6810 (beginning-of-line 1) ; in case this is an item
6811 (setq eos (1- (point))))
6812 ;; Find out what to do next and set `this-command'
6813 (cond
6814 ;; Nothing is hidden behind this heading
6815 ((= eos eoh)
6816 (message "EMPTY ENTRY")
6817 (setq markdown-cycle-subtree-status nil))
6818 ;; Entire subtree is hidden in one line: open it
6819 ((>= eol eos)
6820 (markdown-show-entry)
6821 (markdown-show-children)
6822 (message "CHILDREN")
6823 (setq markdown-cycle-subtree-status 'children))
6824 ;; We just showed the children, now show everything.
6825 ((and (eq last-command this-command)
6826 (eq markdown-cycle-subtree-status 'children))
6827 (markdown-show-subtree)
6828 (message "SUBTREE")
6829 (setq markdown-cycle-subtree-status 'subtree))
6830 ;; Default action: hide the subtree.
6832 (markdown-hide-subtree)
6833 (message "FOLDED")
6834 (setq markdown-cycle-subtree-status 'folded)))))
6836 ;; In a table, move forward by one cell
6837 ((markdown-table-at-point-p)
6838 (call-interactively #'markdown-table-forward-cell))
6840 ;; Otherwise, indent as appropriate
6842 (indent-for-tab-command))))
6844 (defun markdown-shifttab ()
6845 "Handle S-TAB keybinding based on context.
6846 When in a table, move backward one cell.
6847 Otherwise, cycle global heading visibility by calling
6848 `markdown-cycle' with argument t."
6849 (interactive)
6850 (cond ((markdown-table-at-point-p)
6851 (call-interactively #'markdown-table-backward-cell))
6852 (t (markdown-cycle t))))
6854 (defun markdown-outline-level ()
6855 "Return the depth to which a statement is nested in the outline."
6856 (cond
6857 ((and (match-beginning 0)
6858 (markdown-code-block-at-pos (match-beginning 0)))
6859 7) ;; Only 6 header levels are defined.
6860 ((match-end 2) 1)
6861 ((match-end 3) 2)
6862 ((match-end 4)
6863 (length (markdown-trim-whitespace (match-string-no-properties 4))))))
6865 (defun markdown-promote-subtree (&optional arg)
6866 "Promote the current subtree of ATX headings.
6867 Note that Markdown does not support heading levels higher than
6868 six and therefore level-six headings will not be promoted
6869 further. If ARG is non-nil promote the heading, otherwise
6870 demote."
6871 (interactive "*P")
6872 (save-excursion
6873 (when (and (or (thing-at-point-looking-at markdown-regex-header-atx)
6874 (re-search-backward markdown-regex-header-atx nil t))
6875 (not (markdown-code-block-at-point-p)))
6876 (let ((level (length (match-string 1)))
6877 (promote-or-demote (if arg 1 -1))
6878 (remove 't))
6879 (markdown-cycle-atx promote-or-demote remove)
6880 (catch 'end-of-subtree
6881 (while (and (markdown-next-heading)
6882 (looking-at markdown-regex-header-atx))
6883 ;; Exit if this not a higher level heading; promote otherwise.
6884 (if (and (looking-at markdown-regex-header-atx)
6885 (<= (length (match-string-no-properties 1)) level))
6886 (throw 'end-of-subtree nil)
6887 (markdown-cycle-atx promote-or-demote remove))))))))
6889 (defun markdown-demote-subtree ()
6890 "Demote the current subtree of ATX headings."
6891 (interactive)
6892 (markdown-promote-subtree t))
6894 (defun markdown-move-subtree-up ()
6895 "Move the current subtree of ATX headings up."
6896 (interactive)
6897 (outline-move-subtree-up 1))
6899 (defun markdown-move-subtree-down ()
6900 "Move the current subtree of ATX headings down."
6901 (interactive)
6902 (outline-move-subtree-down 1))
6904 (defun markdown-outline-next ()
6905 "Move to next list item, when in a list, or next visible heading."
6906 (interactive)
6907 (let ((bounds (markdown-next-list-item-bounds)))
6908 (if bounds
6909 (goto-char (nth 0 bounds))
6910 (markdown-next-visible-heading 1))))
6912 (defun markdown-outline-previous ()
6913 "Move to previous list item, when in a list, or previous visible heading."
6914 (interactive)
6915 (let ((bounds (markdown-prev-list-item-bounds)))
6916 (if bounds
6917 (goto-char (nth 0 bounds))
6918 (markdown-previous-visible-heading 1))))
6920 (defun markdown-outline-next-same-level ()
6921 "Move to next list item or heading of same level."
6922 (interactive)
6923 (let ((bounds (markdown-cur-list-item-bounds)))
6924 (if bounds
6925 (markdown-next-list-item (nth 3 bounds))
6926 (markdown-forward-same-level 1))))
6928 (defun markdown-outline-previous-same-level ()
6929 "Move to previous list item or heading of same level."
6930 (interactive)
6931 (let ((bounds (markdown-cur-list-item-bounds)))
6932 (if bounds
6933 (markdown-prev-list-item (nth 3 bounds))
6934 (markdown-backward-same-level 1))))
6936 (defun markdown-outline-up ()
6937 "Move to previous list item, when in a list, or next heading."
6938 (interactive)
6939 (unless (markdown-up-list)
6940 (markdown-up-heading 1)))
6943 ;;; Marking and Narrowing =====================================================
6945 (defun markdown-mark-paragraph ()
6946 "Put mark at end of this block, point at beginning.
6947 The block marked is the one that contains point or follows point.
6949 Interactively, if this command is repeated or (in Transient Mark
6950 mode) if the mark is active, it marks the next block after the
6951 ones already marked."
6952 (interactive)
6953 (if (or (and (eq last-command this-command) (mark t))
6954 (and transient-mark-mode mark-active))
6955 (set-mark
6956 (save-excursion
6957 (goto-char (mark))
6958 (markdown-forward-paragraph)
6959 (point)))
6960 (let ((beginning-of-defun-function 'markdown-backward-paragraph)
6961 (end-of-defun-function 'markdown-forward-paragraph))
6962 (mark-defun))))
6964 (defun markdown-mark-block ()
6965 "Put mark at end of this block, point at beginning.
6966 The block marked is the one that contains point or follows point.
6968 Interactively, if this command is repeated or (in Transient Mark
6969 mode) if the mark is active, it marks the next block after the
6970 ones already marked."
6971 (interactive)
6972 (if (or (and (eq last-command this-command) (mark t))
6973 (and transient-mark-mode mark-active))
6974 (set-mark
6975 (save-excursion
6976 (goto-char (mark))
6977 (markdown-forward-block)
6978 (point)))
6979 (let ((beginning-of-defun-function 'markdown-backward-block)
6980 (end-of-defun-function 'markdown-forward-block))
6981 (mark-defun))))
6983 (defun markdown-narrow-to-block ()
6984 "Make text outside current block invisible.
6985 The current block is the one that contains point or follows point."
6986 (interactive)
6987 (let ((beginning-of-defun-function 'markdown-backward-block)
6988 (end-of-defun-function 'markdown-forward-block))
6989 (narrow-to-defun)))
6991 (defun markdown-mark-text-block ()
6992 "Put mark at end of this plain text block, point at beginning.
6993 The block marked is the one that contains point or follows point.
6995 Interactively, if this command is repeated or (in Transient Mark
6996 mode) if the mark is active, it marks the next block after the
6997 ones already marked."
6998 (interactive)
6999 (if (or (and (eq last-command this-command) (mark t))
7000 (and transient-mark-mode mark-active))
7001 (set-mark
7002 (save-excursion
7003 (goto-char (mark))
7004 (markdown-end-of-text-block)
7005 (point)))
7006 (let ((beginning-of-defun-function 'markdown-beginning-of-text-block)
7007 (end-of-defun-function 'markdown-end-of-text-block))
7008 (mark-defun))))
7010 (defun markdown-mark-page ()
7011 "Put mark at end of this top level section, point at beginning.
7012 The top level section marked is the one that contains point or
7013 follows point.
7015 Interactively, if this command is repeated or (in Transient Mark
7016 mode) if the mark is active, it marks the next page after the
7017 ones already marked."
7018 (interactive)
7019 (if (or (and (eq last-command this-command) (mark t))
7020 (and transient-mark-mode mark-active))
7021 (set-mark
7022 (save-excursion
7023 (goto-char (mark))
7024 (markdown-forward-page)
7025 (point)))
7026 (let ((beginning-of-defun-function 'markdown-backward-page)
7027 (end-of-defun-function 'markdown-forward-page))
7028 (mark-defun))))
7030 (defun markdown-narrow-to-page ()
7031 "Make text outside current top level section invisible.
7032 The current section is the one that contains point or follows point."
7033 (interactive)
7034 (let ((beginning-of-defun-function 'markdown-backward-page)
7035 (end-of-defun-function 'markdown-forward-page))
7036 (narrow-to-defun)))
7038 (defun markdown-mark-subtree ()
7039 "Mark the current subtree.
7040 This puts point at the start of the current subtree, and mark at the end."
7041 (interactive)
7042 (let ((beg))
7043 (if (markdown-heading-at-point)
7044 (beginning-of-line)
7045 (markdown-previous-visible-heading 1))
7046 (setq beg (point))
7047 (markdown-end-of-subtree)
7048 (push-mark (point) nil t)
7049 (goto-char beg)))
7051 (defun markdown-narrow-to-subtree ()
7052 "Narrow buffer to the current subtree."
7053 (interactive)
7054 (save-excursion
7055 (save-match-data
7056 (narrow-to-region
7057 (progn (markdown-back-to-heading-over-code-block t) (point))
7058 (progn (markdown-end-of-subtree)
7059 (if (and (markdown-heading-at-point) (not (eobp)))
7060 (backward-char 1))
7061 (point))))))
7064 ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
7066 (defun markdown-move-up ()
7067 "Move thing at point up.
7068 When in a list item, call `markdown-move-list-item-up'.
7069 When in a table, call `markdown-table-move-row-up'.
7070 Otherwise, move the current heading subtree up with
7071 `markdown-move-subtree-up'."
7072 (interactive)
7073 (cond
7074 ((markdown-list-item-at-point-p)
7075 (call-interactively #'markdown-move-list-item-up))
7076 ((markdown-table-at-point-p)
7077 (call-interactively #'markdown-table-move-row-up))
7079 (call-interactively #'markdown-move-subtree-up))))
7081 (defun markdown-move-down ()
7082 "Move thing at point down.
7083 When in a list item, call `markdown-move-list-item-down'.
7084 Otherwise, move the current heading subtree up with
7085 `markdown-move-subtree-down'."
7086 (interactive)
7087 (cond
7088 ((markdown-list-item-at-point-p)
7089 (call-interactively #'markdown-move-list-item-down))
7090 ((markdown-table-at-point-p)
7091 (call-interactively #'markdown-table-move-row-down))
7093 (call-interactively #'markdown-move-subtree-down))))
7095 (defun markdown-promote ()
7096 "Promote or move element at point to the left.
7097 Depending on the context, this function will promote a heading or
7098 list item at the point, move a table column to the left, or cycle
7099 markup."
7100 (interactive)
7101 (let (bounds)
7102 (cond
7103 ;; Promote atx heading subtree
7104 ((thing-at-point-looking-at markdown-regex-header-atx)
7105 (markdown-promote-subtree))
7106 ;; Promote setext heading
7107 ((thing-at-point-looking-at markdown-regex-header-setext)
7108 (markdown-cycle-setext -1))
7109 ;; Promote horizonal rule
7110 ((thing-at-point-looking-at markdown-regex-hr)
7111 (markdown-cycle-hr -1))
7112 ;; Promote list item
7113 ((setq bounds (markdown-cur-list-item-bounds))
7114 (markdown-promote-list-item bounds))
7115 ;; Move table column to the left
7116 ((markdown-table-at-point-p)
7117 (call-interactively #'markdown-table-move-column-left))
7118 ;; Promote bold
7119 ((thing-at-point-looking-at markdown-regex-bold)
7120 (markdown-cycle-bold))
7121 ;; Promote italic
7122 ((thing-at-point-looking-at markdown-regex-italic)
7123 (markdown-cycle-italic))
7125 (user-error "Nothing to promote at point")))))
7127 (defun markdown-demote ()
7128 "Demote or move element at point to the right.
7129 Depending on the context, this function will demote a heading or
7130 list item at the point, move a table column to the right, or cycle
7131 or remove markup."
7132 (interactive)
7133 (let (bounds)
7134 (cond
7135 ;; Demote atx heading subtree
7136 ((thing-at-point-looking-at markdown-regex-header-atx)
7137 (markdown-demote-subtree))
7138 ;; Demote setext heading
7139 ((thing-at-point-looking-at markdown-regex-header-setext)
7140 (markdown-cycle-setext 1))
7141 ;; Demote horizonal rule
7142 ((thing-at-point-looking-at markdown-regex-hr)
7143 (markdown-cycle-hr 1))
7144 ;; Demote list item
7145 ((setq bounds (markdown-cur-list-item-bounds))
7146 (markdown-demote-list-item bounds))
7147 ;; Move table column to the right
7148 ((markdown-table-at-point-p)
7149 (call-interactively #'markdown-table-move-column-right))
7150 ;; Demote bold
7151 ((thing-at-point-looking-at markdown-regex-bold)
7152 (markdown-cycle-bold))
7153 ;; Demote italic
7154 ((thing-at-point-looking-at markdown-regex-italic)
7155 (markdown-cycle-italic))
7157 (user-error "Nothing to demote at point")))))
7160 ;;; Commands ==================================================================
7162 (defun markdown (&optional output-buffer-name)
7163 "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
7164 The output buffer name defaults to `markdown-output-buffer-name'.
7165 Return the name of the output buffer used."
7166 (interactive)
7167 (save-window-excursion
7168 (let ((begin-region)
7169 (end-region))
7170 (if (markdown-use-region-p)
7171 (setq begin-region (region-beginning)
7172 end-region (region-end))
7173 (setq begin-region (point-min)
7174 end-region (point-max)))
7176 (unless output-buffer-name
7177 (setq output-buffer-name markdown-output-buffer-name))
7178 (let ((exit-code
7179 (cond
7180 ;; Handle case when `markdown-command' does not read from stdin
7181 ((and (stringp markdown-command) markdown-command-needs-filename)
7182 (if (not buffer-file-name)
7183 (user-error "Must be visiting a file")
7184 ;; Don’t use ‘shell-command’ because it’s not guaranteed to
7185 ;; return the exit code of the process.
7186 (shell-command-on-region
7187 ;; Pass an empty region so that stdin is empty.
7188 (point) (point)
7189 (concat markdown-command " "
7190 (shell-quote-argument buffer-file-name))
7191 output-buffer-name)))
7192 ;; Pass region to `markdown-command' via stdin
7194 (let ((buf (get-buffer-create output-buffer-name)))
7195 (with-current-buffer buf
7196 (setq buffer-read-only nil)
7197 (erase-buffer))
7198 (if (stringp markdown-command)
7199 (call-process-region begin-region end-region
7200 shell-file-name nil buf nil
7201 shell-command-switch markdown-command)
7202 (funcall markdown-command begin-region end-region buf)
7203 ;; If the ‘markdown-command’ function didn’t signal an
7204 ;; error, assume it succeeded by binding ‘exit-code’ to 0.
7205 0))))))
7206 ;; The exit code can be a signal description string, so don’t use ‘=’
7207 ;; or ‘zerop’.
7208 (unless (eq exit-code 0)
7209 (user-error "%s failed with exit code %s"
7210 markdown-command exit-code))))
7211 output-buffer-name))
7213 (defun markdown-standalone (&optional output-buffer-name)
7214 "Special function to provide standalone HTML output.
7215 Insert the output in the buffer named OUTPUT-BUFFER-NAME."
7216 (interactive)
7217 (setq output-buffer-name (markdown output-buffer-name))
7218 (with-current-buffer output-buffer-name
7219 (set-buffer output-buffer-name)
7220 (unless (markdown-output-standalone-p)
7221 (markdown-add-xhtml-header-and-footer output-buffer-name))
7222 (goto-char (point-min))
7223 (html-mode))
7224 output-buffer-name)
7226 (defun markdown-other-window (&optional output-buffer-name)
7227 "Run `markdown-command' on current buffer and display in other window.
7228 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7229 that name."
7230 (interactive)
7231 (markdown-display-buffer-other-window
7232 (markdown-standalone output-buffer-name)))
7234 (defun markdown-output-standalone-p ()
7235 "Determine whether `markdown-command' output is standalone XHTML.
7236 Standalone XHTML output is identified by an occurrence of
7237 `markdown-xhtml-standalone-regexp' in the first five lines of output."
7238 (save-excursion
7239 (goto-char (point-min))
7240 (save-match-data
7241 (re-search-forward
7242 markdown-xhtml-standalone-regexp
7243 (save-excursion (goto-char (point-min)) (forward-line 4) (point))
7244 t))))
7246 (defun markdown-stylesheet-link-string (stylesheet-path)
7247 (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
7248 stylesheet-path
7249 "\" />"))
7251 (defun markdown-add-xhtml-header-and-footer (title)
7252 "Wrap XHTML header and footer with given TITLE around current buffer."
7253 (goto-char (point-min))
7254 (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
7255 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
7256 "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
7257 "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
7258 "<head>\n<title>")
7259 (insert title)
7260 (insert "</title>\n")
7261 (when (> (length markdown-content-type) 0)
7262 (insert
7263 (format
7264 "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
7265 markdown-content-type
7266 (or (and markdown-coding-system
7267 (fboundp 'coding-system-get)
7268 (coding-system-get markdown-coding-system
7269 'mime-charset))
7270 (and (fboundp 'coding-system-get)
7271 (coding-system-get buffer-file-coding-system
7272 'mime-charset))
7273 "iso-8859-1"))))
7274 (if (> (length markdown-css-paths) 0)
7275 (insert (mapconcat #'markdown-stylesheet-link-string
7276 markdown-css-paths "\n")))
7277 (when (> (length markdown-xhtml-header-content) 0)
7278 (insert markdown-xhtml-header-content))
7279 (insert "\n</head>\n\n"
7280 "<body>\n\n")
7281 (when (> (length markdown-xhtml-body-preamble) 0)
7282 (insert markdown-xhtml-body-preamble "\n"))
7283 (goto-char (point-max))
7284 (when (> (length markdown-xhtml-body-epilogue) 0)
7285 (insert "\n" markdown-xhtml-body-epilogue))
7286 (insert "\n"
7287 "</body>\n"
7288 "</html>\n"))
7290 (defun markdown-preview (&optional output-buffer-name)
7291 "Run `markdown-command' on the current buffer and view output in browser.
7292 When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
7293 that name."
7294 (interactive)
7295 (browse-url-of-buffer
7296 (markdown-standalone (or output-buffer-name markdown-output-buffer-name))))
7298 (defun markdown-export-file-name (&optional extension)
7299 "Attempt to generate a filename for Markdown output.
7300 The file extension will be EXTENSION if given, or .html by default.
7301 If the current buffer is visiting a file, we construct a new
7302 output filename based on that filename. Otherwise, return nil."
7303 (when (buffer-file-name)
7304 (unless extension
7305 (setq extension ".html"))
7306 (let ((candidate
7307 (concat
7308 (cond
7309 ((buffer-file-name)
7310 (file-name-sans-extension (buffer-file-name)))
7311 (t (buffer-name)))
7312 extension)))
7313 (cond
7314 ((equal candidate (buffer-file-name))
7315 (concat candidate extension))
7317 candidate)))))
7319 (defun markdown-export (&optional output-file)
7320 "Run Markdown on the current buffer, save to file, and return the filename.
7321 If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
7322 generated by `markdown-export-file-name', which will be constructed using the
7323 current filename, but with the extension removed and replaced with .html."
7324 (interactive)
7325 (unless output-file
7326 (setq output-file (markdown-export-file-name ".html")))
7327 (when output-file
7328 (let* ((init-buf (current-buffer))
7329 (init-point (point))
7330 (init-buf-string (buffer-string))
7331 (output-buffer (find-file-noselect output-file))
7332 (output-buffer-name (buffer-name output-buffer)))
7333 (run-hooks 'markdown-before-export-hook)
7334 (markdown-standalone output-buffer-name)
7335 (with-current-buffer output-buffer
7336 (run-hooks 'markdown-after-export-hook)
7337 (save-buffer)
7338 (when markdown-export-kill-buffer (kill-buffer)))
7339 ;; if modified, restore initial buffer
7340 (when (buffer-modified-p init-buf)
7341 (erase-buffer)
7342 (insert init-buf-string)
7343 (save-buffer)
7344 (goto-char init-point))
7345 output-file)))
7347 (defun markdown-export-and-preview ()
7348 "Export to XHTML using `markdown-export' and browse the resulting file."
7349 (interactive)
7350 (browse-url-of-file (markdown-export)))
7352 (defvar markdown-live-preview-buffer nil
7353 "Buffer used to preview markdown output in `markdown-live-preview-export'.")
7354 (make-variable-buffer-local 'markdown-live-preview-buffer)
7356 (defvar markdown-live-preview-source-buffer nil
7357 "Source buffer from which current buffer was generated.
7358 This is the inverse of `markdown-live-preview-buffer'.")
7359 (make-variable-buffer-local 'markdown-live-preview-source-buffer)
7361 (defvar markdown-live-preview-currently-exporting nil)
7363 (defun markdown-live-preview-get-filename ()
7364 "Standardize the filename exported by `markdown-live-preview-export'."
7365 (markdown-export-file-name ".html"))
7367 (defun markdown-live-preview-window-eww (file)
7368 "Preview FILE with eww.
7369 To be used with `markdown-live-preview-window-function'."
7370 (if (require 'eww nil t)
7371 (progn
7372 (eww-open-file file)
7373 (get-buffer "*eww*"))
7374 (error "EWW is not present or not loaded on this version of Emacs")))
7376 (defun markdown-visual-lines-between-points (beg end)
7377 (save-excursion
7378 (goto-char beg)
7379 (cl-loop with count = 0
7380 while (progn (end-of-visual-line)
7381 (and (< (point) end) (line-move-visual 1 t)))
7382 do (cl-incf count)
7383 finally return count)))
7385 (defun markdown-live-preview-window-serialize (buf)
7386 "Get window point and scroll data for all windows displaying BUF."
7387 (when (buffer-live-p buf)
7388 (with-current-buffer buf
7389 (mapcar
7390 (lambda (win)
7391 (with-selected-window win
7392 (let* ((start (window-start))
7393 (pt (window-point))
7394 (pt-or-sym (cond ((= pt (point-min)) 'min)
7395 ((= pt (point-max)) 'max)
7396 (t pt)))
7397 (diff (markdown-visual-lines-between-points
7398 start pt)))
7399 (list win pt-or-sym diff))))
7400 (get-buffer-window-list buf)))))
7402 (defun markdown-get-point-back-lines (pt num-lines)
7403 (save-excursion
7404 (goto-char pt)
7405 (line-move-visual (- num-lines) t)
7406 ;; in testing, can occasionally overshoot the number of lines to traverse
7407 (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt)))
7408 (when (> actual-num-lines num-lines)
7409 (line-move-visual (- actual-num-lines num-lines) t)))
7410 (point)))
7412 (defun markdown-live-preview-window-deserialize (window-posns)
7413 "Apply window point and scroll data from WINDOW-POSNS.
7414 WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
7415 (cl-destructuring-bind (win pt-or-sym diff) window-posns
7416 (when (window-live-p win)
7417 (with-current-buffer markdown-live-preview-buffer
7418 (set-window-buffer win (current-buffer))
7419 (cl-destructuring-bind (actual-pt actual-diff)
7420 (cl-case pt-or-sym
7421 (min (list (point-min) 0))
7422 (max (list (point-max) diff))
7423 (t (list pt-or-sym diff)))
7424 (set-window-start
7425 win (markdown-get-point-back-lines actual-pt actual-diff))
7426 (set-window-point win actual-pt))))))
7428 (defun markdown-live-preview-export ()
7429 "Export to XHTML using `markdown-export'.
7430 Browse the resulting file within Emacs using
7431 `markdown-live-preview-window-function' Return the buffer
7432 displaying the rendered output."
7433 (interactive)
7434 (let ((filename (markdown-live-preview-get-filename)))
7435 (when filename
7436 (let* ((markdown-live-preview-currently-exporting t)
7437 (cur-buf (current-buffer))
7438 (export-file (markdown-export filename))
7439 ;; get positions in all windows currently displaying output buffer
7440 (window-data
7441 (markdown-live-preview-window-serialize
7442 markdown-live-preview-buffer)))
7443 (save-window-excursion
7444 (let ((output-buffer
7445 (funcall markdown-live-preview-window-function export-file)))
7446 (with-current-buffer output-buffer
7447 (setq markdown-live-preview-source-buffer cur-buf)
7448 (add-hook 'kill-buffer-hook
7449 #'markdown-live-preview-remove-on-kill t t))
7450 (with-current-buffer cur-buf
7451 (setq markdown-live-preview-buffer output-buffer))))
7452 (with-current-buffer cur-buf
7453 ;; reset all windows displaying output buffer to where they were,
7454 ;; now with the new output
7455 (mapc #'markdown-live-preview-window-deserialize window-data)
7456 ;; delete html editing buffer
7457 (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf)))
7458 (when (and export-file (file-exists-p export-file)
7459 (eq markdown-live-preview-delete-export
7460 'delete-on-export))
7461 (delete-file export-file))
7462 markdown-live-preview-buffer)))))
7464 (defun markdown-live-preview-remove ()
7465 (when (buffer-live-p markdown-live-preview-buffer)
7466 (kill-buffer markdown-live-preview-buffer))
7467 (setq markdown-live-preview-buffer nil)
7468 ;; if set to 'delete-on-export, the output has already been deleted
7469 (when (eq markdown-live-preview-delete-export 'delete-on-destroy)
7470 (let ((outfile-name (markdown-live-preview-get-filename)))
7471 (when (and outfile-name (file-exists-p outfile-name))
7472 (delete-file outfile-name)))))
7474 (defun markdown-get-other-window ()
7475 "Find another window to display preview or output content."
7476 (cond
7477 ((memq markdown-split-window-direction '(vertical below))
7478 (or (window-in-direction 'below) (split-window-vertically)))
7479 ((memq markdown-split-window-direction '(horizontal right))
7480 (or (window-in-direction 'right) (split-window-horizontally)))
7481 (t (split-window-sensibly (get-buffer-window)))))
7483 (defun markdown-display-buffer-other-window (buf)
7484 "Display preview or output buffer BUF in another window."
7485 (let ((cur-buf (current-buffer))
7486 (window (markdown-get-other-window)))
7487 (set-window-buffer window buf)
7488 (set-buffer cur-buf)))
7490 (defun markdown-live-preview-if-markdown ()
7491 (when (and (derived-mode-p 'markdown-mode)
7492 markdown-live-preview-mode)
7493 (unless markdown-live-preview-currently-exporting
7494 (if (buffer-live-p markdown-live-preview-buffer)
7495 (markdown-live-preview-export)
7496 (markdown-display-buffer-other-window
7497 (markdown-live-preview-export))))))
7499 (defun markdown-live-preview-remove-on-kill ()
7500 (cond ((and (derived-mode-p 'markdown-mode)
7501 markdown-live-preview-mode)
7502 (markdown-live-preview-remove))
7503 (markdown-live-preview-source-buffer
7504 (with-current-buffer markdown-live-preview-source-buffer
7505 (setq markdown-live-preview-buffer nil))
7506 (setq markdown-live-preview-source-buffer nil))))
7508 (defun markdown-live-preview-switch-to-output ()
7509 "Switch to output buffer."
7510 (interactive)
7511 "Turn on `markdown-live-preview-mode' if not already on, and switch to its
7512 output buffer in another window."
7513 (if markdown-live-preview-mode
7514 (markdown-display-buffer-other-window (markdown-live-preview-export)))
7515 (markdown-live-preview-mode))
7517 (defun markdown-live-preview-re-export ()
7518 "Re export source buffer."
7519 (interactive)
7520 "If the current buffer is a buffer displaying the exported version of a
7521 `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
7522 update this buffer's contents."
7523 (when markdown-live-preview-source-buffer
7524 (with-current-buffer markdown-live-preview-source-buffer
7525 (markdown-live-preview-export))))
7527 (defun markdown-open ()
7528 "Open file for the current buffer with `markdown-open-command'."
7529 (interactive)
7530 (unless markdown-open-command
7531 (user-error "Variable `markdown-open-command' must be set"))
7532 (if (stringp markdown-open-command)
7533 (if (not buffer-file-name)
7534 (user-error "Must be visiting a file")
7535 (save-buffer)
7536 (let ((exit-code (call-process markdown-open-command nil nil nil
7537 buffer-file-name)))
7538 ;; The exit code can be a signal description string, so don’t use ‘=’
7539 ;; or ‘zerop’.
7540 (unless (eq exit-code 0)
7541 (user-error "%s failed with exit code %s"
7542 markdown-open-command exit-code))))
7543 (funcall markdown-open-command))
7544 nil)
7546 (defun markdown-kill-ring-save ()
7547 "Run Markdown on file and store output in the kill ring."
7548 (interactive)
7549 (save-window-excursion
7550 (markdown)
7551 (with-current-buffer markdown-output-buffer-name
7552 (kill-ring-save (point-min) (point-max)))))
7555 ;;; Links =====================================================================
7557 (defun markdown-link-p ()
7558 "Return non-nil when `point' is at a non-wiki link.
7559 See `markdown-wiki-link-p' for more information."
7560 (let ((case-fold-search nil))
7561 (and (not (markdown-wiki-link-p))
7562 (not (markdown-code-block-at-point-p))
7563 (or (thing-at-point-looking-at markdown-regex-link-inline)
7564 (thing-at-point-looking-at markdown-regex-link-reference)
7565 (thing-at-point-looking-at markdown-regex-uri)
7566 (thing-at-point-looking-at markdown-regex-angle-uri)))))
7568 (make-obsolete 'markdown-link-link 'markdown-link-url "v2.3")
7570 (defun markdown-link-at-pos (pos)
7571 "Return properties of link or image at position POS.
7572 Value is a list of elements describing the link:
7573 0. beginning position
7574 1. end position
7575 2. link text
7576 3. URL
7577 4. reference label
7578 5. title text
7579 6. bang (nil or \"!\")"
7580 (save-excursion
7581 (goto-char pos)
7582 (let (begin end text url reference title bang)
7583 (cond
7584 ;; Inline or reference image or link at point.
7585 ((or (thing-at-point-looking-at markdown-regex-link-inline)
7586 (thing-at-point-looking-at markdown-regex-link-reference))
7587 (setq bang (match-string-no-properties 1)
7588 begin (match-beginning 0)
7589 end (match-end 0)
7590 text (match-string-no-properties 3))
7591 (if (char-equal (char-after (match-beginning 5)) ?\[)
7592 ;; Reference link
7593 (setq reference (match-string-no-properties 6))
7594 ;; Inline link
7595 (setq url (match-string-no-properties 6))
7596 (when (match-end 7)
7597 (setq title (substring (match-string-no-properties 7) 1 -1)))))
7598 ;; Angle bracket URI at point.
7599 ((thing-at-point-looking-at markdown-regex-angle-uri)
7600 (setq begin (match-beginning 0)
7601 end (match-end 0)
7602 url (match-string-no-properties 2)))
7603 ;; Plain URI at point.
7604 ((thing-at-point-looking-at markdown-regex-uri)
7605 (setq begin (match-beginning 0)
7606 end (match-end 0)
7607 url (match-string-no-properties 1))))
7608 (list begin end text url reference title bang))))
7610 (defun markdown-link-url ()
7611 "Return the URL part of the regular (non-wiki) link at point.
7612 Works with both inline and reference style links, and with images.
7613 If point is not at a link or the link reference is not defined
7614 returns nil."
7615 (let* ((values (markdown-link-at-pos (point)))
7616 (text (nth 2 values))
7617 (url (nth 3 values))
7618 (ref (nth 4 values)))
7619 (or url (and ref (car (markdown-reference-definition
7620 (downcase (if (string= ref "") text ref))))))))
7622 (defun markdown-follow-link-at-point ()
7623 "Open the current non-wiki link.
7624 If the link is a complete URL, open in browser with `browse-url'.
7625 Otherwise, open with `find-file' after stripping anchor and/or query string.
7626 Translate filenames using `markdown-filename-translate-function'."
7627 (interactive)
7628 (if (markdown-link-p)
7629 (let* ((url (markdown-link-url))
7630 (struct (url-generic-parse-url url))
7631 (full (url-fullness struct))
7632 (file url))
7633 ;; Parse URL, determine fullness, strip query string
7634 (if (fboundp 'url-path-and-query)
7635 (setq file (car (url-path-and-query struct)))
7636 (when (and (setq file (url-filename struct))
7637 (string-match "\\?" file))
7638 (setq file (substring file 0 (match-beginning 0)))))
7639 ;; Open full URLs in browser, files in Emacs
7640 (if full
7641 (browse-url url)
7642 (when (and file (> (length file) 0))
7643 (find-file (funcall markdown-translate-filename-function file)))))
7644 (user-error "Point is not at a Markdown link or URL")))
7646 (defun markdown-fontify-inline-links (last)
7647 "Add text properties to next inline link from point to LAST."
7648 (when (markdown-match-generic-links last nil)
7649 (let* ((link-start (match-beginning 3))
7650 (link-end (match-end 3))
7651 (url-start (match-beginning 6))
7652 (url-end (match-end 6))
7653 (url (match-string-no-properties 6))
7654 (title-start (match-beginning 7))
7655 (title-end (match-end 7))
7656 (title (match-string-no-properties 7))
7657 ;; Markup part
7658 (mp (list 'face 'markdown-markup-face
7659 'invisible 'markdown-markup
7660 'rear-nonsticky t
7661 'font-lock-multiline t))
7662 ;; Link part (without face)
7663 (lp (list 'keymap markdown-mode-mouse-map
7664 'mouse-face 'markdown-highlight-face
7665 'font-lock-multiline t
7666 'help-echo (if title (concat title "\n" url) url)))
7667 ;; URL part
7668 (up (list 'keymap markdown-mode-mouse-map
7669 'face 'markdown-url-face
7670 'invisible 'markdown-markup
7671 'mouse-face 'markdown-highlight-face
7672 'font-lock-multiline t))
7673 ;; URL composition character
7674 (url-char (markdown--first-displayable markdown-url-compose-char))
7675 ;; Title part
7676 (tp (list 'face 'markdown-link-title-face
7677 'invisible 'markdown-markup
7678 'font-lock-multiline t)))
7679 (dolist (g '(1 2 4 5 8))
7680 (when (match-end g)
7681 (add-text-properties (match-beginning g) (match-end g) mp)))
7682 ;; Preserve existing faces applied to link part (e.g., inline code)
7683 (when link-start
7684 (add-text-properties link-start link-end lp)
7685 (add-face-text-property link-start link-end
7686 'markdown-link-face 'append))
7687 (when url-start (add-text-properties url-start url-end up))
7688 (when title-start (add-text-properties url-end title-end tp))
7689 (when (and markdown-hide-urls url-start)
7690 (compose-region url-start (or title-end url-end) url-char))
7691 t)))
7693 (defun markdown-fontify-reference-links (last)
7694 "Add text properties to next reference link from point to LAST."
7695 (when (markdown-match-generic-links last t)
7696 (let* ((link-start (match-beginning 3))
7697 (link-end (match-end 3))
7698 (ref-start (match-beginning 6))
7699 (ref-end (match-end 6))
7700 ;; Markup part
7701 (mp (list 'face 'markdown-markup-face
7702 'invisible 'markdown-markup
7703 'rear-nonsticky t
7704 'font-lock-multiline t))
7705 ;; Link part
7706 (lp (list 'keymap markdown-mode-mouse-map
7707 'face 'markdown-link-face
7708 'mouse-face 'markdown-highlight-face
7709 'font-lock-multiline t
7710 'help-echo (lambda (_ __ pos)
7711 (save-match-data
7712 (save-excursion
7713 (goto-char pos)
7714 (or (markdown-link-url)
7715 "Undefined reference"))))))
7716 ;; URL composition character
7717 (url-char (markdown--first-displayable markdown-url-compose-char))
7718 ;; Reference part
7719 (rp (list 'face 'markdown-reference-face
7720 'invisible 'markdown-markup
7721 'font-lock-multiline t)))
7722 (dolist (g '(1 2 4 5 8))
7723 (when (match-end g)
7724 (add-text-properties (match-beginning g) (match-end g) mp)))
7725 (when link-start (add-text-properties link-start link-end lp))
7726 (when ref-start (add-text-properties ref-start ref-end rp)
7727 (when (and markdown-hide-urls (> (- ref-end ref-start) 2))
7728 (compose-region ref-start ref-end url-char)))
7729 t)))
7731 (defun markdown-fontify-angle-uris (last)
7732 "Add text properties to angle URIs from point to LAST."
7733 (when (markdown-match-angle-uris last)
7734 (let* ((url-start (match-beginning 2))
7735 (url-end (match-end 2))
7736 ;; Markup part
7737 (mp (list 'face 'markdown-markup-face
7738 'invisible 'markdown-markup
7739 'rear-nonsticky t
7740 'font-lock-multiline t))
7741 ;; URI part
7742 (up (list 'keymap markdown-mode-mouse-map
7743 'face 'markdown-plain-url-face
7744 'mouse-face 'markdown-highlight-face
7745 'font-lock-multiline t)))
7746 (dolist (g '(1 3))
7747 (add-text-properties (match-beginning g) (match-end g) mp))
7748 (add-text-properties url-start url-end up)
7749 t)))
7751 (defun markdown-fontify-plain-uris (last)
7752 "Add text properties to plain URLs from point to LAST."
7753 (when (markdown-match-plain-uris last)
7754 (let* ((start (match-beginning 0))
7755 (end (match-end 0))
7756 (props (list 'keymap markdown-mode-mouse-map
7757 'face 'markdown-plain-url-face
7758 'mouse-face 'markdown-highlight-face
7759 'rear-nonsticky t
7760 'font-lock-multiline t)))
7761 (add-text-properties start end props)
7762 t)))
7764 (defun markdown-toggle-url-hiding (&optional arg)
7765 "Toggle the display or hiding of URLs.
7766 With a prefix argument ARG, enable URL hiding if ARG is positive,
7767 and disable it otherwise."
7768 (interactive (list (or current-prefix-arg 'toggle)))
7769 (setq markdown-hide-urls
7770 (if (eq arg 'toggle)
7771 (not markdown-hide-urls)
7772 (> (prefix-numeric-value arg) 0)))
7773 (if markdown-hide-urls
7774 (message "markdown-mode URL hiding enabled")
7775 (message "markdown-mode URL hiding disabled"))
7776 (markdown-reload-extensions))
7779 ;;; Wiki Links ================================================================
7781 (defun markdown-wiki-link-p ()
7782 "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
7783 A true wiki link name matches `markdown-regex-wiki-link' but does
7784 not match the current file name after conversion. This modifies
7785 the data returned by `match-data'. Note that the potential wiki
7786 link name must be available via `match-string'."
7787 (when markdown-enable-wiki-links
7788 (let ((case-fold-search nil))
7789 (and (thing-at-point-looking-at markdown-regex-wiki-link)
7790 (not (markdown-code-block-at-point-p))
7791 (or (not buffer-file-name)
7792 (not (string-equal (buffer-file-name)
7793 (markdown-convert-wiki-link-to-filename
7794 (markdown-wiki-link-link)))))))))
7796 (defun markdown-wiki-link-link ()
7797 "Return the link part of the wiki link using current match data.
7798 The location of the link component depends on the value of
7799 `markdown-wiki-link-alias-first'."
7800 (if markdown-wiki-link-alias-first
7801 (or (match-string-no-properties 5) (match-string-no-properties 3))
7802 (match-string-no-properties 3)))
7804 (defun markdown-wiki-link-alias ()
7805 "Return the alias or text part of the wiki link using current match data.
7806 The location of the alias component depends on the value of
7807 `markdown-wiki-link-alias-first'."
7808 (if markdown-wiki-link-alias-first
7809 (match-string-no-properties 3)
7810 (or (match-string-no-properties 5) (match-string-no-properties 3))))
7812 (defun markdown-convert-wiki-link-to-filename (name)
7813 "Generate a filename from the wiki link NAME.
7814 Spaces in NAME are replaced with `markdown-link-space-sub-char'.
7815 When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
7816 and [[test test]] both map to Test-test.ext. Look in the current
7817 directory first, then in subdirectories if
7818 `markdown-wiki-link-search-subdirectories' is non-nil, and then
7819 in parent directories if
7820 `markdown-wiki-link-search-parent-directories' is non-nil."
7821 (let* ((basename (markdown-replace-regexp-in-string
7822 "[[:space:]\n]" markdown-link-space-sub-char name))
7823 (basename (if (memq major-mode '(gfm-mode gfm-view-mode))
7824 (concat (upcase (substring basename 0 1))
7825 (downcase (substring basename 1 nil)))
7826 basename))
7827 directory extension default candidates dir)
7828 (when buffer-file-name
7829 (setq directory (file-name-directory buffer-file-name)
7830 extension (file-name-extension buffer-file-name)))
7831 (setq default (concat basename
7832 (when extension (concat "." extension))))
7833 (cond
7834 ;; Look in current directory first.
7835 ((or (null buffer-file-name)
7836 (file-exists-p default))
7837 default)
7838 ;; Possibly search in subdirectories, next.
7839 ((and markdown-wiki-link-search-subdirectories
7840 (setq candidates
7841 (markdown-directory-files-recursively
7842 directory (concat "^" default "$"))))
7843 (car candidates))
7844 ;; Possibly search in parent directories as a last resort.
7845 ((and markdown-wiki-link-search-parent-directories
7846 (setq dir (locate-dominating-file directory default)))
7847 (concat dir default))
7848 ;; If nothing is found, return default in current directory.
7849 (t default))))
7851 (defun markdown-follow-wiki-link (name &optional other)
7852 "Follow the wiki link NAME.
7853 Convert the name to a file name and call `find-file'. Ensure that
7854 the new buffer remains in `markdown-mode'. Open the link in another
7855 window when OTHER is non-nil."
7856 (let ((filename (markdown-convert-wiki-link-to-filename name))
7857 (wp (when buffer-file-name
7858 (file-name-directory buffer-file-name))))
7859 (if (not wp)
7860 (user-error "Must be visiting a file")
7861 (when other (other-window 1))
7862 (let ((default-directory wp))
7863 (find-file filename)))
7864 (when (not (eq major-mode 'markdown-mode))
7865 (markdown-mode))))
7867 (defun markdown-follow-wiki-link-at-point (&optional arg)
7868 "Find Wiki Link at point.
7869 With prefix argument ARG, open the file in other window.
7870 See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
7871 (interactive "P")
7872 (if (markdown-wiki-link-p)
7873 (markdown-follow-wiki-link (markdown-wiki-link-link) arg)
7874 (user-error "Point is not at a Wiki Link")))
7876 (defun markdown-highlight-wiki-link (from to face)
7877 "Highlight the wiki link in the region between FROM and TO using FACE."
7878 (put-text-property from to 'font-lock-face face))
7880 (defun markdown-unfontify-region-wiki-links (from to)
7881 "Remove wiki link faces from the region specified by FROM and TO."
7882 (interactive "*r")
7883 (let ((modified (buffer-modified-p)))
7884 (remove-text-properties from to '(font-lock-face markdown-link-face))
7885 (remove-text-properties from to '(font-lock-face markdown-missing-link-face))
7886 ;; remove-text-properties marks the buffer modified in emacs 24.3,
7887 ;; undo that if it wasn't originally marked modified
7888 (set-buffer-modified-p modified)))
7890 (defun markdown-fontify-region-wiki-links (from to)
7891 "Search region given by FROM and TO for wiki links and fontify them.
7892 If a wiki link is found check to see if the backing file exists
7893 and highlight accordingly."
7894 (goto-char from)
7895 (save-match-data
7896 (while (re-search-forward markdown-regex-wiki-link to t)
7897 (when (not (markdown-code-block-at-point-p))
7898 (let ((highlight-beginning (match-beginning 1))
7899 (highlight-end (match-end 1))
7900 (file-name
7901 (markdown-convert-wiki-link-to-filename
7902 (markdown-wiki-link-link))))
7903 (if (condition-case nil (file-exists-p file-name) (error nil))
7904 (markdown-highlight-wiki-link
7905 highlight-beginning highlight-end 'markdown-link-face)
7906 (markdown-highlight-wiki-link
7907 highlight-beginning highlight-end 'markdown-missing-link-face)))))))
7909 (defun markdown-extend-changed-region (from to)
7910 "Extend region given by FROM and TO so that we can fontify all links.
7911 The region is extended to the first newline before and the first
7912 newline after."
7913 ;; start looking for the first new line before 'from
7914 (goto-char from)
7915 (re-search-backward "\n" nil t)
7916 (let ((new-from (point-min))
7917 (new-to (point-max)))
7918 (if (not (= (point) from))
7919 (setq new-from (point)))
7920 ;; do the same thing for the first new line after 'to
7921 (goto-char to)
7922 (re-search-forward "\n" nil t)
7923 (if (not (= (point) to))
7924 (setq new-to (point)))
7925 (cl-values new-from new-to)))
7927 (defun markdown-check-change-for-wiki-link (from to)
7928 "Check region between FROM and TO for wiki links and re-fontify as needed."
7929 (interactive "*r")
7930 (let* ((modified (buffer-modified-p))
7931 (buffer-undo-list t)
7932 (inhibit-read-only t)
7933 (inhibit-point-motion-hooks t)
7934 deactivate-mark
7935 buffer-file-truename)
7936 (unwind-protect
7937 (save-excursion
7938 (save-match-data
7939 (save-restriction
7940 ;; Extend the region to fontify so that it starts
7941 ;; and ends at safe places.
7942 (cl-multiple-value-bind (new-from new-to)
7943 (markdown-extend-changed-region from to)
7944 (goto-char new-from)
7945 ;; Only refontify when the range contains text with a
7946 ;; wiki link face or if the wiki link regexp matches.
7947 (when (or (markdown-range-property-any
7948 new-from new-to 'font-lock-face
7949 '(markdown-link-face markdown-missing-link-face))
7950 (re-search-forward
7951 markdown-regex-wiki-link new-to t))
7952 ;; Unfontify existing fontification (start from scratch)
7953 (markdown-unfontify-region-wiki-links new-from new-to)
7954 ;; Now do the fontification.
7955 (markdown-fontify-region-wiki-links new-from new-to))))))
7956 (and (not modified)
7957 (buffer-modified-p)
7958 (set-buffer-modified-p nil)))))
7960 (defun markdown-check-change-for-wiki-link-after-change (from to _)
7961 "Check region between FROM and TO for wiki links and re-fontify as needed.
7962 Designed to be used with the `after-change-functions' hook."
7963 (markdown-check-change-for-wiki-link from to))
7965 (defun markdown-fontify-buffer-wiki-links ()
7966 "Refontify all wiki links in the buffer."
7967 (interactive)
7968 (markdown-check-change-for-wiki-link (point-min) (point-max)))
7970 (defun markdown-toggle-wiki-links (&optional arg)
7971 "Toggle support for wiki links.
7972 With a prefix argument ARG, enable wiki link support if ARG is positive,
7973 and disable it otherwise."
7974 (interactive (list (or current-prefix-arg 'toggle)))
7975 (setq markdown-enable-wiki-links
7976 (if (eq arg 'toggle)
7977 (not markdown-enable-wiki-links)
7978 (> (prefix-numeric-value arg) 0)))
7979 (if markdown-enable-wiki-links
7980 (message "markdown-mode wiki link support enabled")
7981 (message "markdown-mode wiki link support disabled"))
7982 (markdown-reload-extensions))
7984 (defun markdown-setup-wiki-link-hooks ()
7985 "Add or remove hooks for fontifying wiki links.
7986 These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
7987 ;; Anytime text changes make sure it gets fontified correctly
7988 (if (and markdown-enable-wiki-links
7989 markdown-wiki-link-fontify-missing)
7990 (add-hook 'after-change-functions
7991 'markdown-check-change-for-wiki-link-after-change t t)
7992 (remove-hook 'after-change-functions
7993 'markdown-check-change-for-wiki-link-after-change t))
7994 ;; If we left the buffer there is a really good chance we were
7995 ;; creating one of the wiki link documents. Make sure we get
7996 ;; refontified when we come back.
7997 (if (and markdown-enable-wiki-links
7998 markdown-wiki-link-fontify-missing)
7999 (progn
8000 (add-hook 'window-configuration-change-hook
8001 'markdown-fontify-buffer-wiki-links t t)
8002 (markdown-fontify-buffer-wiki-links))
8003 (remove-hook 'window-configuration-change-hook
8004 'markdown-fontify-buffer-wiki-links t)
8005 (markdown-unfontify-region-wiki-links (point-min) (point-max))))
8008 ;;; Following & Doing =========================================================
8010 (defun markdown-follow-thing-at-point (arg)
8011 "Follow thing at point if possible, such as a reference link or wiki link.
8012 Opens inline and reference links in a browser. Opens wiki links
8013 to other files in the current window, or the another window if
8014 ARG is non-nil.
8015 See `markdown-follow-link-at-point' and
8016 `markdown-follow-wiki-link-at-point'."
8017 (interactive "P")
8018 (cond ((markdown-link-p)
8019 (markdown-follow-link-at-point))
8020 ((markdown-wiki-link-p)
8021 (markdown-follow-wiki-link-at-point arg))
8023 (user-error "Nothing to follow at point"))))
8025 (make-obsolete 'markdown-jump 'markdown-do "v2.3")
8027 (defun markdown-do ()
8028 "Do something sensible based on context at point.
8029 Jumps between reference links and definitions; between footnote
8030 markers and footnote text."
8031 (interactive)
8032 (cond
8033 ;; Footnote definition
8034 ((markdown-footnote-text-positions)
8035 (markdown-footnote-return))
8036 ;; Footnote marker
8037 ((markdown-footnote-marker-positions)
8038 (markdown-footnote-goto-text))
8039 ;; Reference link
8040 ((thing-at-point-looking-at markdown-regex-link-reference)
8041 (markdown-reference-goto-definition))
8042 ;; Reference definition
8043 ((thing-at-point-looking-at markdown-regex-reference-definition)
8044 (markdown-reference-goto-link (match-string-no-properties 2)))
8045 ;; GFM task list item
8046 ((markdown-gfm-task-list-item-at-point)
8047 (markdown-toggle-gfm-checkbox))
8048 ;; Align table
8049 ((markdown-table-at-point-p)
8050 (call-interactively #'markdown-table-align))
8051 ;; Otherwise
8053 (markdown-insert-gfm-checkbox))))
8056 ;;; Miscellaneous =============================================================
8058 (defun markdown-compress-whitespace-string (str)
8059 "Compress whitespace in STR and return result.
8060 Leading and trailing whitespace is removed. Sequences of multiple
8061 spaces, tabs, and newlines are replaced with single spaces."
8062 (markdown-replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
8063 (markdown-replace-regexp-in-string "[ \t\n]+" " " str)))
8065 (defun markdown--substitute-command-keys (string)
8066 "Like `substitute-command-keys' but, but prefers control characters.
8067 First pass STRING to `substitute-command-keys' and then
8068 substitute `C-i` for `TAB` and `C-m` for `RET`."
8069 (replace-regexp-in-string
8070 "\\<TAB\\>" "C-i"
8071 (replace-regexp-in-string
8072 "\\<RET\\>" "C-m" (substitute-command-keys string) t) t))
8074 (defun markdown-line-number-at-pos (&optional pos)
8075 "Return (narrowed) buffer line number at position POS.
8076 If POS is nil, use current buffer location.
8077 This is an exact copy of `line-number-at-pos' for use in emacs21."
8078 (let ((opoint (or pos (point))) start)
8079 (save-excursion
8080 (goto-char (point-min))
8081 (setq start (point))
8082 (goto-char opoint)
8083 (forward-line 0)
8084 (1+ (count-lines start (point))))))
8086 (defun markdown-inside-link-p ()
8087 "Return t if point is within a link."
8088 (save-match-data
8089 (thing-at-point-looking-at (markdown-make-regex-link-generic))))
8091 (defun markdown-line-is-reference-definition-p ()
8092 "Return whether the current line is a (non-footnote) reference defition."
8093 (save-excursion
8094 (move-beginning-of-line 1)
8095 (and (looking-at-p markdown-regex-reference-definition)
8096 (not (looking-at-p "[ \t]*\\[^")))))
8098 (defun markdown-adaptive-fill-function ()
8099 "Return prefix for filling paragraph or nil if not determined."
8100 (cond
8101 ;; List item inside blockquote
8102 ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
8103 (markdown-replace-regexp-in-string
8104 "[0-9\\.*+-]" " " (match-string-no-properties 0)))
8105 ;; Blockquote
8106 ((looking-at markdown-regex-blockquote)
8107 (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
8108 ;; List items
8109 ((looking-at markdown-regex-list)
8110 (match-string-no-properties 0))
8111 ;; Footnote definition
8112 ((looking-at-p markdown-regex-footnote-definition)
8113 " ") ; four spaces
8114 ;; No match
8115 (t nil)))
8117 (defun markdown-fill-paragraph (&optional justify)
8118 "Fill paragraph at or after point.
8119 This function is like \\[fill-paragraph], but it skips Markdown
8120 code blocks. If the point is in a code block, or just before one,
8121 do not fill. Otherwise, call `fill-paragraph' as usual. If
8122 JUSTIFY is non-nil, justify text as well. Since this function
8123 handles filling itself, it always returns t so that
8124 `fill-paragraph' doesn't run."
8125 (interactive "P")
8126 (unless (or (markdown-code-block-at-point-p)
8127 (save-excursion
8128 (back-to-indentation)
8129 (skip-syntax-forward "-")
8130 (markdown-code-block-at-point-p)))
8131 (fill-paragraph justify))
8134 (make-obsolete 'markdown-fill-forward-paragraph-function
8135 'markdown-fill-forward-paragraph "v2.3")
8137 (defun markdown-fill-forward-paragraph (&optional arg)
8138 "Function used by `fill-paragraph' to move over ARG paragraphs.
8139 This is a `fill-forward-paragraph-function' for `markdown-mode'.
8140 It is called with a single argument specifying the number of
8141 paragraphs to move. Just like `forward-paragraph', it should
8142 return the number of paragraphs left to move."
8143 (or arg (setq arg 1))
8144 (if (> arg 0)
8145 ;; With positive ARG, move across ARG non-code-block paragraphs,
8146 ;; one at a time. When passing a code block, don't decrement ARG.
8147 (while (and (not (eobp))
8148 (> arg 0)
8149 (= (forward-paragraph 1) 0)
8150 (or (markdown-code-block-at-pos (point-at-bol 0))
8151 (setq arg (1- arg)))))
8152 ;; Move backward by one paragraph with negative ARG (always -1).
8153 (let ((start (point)))
8154 (setq arg (forward-paragraph arg))
8155 (while (and (not (eobp))
8156 (progn (move-to-left-margin) (not (eobp)))
8157 (looking-at-p paragraph-separate))
8158 (forward-line 1))
8159 (cond
8160 ;; Move point past whitespace following list marker.
8161 ((looking-at markdown-regex-list)
8162 (goto-char (match-end 0)))
8163 ;; Move point past whitespace following pipe at beginning of line
8164 ;; to handle Pandoc line blocks.
8165 ((looking-at "^|\\s-*")
8166 (goto-char (match-end 0)))
8167 ;; Return point if the paragraph passed was a code block.
8168 ((markdown-code-block-at-pos (point-at-bol 2))
8169 (goto-char start)))))
8170 arg)
8172 (defun markdown--inhibit-electric-quote ()
8173 "Function added to `electric-quote-inhibit-functions'.
8174 Return non-nil if the quote has been inserted inside a code block
8175 or span."
8176 (let ((pos (1- (point))))
8177 (or (markdown-inline-code-at-pos pos)
8178 (markdown-code-block-at-pos pos))))
8181 ;;; Extension Framework =======================================================
8183 (defun markdown-reload-extensions ()
8184 "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
8185 (interactive)
8186 (when (member major-mode
8187 '(markdown-mode markdown-view-mode gfm-mode gfm-view-mode))
8188 ;; Refontify buffer
8189 (if (eval-when-compile (fboundp 'font-lock-flush))
8190 ;; Use font-lock-flush in Emacs >= 25.1
8191 (font-lock-flush)
8192 ;; Backwards compatibility for Emacs 24.3-24.5
8193 (when (and font-lock-mode (fboundp 'font-lock-refresh-defaults))
8194 (font-lock-refresh-defaults)))
8195 ;; Add or remove hooks related to extensions
8196 (markdown-setup-wiki-link-hooks)))
8198 (defun markdown-handle-local-variables ()
8199 "Run in `hack-local-variables-hook' to update font lock rules.
8200 Checks to see if there is actually a ‘markdown-mode’ file local variable
8201 before regenerating font-lock rules for extensions."
8202 (when (and (boundp 'file-local-variables-alist)
8203 (or (assoc 'markdown-enable-wiki-links file-local-variables-alist)
8204 (assoc 'markdown-enable-math file-local-variables-alist)))
8205 (when (assoc 'markdown-enable-math file-local-variables-alist)
8206 (markdown-toggle-math markdown-enable-math))
8207 (markdown-reload-extensions)))
8210 ;;; Math Support ==============================================================
8212 (make-obsolete 'markdown-enable-math 'markdown-toggle-math "v2.1")
8214 (defconst markdown-mode-font-lock-keywords-math
8215 (list
8216 ;; Equation reference (eq:foo)
8217 '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face)
8218 (2 markdown-reference-face)
8219 (3 markdown-markup-face)))
8220 ;; Equation reference \eqref{foo}
8221 '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face)
8222 (2 markdown-reference-face)
8223 (3 markdown-markup-face))))
8224 "Font lock keywords to add and remove when toggling math support.")
8226 (defun markdown-toggle-math (&optional arg)
8227 "Toggle support for inline and display LaTeX math expressions.
8228 With a prefix argument ARG, enable math mode if ARG is positive,
8229 and disable it otherwise. If called from Lisp, enable the mode
8230 if ARG is omitted or nil."
8231 (interactive (list (or current-prefix-arg 'toggle)))
8232 (setq markdown-enable-math
8233 (if (eq arg 'toggle)
8234 (not markdown-enable-math)
8235 (> (prefix-numeric-value arg) 0)))
8236 (if markdown-enable-math
8237 (progn
8238 (font-lock-add-keywords
8239 'markdown-mode markdown-mode-font-lock-keywords-math)
8240 (message "markdown-mode math support enabled"))
8241 (font-lock-remove-keywords
8242 'markdown-mode markdown-mode-font-lock-keywords-math)
8243 (message "markdown-mode math support disabled"))
8244 (markdown-reload-extensions))
8247 ;;; GFM Checkboxes ============================================================
8249 (define-button-type 'markdown-gfm-checkbox-button
8250 'follow-link t
8251 'face 'markdown-gfm-checkbox-face
8252 'mouse-face 'markdown-highlight-face
8253 'action #'markdown-toggle-gfm-checkbox-button)
8255 (defun markdown-gfm-task-list-item-at-point (&optional bounds)
8256 "Return non-nil if there is a GFM task list item at the point.
8257 Optionally, the list item BOUNDS may be given if available, as
8258 returned by `markdown-cur-list-item-bounds'. When a task list item
8259 is found, the return value is the same value returned by
8260 `markdown-cur-list-item-bounds'."
8261 (unless bounds
8262 (setq bounds (markdown-cur-list-item-bounds)))
8263 (> (length (nth 5 bounds)) 0))
8265 (defun markdown-insert-gfm-checkbox ()
8266 "Add GFM checkbox at point.
8267 Returns t if added.
8268 Returns nil if non-applicable."
8269 (interactive)
8270 (let ((bounds (markdown-cur-list-item-bounds)))
8271 (if bounds
8272 (unless (cl-sixth bounds)
8273 (let ((pos (+ (cl-first bounds) (cl-fourth bounds)))
8274 (markup "[ ] "))
8275 (if (< pos (point))
8276 (save-excursion
8277 (goto-char pos)
8278 (insert markup))
8279 (goto-char pos)
8280 (insert markup))
8281 (syntax-propertize (+ (cl-second bounds) 4))
8283 (unless (save-excursion
8284 (back-to-indentation)
8285 (or (markdown-list-item-at-point-p)
8286 (markdown-heading-at-point)
8287 (markdown-in-comment-p)
8288 (markdown-code-block-at-point-p)))
8289 (let ((pos (save-excursion
8290 (back-to-indentation)
8291 (point)))
8292 (markup (concat (or (save-excursion
8293 (beginning-of-line 0)
8294 (cl-fifth (markdown-cur-list-item-bounds)))
8295 markdown-unordered-list-item-prefix)
8296 "[ ] ")))
8297 (if (< pos (point))
8298 (save-excursion
8299 (goto-char pos)
8300 (insert markup))
8301 (goto-char pos)
8302 (insert markup))
8303 (syntax-propertize (point-at-eol))
8304 t)))))
8306 (defun markdown-toggle-gfm-checkbox ()
8307 "Toggle GFM checkbox at point.
8308 Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
8309 Returns nil if there is no task list item at the point."
8310 (interactive)
8311 (save-match-data
8312 (save-excursion
8313 (let ((bounds (markdown-cur-list-item-bounds)))
8314 (when bounds
8315 ;; Move to beginning of task list item
8316 (goto-char (cl-first bounds))
8317 ;; Advance to column of first non-whitespace after marker
8318 (forward-char (cl-fourth bounds))
8319 (cond ((looking-at "\\[ \\]")
8320 (replace-match
8321 (if markdown-gfm-uppercase-checkbox "[X]" "[x]")
8322 nil t)
8323 (match-string-no-properties 0))
8324 ((looking-at "\\[[xX]\\]")
8325 (replace-match "[ ]" nil t)
8326 (match-string-no-properties 0))))))))
8328 (defun markdown-toggle-gfm-checkbox-button (button)
8329 "Toggle GFM checkbox BUTTON on click."
8330 (save-match-data
8331 (save-excursion
8332 (goto-char (button-start button))
8333 (markdown-toggle-gfm-checkbox))))
8335 (defun markdown-make-gfm-checkboxes-buttons (start end)
8336 "Make GFM checkboxes buttons in region between START and END."
8337 (save-excursion
8338 (goto-char start)
8339 (let ((case-fold-search t))
8340 (save-excursion
8341 (while (re-search-forward markdown-regex-gfm-checkbox end t)
8342 (make-button (match-beginning 1) (match-end 1)
8343 :type 'markdown-gfm-checkbox-button))))))
8345 ;; Called when any modification is made to buffer text.
8346 (defun markdown-gfm-checkbox-after-change-function (beg end _)
8347 "Add to `after-change-functions' to setup GFM checkboxes as buttons.
8348 BEG and END are the limits of scanned region."
8349 (save-excursion
8350 (save-match-data
8351 ;; Rescan between start of line from `beg' and start of line after `end'.
8352 (markdown-make-gfm-checkboxes-buttons
8353 (progn (goto-char beg) (beginning-of-line) (point))
8354 (progn (goto-char end) (forward-line 1) (point))))))
8356 (defun markdown-remove-gfm-checkbox-overlays ()
8357 "Remove all GFM checkbox overlays in buffer."
8358 (save-excursion
8359 (save-restriction
8360 (widen)
8361 (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face))))
8364 ;;; Display inline image =================================================
8366 (defvar markdown-inline-image-overlays nil)
8367 (make-variable-buffer-local 'markdown-inline-image-overlays)
8369 (defun markdown-remove-inline-images ()
8370 "Remove inline image overlays from image links in the buffer.
8371 This can be toggled with `markdown-toggle-inline-images'
8372 or \\[markdown-toggle-inline-images]."
8373 (interactive)
8374 (mapc #'delete-overlay markdown-inline-image-overlays)
8375 (setq markdown-inline-image-overlays nil))
8377 (defun markdown-display-inline-images ()
8378 "Add inline image overlays to image links in the buffer.
8379 This can be toggled with `markdown-toggle-inline-images'
8380 or \\[markdown-toggle-inline-images]."
8381 (interactive)
8382 (unless (display-images-p)
8383 (error "Cannot show images"))
8384 (save-excursion
8385 (save-restriction
8386 (widen)
8387 (goto-char (point-min))
8388 (while (re-search-forward markdown-regex-link-inline nil t)
8389 (let ((start (match-beginning 0))
8390 (end (match-end 0))
8391 (file (match-string-no-properties 6)))
8392 (when (and (not (zerop (length file)))
8393 (file-exists-p file))
8394 (let* ((abspath (if (file-name-absolute-p file)
8395 file
8396 (concat default-directory file)))
8397 (image
8398 (if (and markdown-max-image-size
8399 (image-type-available-p 'imagemagick))
8400 (create-image
8401 abspath 'imagemagick nil
8402 :max-width (car markdown-max-image-size)
8403 :max-height (cdr markdown-max-image-size))
8404 (create-image abspath))))
8405 (when image
8406 (let ((ov (make-overlay start end)))
8407 (overlay-put ov 'display image)
8408 (overlay-put ov 'face 'default)
8409 (push ov markdown-inline-image-overlays))))))))))
8411 (defun markdown-toggle-inline-images ()
8412 "Toggle inline image overlays in the buffer."
8413 (interactive)
8414 (if markdown-inline-image-overlays
8415 (markdown-remove-inline-images)
8416 (markdown-display-inline-images)))
8419 ;;; GFM Code Block Fontification ==============================================
8421 (defcustom markdown-fontify-code-blocks-natively nil
8422 "When non-nil, fontify code in code blocks using the native major mode.
8423 This only works for fenced code blocks where the language is
8424 specified where we can automatically determine the appropriate
8425 mode to use. The language to mode mapping may be customized by
8426 setting the variable `markdown-code-lang-modes'."
8427 :group 'markdown
8428 :type 'boolean
8429 :safe 'booleanp
8430 :package-version '(markdown-mode . "2.3"))
8432 (defcustom markdown-fontify-code-block-default-mode nil
8433 "Default mode to use to fontify code blocks.
8434 This mode is used when automatic detection fails, such as for GFM
8435 code blocks with no language specified."
8436 :group 'markdown
8437 :type '(choice function (const :tag "None" nil))
8438 :package-version '(markdown-mode . "2.4"))
8440 (defun markdown-toggle-fontify-code-blocks-natively (&optional arg)
8441 "Toggle the native fontification of code blocks.
8442 With a prefix argument ARG, enable if ARG is positive,
8443 and disable otherwise."
8444 (interactive (list (or current-prefix-arg 'toggle)))
8445 (setq markdown-fontify-code-blocks-natively
8446 (if (eq arg 'toggle)
8447 (not markdown-fontify-code-blocks-natively)
8448 (> (prefix-numeric-value arg) 0)))
8449 (if markdown-fontify-code-blocks-natively
8450 (message "markdown-mode native code block fontification enabled")
8451 (message "markdown-mode native code block fontification disabled"))
8452 (markdown-reload-extensions))
8454 ;; This is based on `org-src-lang-modes' from org-src.el
8455 (defcustom markdown-code-lang-modes
8456 '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
8457 ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
8458 ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
8459 ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
8460 ("bash" . sh-mode))
8461 "Alist mapping languages to their major mode.
8462 The key is the language name, the value is the major mode. For
8463 many languages this is simple, but for language where this is not
8464 the case, this variable provides a way to simplify things on the
8465 user side. For example, there is no ocaml-mode in Emacs, but the
8466 mode to use is `tuareg-mode'."
8467 :group 'markdown
8468 :type '(repeat
8469 (cons
8470 (string "Language name")
8471 (symbol "Major mode")))
8472 :package-version '(markdown-mode . "2.3"))
8474 (defun markdown-get-lang-mode (lang)
8475 "Return major mode that should be used for LANG.
8476 LANG is a string, and the returned major mode is a symbol."
8477 (cl-find-if
8478 'fboundp
8479 (list (cdr (assoc lang markdown-code-lang-modes))
8480 (cdr (assoc (downcase lang) markdown-code-lang-modes))
8481 (intern (concat lang "-mode"))
8482 (intern (concat (downcase lang) "-mode")))))
8484 (defun markdown-fontify-code-blocks-generic (matcher last)
8485 "Add text properties to next code block from point to LAST.
8486 Use matching function MATCHER."
8487 (when (funcall matcher last)
8488 (save-excursion
8489 (save-match-data
8490 (let* ((start (match-beginning 0))
8491 (end (match-end 0))
8492 ;; Find positions outside opening and closing backquotes.
8493 (bol-prev (progn (goto-char start)
8494 (if (bolp) (point-at-bol 0) (point-at-bol))))
8495 (eol-next (progn (goto-char end)
8496 (if (bolp) (point-at-bol 2) (point-at-bol 3))))
8497 lang)
8498 (if (and markdown-fontify-code-blocks-natively
8499 (or (setq lang (markdown-code-block-lang))
8500 markdown-fontify-code-block-default-mode))
8501 (markdown-fontify-code-block-natively lang start end)
8502 (add-text-properties start end '(face markdown-pre-face)))
8503 ;; Set background for block as well as opening and closing lines.
8504 (font-lock-append-text-property
8505 bol-prev eol-next 'face 'markdown-code-face)
8506 ;; Set invisible property for lines before and after, including newline.
8507 (add-text-properties bol-prev start '(invisible markdown-markup))
8508 (add-text-properties end eol-next '(invisible markdown-markup)))))
8511 (defun markdown-fontify-gfm-code-blocks (last)
8512 "Add text properties to next GFM code block from point to LAST."
8513 (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last))
8515 (defun markdown-fontify-fenced-code-blocks (last)
8516 "Add text properties to next tilde fenced code block from point to LAST."
8517 (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last))
8519 ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
8520 (defun markdown-fontify-code-block-natively (lang start end)
8521 "Fontify given GFM or fenced code block.
8522 This function is called by Emacs for automatic fontification when
8523 `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
8524 language used in the block. START and END specify the block
8525 position."
8526 (let ((lang-mode (if lang (markdown-get-lang-mode lang)
8527 markdown-fontify-code-block-default-mode)))
8528 (when (fboundp lang-mode)
8529 (let ((string (buffer-substring-no-properties start end))
8530 (modified (buffer-modified-p))
8531 (markdown-buffer (current-buffer)) pos next)
8532 (remove-text-properties start end '(face nil))
8533 (with-current-buffer
8534 (get-buffer-create
8535 (concat " markdown-code-fontification:" (symbol-name lang-mode)))
8536 ;; Make sure that modification hooks are not inhibited in
8537 ;; the org-src-fontification buffer in case we're called
8538 ;; from `jit-lock-function' (Bug#25132).
8539 (let ((inhibit-modification-hooks nil))
8540 (delete-region (point-min) (point-max))
8541 (insert string " ")) ;; so there's a final property change
8542 (unless (eq major-mode lang-mode) (funcall lang-mode))
8543 (markdown-font-lock-ensure)
8544 (setq pos (point-min))
8545 (while (setq next (next-single-property-change pos 'face))
8546 (let ((val (get-text-property pos 'face)))
8547 (when val
8548 (put-text-property
8549 (+ start (1- pos)) (1- (+ start next)) 'face
8550 val markdown-buffer)))
8551 (setq pos next)))
8552 (add-text-properties
8553 start end
8554 '(font-lock-fontified t fontified t font-lock-multiline t))
8555 (set-buffer-modified-p modified)))))
8557 (require 'edit-indirect nil t)
8558 (defvar edit-indirect-guess-mode-function)
8559 (defvar edit-indirect-after-commit-functions)
8561 (defun markdown--edit-indirect-after-commit-function (_beg end)
8562 "Ensure trailing newlines at the END of code blocks."
8563 (goto-char end)
8564 (unless (eq (char-before) ?\n)
8565 (insert "\n")))
8567 (defun markdown-edit-code-block ()
8568 "Edit Markdown code block in an indirect buffer."
8569 (interactive)
8570 (save-excursion
8571 (if (fboundp 'edit-indirect-region)
8572 (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
8573 (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2)))
8574 (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1))))
8575 (if (and begin end)
8576 (let* ((lang (markdown-code-block-lang))
8577 (mode (or (and lang (markdown-get-lang-mode lang))
8578 markdown-edit-code-block-default-mode))
8579 (edit-indirect-guess-mode-function
8580 (lambda (_parent-buffer _beg _end)
8581 (funcall mode))))
8582 (edit-indirect-region begin end 'display-buffer))
8583 (user-error "Not inside a GFM or tilde fenced code block")))
8584 (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
8585 (progn (package-refresh-contents)
8586 (package-install 'edit-indirect)
8587 (markdown-edit-code-block))))))
8590 ;;; Table Editing
8592 ;; These functions were originally adapted from `org-table.el'.
8594 ;; General helper functions
8596 (defmacro markdown--with-gensyms (symbols &rest body)
8597 (declare (debug (sexp body)) (indent 1))
8598 `(let ,(mapcar (lambda (s)
8599 `(,s (make-symbol (concat "--" (symbol-name ',s)))))
8600 symbols)
8601 ,@body))
8603 (defun markdown--split-string (string &optional separators)
8604 "Splits STRING into substrings at SEPARATORS.
8605 SEPARATORS is a regular expression. If nil it defaults to
8606 `split-string-default-separators'. This version returns no empty
8607 strings if there are matches at the beginning and end of string."
8608 (let ((start 0) notfirst list)
8609 (while (and (string-match
8610 (or separators split-string-default-separators)
8611 string
8612 (if (and notfirst
8613 (= start (match-beginning 0))
8614 (< start (length string)))
8615 (1+ start) start))
8616 (< (match-beginning 0) (length string)))
8617 (setq notfirst t)
8618 (or (eq (match-beginning 0) 0)
8619 (and (eq (match-beginning 0) (match-end 0))
8620 (eq (match-beginning 0) start))
8621 (push (substring string start (match-beginning 0)) list))
8622 (setq start (match-end 0)))
8623 (or (eq start (length string))
8624 (push (substring string start) list))
8625 (nreverse list)))
8627 (defun markdown--string-width (s)
8628 "Return width of string S.
8629 This version ignores characters with invisibility property
8630 `markdown-markup'."
8631 (let (b)
8632 (when (or (eq t buffer-invisibility-spec)
8633 (member 'markdown-markup buffer-invisibility-spec))
8634 (while (setq b (text-property-any
8635 0 (length s)
8636 'invisible 'markdown-markup s))
8637 (setq s (concat
8638 (substring s 0 b)
8639 (substring s (or (next-single-property-change
8640 b 'invisible s)
8641 (length s))))))))
8642 (string-width s))
8644 (defun markdown--remove-invisible-markup (s)
8645 "Remove Markdown markup from string S.
8646 This version removes characters with invisibility property
8647 `markdown-markup'."
8648 (let (b)
8649 (while (setq b (text-property-any
8650 0 (length s)
8651 'invisible 'markdown-markup s))
8652 (setq s (concat
8653 (substring s 0 b)
8654 (substring s (or (next-single-property-change
8655 b 'invisible s)
8656 (length s)))))))
8659 ;; Functions for maintaining tables
8661 (defvar markdown-table-at-point-p-function nil
8662 "Function to decide if point is inside a table.
8664 The indirection serves to differentiate between standard markdown
8665 tables and gfm tables which are less strict about the markup.")
8667 (defconst markdown-table-line-regexp "^[ \t]*|"
8668 "Regexp matching any line inside a table.")
8670 (defconst markdown-table-hline-regexp "^[ \t]*|[-:]"
8671 "Regexp matching hline inside a table.")
8673 (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]"
8674 "Regexp matching dline inside a table.")
8676 (defun markdown-table-at-point-p ()
8677 "Return non-nil when point is inside a table."
8678 (if (functionp markdown-table-at-point-p-function)
8679 (funcall markdown-table-at-point-p-function)
8680 (markdown--table-at-point-p)))
8682 (defun markdown--table-at-point-p ()
8683 "Return non-nil when point is inside a table."
8684 (save-excursion
8685 (beginning-of-line)
8686 (and (looking-at-p markdown-table-line-regexp)
8687 (not (markdown-code-block-at-point-p)))))
8689 (defconst gfm-table-line-regexp "^.?*|"
8690 "Regexp matching any line inside a table.")
8692 (defconst gfm-table-hline-regexp "^-+\\(|-\\)+"
8693 "Regexp matching hline inside a table.")
8695 ;; GFM simplified tables syntax is as follows:
8696 ;; - A header line for the column names, this is any text
8697 ;; separated by `|'.
8698 ;; - Followed by a string -|-|- ..., the number of dashes is optional
8699 ;; but must be higher than 1. The number of separators should match
8700 ;; the number of columns.
8701 ;; - Followed by the rows of data, which has the same format as the
8702 ;; header line.
8703 ;; Example:
8705 ;; foo | bar
8706 ;; ------|---------
8707 ;; bar | baz
8708 ;; bar | baz
8709 (defun gfm--table-at-point-p ()
8710 "Return non-nil when point is inside a gfm-compatible table."
8711 (or (markdown--table-at-point-p)
8712 (save-excursion
8713 (beginning-of-line)
8714 (when (looking-at-p gfm-table-line-regexp)
8715 ;; we might be at the first line of the table, check if the
8716 ;; line below is the hline
8717 (or (save-excursion
8718 (forward-line 1)
8719 (looking-at-p gfm-table-hline-regexp))
8720 ;; go up to find the header
8721 (catch 'done
8722 (while (looking-at-p gfm-table-line-regexp)
8723 (cond
8724 ((looking-at-p gfm-table-hline-regexp)
8725 (throw 'done t))
8726 ((bobp)
8727 (throw 'done nil)))
8728 (forward-line -1))
8729 nil))))))
8731 (defun markdown-table-hline-at-point-p ()
8732 "Return non-nil when point is on a hline in a table.
8733 This function assumes point is on a table."
8734 (save-excursion
8735 (beginning-of-line)
8736 (looking-at-p markdown-table-hline-regexp)))
8738 (defun markdown-table-begin ()
8739 "Find the beginning of the table and return its position.
8740 This function assumes point is on a table."
8741 (save-excursion
8742 (while (and (not (bobp))
8743 (markdown-table-at-point-p))
8744 (forward-line -1))
8745 (unless (eobp)
8746 (forward-line 1))
8747 (point)))
8749 (defun markdown-table-end ()
8750 "Find the end of the table and return its position.
8751 This function assumes point is on a table."
8752 (save-excursion
8753 (while (and (not (eobp))
8754 (markdown-table-at-point-p))
8755 (forward-line 1))
8756 (point)))
8758 (defun markdown-table-get-dline ()
8759 "Return index of the table data line at point.
8760 This function assumes point is on a table."
8761 (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
8762 (save-excursion
8763 (goto-char (markdown-table-begin))
8764 (while (and (re-search-forward
8765 markdown-table-dline-regexp end t)
8766 (setq cnt (1+ cnt))
8767 (< (point-at-eol) pos))))
8768 cnt))
8770 (defun markdown-table-get-column ()
8771 "Return table column at point.
8772 This function assumes point is on a table."
8773 (let ((pos (point)) (cnt 0))
8774 (save-excursion
8775 (beginning-of-line)
8776 (while (search-forward "|" pos t) (setq cnt (1+ cnt))))
8777 cnt))
8779 (defun markdown-table-get-cell (&optional n)
8780 "Return the content of the cell in column N of current row.
8781 N defaults to column at point. This function assumes point is on
8782 a table."
8783 (and n (markdown-table-goto-column n))
8784 (skip-chars-backward "^|\n") (backward-char 1)
8785 (if (looking-at "|[^|\r\n]*")
8786 (let* ((pos (match-beginning 0))
8787 (val (buffer-substring (1+ pos) (match-end 0))))
8788 (goto-char (min (point-at-eol) (+ 2 pos)))
8789 ;; Trim whitespaces
8790 (setq val (replace-regexp-in-string "\\`[ \t]+" "" val)
8791 val (replace-regexp-in-string "[ \t]+\\'" "" val)))
8792 (forward-char 1) ""))
8794 (defun markdown-table-goto-dline (n)
8795 "Go to the Nth data line in the table at point.
8796 Return t when the line exists, nil otherwise. This function
8797 assumes point is on a table."
8798 (goto-char (markdown-table-begin))
8799 (let ((end (markdown-table-end)) (cnt 0))
8800 (while (and (re-search-forward
8801 markdown-table-dline-regexp end t)
8802 (< (setq cnt (1+ cnt)) n)))
8803 (= cnt n)))
8805 (defun markdown-table-goto-column (n &optional on-delim)
8806 "Go to the Nth column in the table line at point.
8807 With optional argument ON-DELIM, stop with point before the left
8808 delimiter of the cell. If there are less than N cells, just go
8809 beyond the last delimiter. This function assumes point is on a
8810 table."
8811 (beginning-of-line 1)
8812 (when (> n 0)
8813 (while (and (> (setq n (1- n)) -1)
8814 (search-forward "|" (point-at-eol) t)))
8815 (if on-delim
8816 (backward-char 1)
8817 (when (looking-at " ") (forward-char 1)))))
8819 (defmacro markdown-table-save-cell (&rest body)
8820 "Save cell at point, execute BODY and restore cell.
8821 This function assumes point is on a table."
8822 (declare (debug (body)))
8823 (markdown--with-gensyms (line column)
8824 `(let ((,line (copy-marker (line-beginning-position)))
8825 (,column (markdown-table-get-column)))
8826 (unwind-protect
8827 (progn ,@body)
8828 (goto-char ,line)
8829 (markdown-table-goto-column ,column)
8830 (set-marker ,line nil)))))
8832 (defun markdown-table-blank-line (s)
8833 "Convert a table line S into a line with blank cells."
8834 (if (string-match "^[ \t]*|-" s)
8835 (setq s (mapconcat
8836 (lambda (x) (if (member x '(?| ?+)) "|" " "))
8837 s ""))
8838 (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
8839 (setq s (replace-match
8840 (concat "|" (make-string (length (match-string 1 s)) ?\ ) "|")
8841 t t s)))
8844 (defun markdown-table-colfmt (fmtspec)
8845 "Process column alignment specifier FMTSPEC for tables."
8846 (when (stringp fmtspec)
8847 (mapcar (lambda (x)
8848 (cond ((string-match-p "^:.*:$" x) 'c)
8849 ((string-match-p "^:" x) 'l)
8850 ((string-match-p ":$" x) 'r)
8851 (t 'd)))
8852 (markdown--split-string fmtspec "\\s-*|\\s-*"))))
8854 (defun markdown-table-align ()
8855 "Align table at point.
8856 This function assumes point is on a table."
8857 (interactive)
8858 (let ((begin (markdown-table-begin))
8859 (end (copy-marker (markdown-table-end))))
8860 (markdown-table-save-cell
8861 (goto-char begin)
8862 (let* (fmtspec
8863 ;; Store table indent
8864 (indent (progn (looking-at "[ \t]*") (match-string 0)))
8865 ;; Split table in lines and save column format specifier
8866 (lines (mapcar (lambda (l)
8867 (if (string-match-p "\\`[ \t]*|[-:]" l)
8868 (progn (setq fmtspec (or fmtspec l)) nil) l))
8869 (markdown--split-string (buffer-substring begin end) "\n")))
8870 ;; Split lines in cells
8871 (cells (mapcar (lambda (l) (markdown--split-string l "\\s-*|\\s-*"))
8872 (remq nil lines)))
8873 ;; Calculate maximum number of cells in a line
8874 (maxcells (if cells
8875 (apply #'max (mapcar #'length cells))
8876 (user-error "Empty table")))
8877 ;; Empty cells to fill short lines
8878 (emptycells (make-list maxcells "")) maxwidths)
8879 ;; Calculate maximum width for each column
8880 (dotimes (i maxcells)
8881 (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells)))
8882 (push (apply #'max 1 (mapcar #'markdown--string-width column))
8883 maxwidths)))
8884 (setq maxwidths (nreverse maxwidths))
8885 ;; Process column format specifier
8886 (setq fmtspec (markdown-table-colfmt fmtspec))
8887 ;; Compute formats needed for output of table lines
8888 (let ((hfmt (concat indent "|"))
8889 (rfmt (concat indent "|"))
8890 hfmt1 rfmt1 fmt)
8891 (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|")))
8892 (setq fmt (pop fmtspec))
8893 (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |"))
8894 ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |"))
8895 ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |"))
8896 (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |")))
8897 (setq rfmt (concat rfmt (format rfmt1 width)))
8898 (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-)))))
8899 ;; Replace modified lines only
8900 (dolist (line lines)
8901 (let ((line (if line
8902 (apply #'format rfmt (append (pop cells) emptycells))
8903 hfmt))
8904 (previous (buffer-substring (point) (line-end-position))))
8905 (if (equal previous line)
8906 (forward-line)
8907 (insert line "\n")
8908 (delete-region (point) (line-beginning-position 2))))))
8909 (set-marker end nil)))))
8911 (defun markdown-table-insert-row (&optional arg)
8912 "Insert a new row above the row at point into the table.
8913 With optional argument ARG, insert below the current row."
8914 (interactive "P")
8915 (unless (markdown-table-at-point-p)
8916 (user-error "Not at a table"))
8917 (let* ((line (buffer-substring
8918 (line-beginning-position) (line-end-position)))
8919 (new (markdown-table-blank-line line)))
8920 (beginning-of-line (if arg 2 1))
8921 (unless (bolp) (insert "\n"))
8922 (insert-before-markers new "\n")
8923 (beginning-of-line 0)
8924 (re-search-forward "| ?" (line-end-position) t)))
8926 (defun markdown-table-delete-row ()
8927 "Delete row or horizontal line at point from the table."
8928 (interactive)
8929 (unless (markdown-table-at-point-p)
8930 (user-error "Not at a table"))
8931 (let ((col (current-column)))
8932 (kill-region (point-at-bol)
8933 (min (1+ (point-at-eol)) (point-max)))
8934 (unless (markdown-table-at-point-p) (beginning-of-line 0))
8935 (move-to-column col)))
8937 (defun markdown-table-move-row (&optional up)
8938 "Move table line at point down.
8939 With optional argument UP, move it up."
8940 (interactive "P")
8941 (unless (markdown-table-at-point-p)
8942 (user-error "Not at a table"))
8943 (let* ((col (current-column)) (pos (point))
8944 (tonew (if up 0 2)) txt)
8945 (beginning-of-line tonew)
8946 (unless (markdown-table-at-point-p)
8947 (goto-char pos) (user-error "Cannot move row further"))
8948 (goto-char pos) (beginning-of-line 1) (setq pos (point))
8949 (setq txt (buffer-substring (point) (1+ (point-at-eol))))
8950 (delete-region (point) (1+ (point-at-eol)))
8951 (beginning-of-line tonew)
8952 (insert txt) (beginning-of-line 0)
8953 (move-to-column col)))
8955 (defun markdown-table-move-row-up ()
8956 "Move table row at point up."
8957 (interactive)
8958 (markdown-table-move-row 'up))
8960 (defun markdown-table-move-row-down ()
8961 "Move table row at point down."
8962 (interactive)
8963 (markdown-table-move-row nil))
8965 (defun markdown-table-insert-column ()
8966 "Insert a new table column."
8967 (interactive)
8968 (unless (markdown-table-at-point-p)
8969 (user-error "Not at a table"))
8970 (let* ((col (max 1 (markdown-table-get-column)))
8971 (begin (markdown-table-begin))
8972 (end (copy-marker (markdown-table-end))))
8973 (markdown-table-save-cell
8974 (goto-char begin)
8975 (while (< (point) end)
8976 (markdown-table-goto-column col t)
8977 (if (markdown-table-hline-at-point-p)
8978 (insert "|---")
8979 (insert "| "))
8980 (forward-line)))
8981 (set-marker end nil)
8982 (markdown-table-align)))
8984 (defun markdown-table-delete-column ()
8985 "Delete column at point from table."
8986 (interactive)
8987 (unless (markdown-table-at-point-p)
8988 (user-error "Not at a table"))
8989 (let ((col (markdown-table-get-column))
8990 (begin (markdown-table-begin))
8991 (end (copy-marker (markdown-table-end))))
8992 (markdown-table-save-cell
8993 (goto-char begin)
8994 (while (< (point) end)
8995 (markdown-table-goto-column col t)
8996 (and (looking-at "|[^|\n]+|")
8997 (replace-match "|"))
8998 (forward-line)))
8999 (set-marker end nil)
9000 (markdown-table-goto-column (max 1 (1- col)))
9001 (markdown-table-align)))
9003 (defun markdown-table-move-column (&optional left)
9004 "Move table column at point to the right.
9005 With optional argument LEFT, move it to the left."
9006 (interactive "P")
9007 (unless (markdown-table-at-point-p)
9008 (user-error "Not at a table"))
9009 (let* ((col (markdown-table-get-column))
9010 (col1 (if left (1- col) col))
9011 (colpos (if left (1- col) (1+ col)))
9012 (begin (markdown-table-begin))
9013 (end (copy-marker (markdown-table-end))))
9014 (when (and left (= col 1))
9015 (user-error "Cannot move column further left"))
9016 (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
9017 (user-error "Cannot move column further right"))
9018 (markdown-table-save-cell
9019 (goto-char begin)
9020 (while (< (point) end)
9021 (markdown-table-goto-column col1 t)
9022 (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
9023 (replace-match "|\\2|\\1|"))
9024 (forward-line)))
9025 (set-marker end nil)
9026 (markdown-table-goto-column colpos)
9027 (markdown-table-align)))
9029 (defun markdown-table-move-column-left ()
9030 "Move table column at point to the left."
9031 (interactive)
9032 (markdown-table-move-column 'left))
9034 (defun markdown-table-move-column-right ()
9035 "Move table column at point to the right."
9036 (interactive)
9037 (markdown-table-move-column nil))
9039 (defun markdown-table-next-row ()
9040 "Go to the next row (same column) in the table.
9041 Create new table lines if required."
9042 (interactive)
9043 (unless (markdown-table-at-point-p)
9044 (user-error "Not at a table"))
9045 (if (or (looking-at "[ \t]*$")
9046 (save-excursion (skip-chars-backward " \t") (bolp)))
9047 (newline)
9048 (markdown-table-align)
9049 (let ((col (markdown-table-get-column)))
9050 (beginning-of-line 2)
9051 (if (or (not (markdown-table-at-point-p))
9052 (markdown-table-hline-at-point-p))
9053 (progn
9054 (beginning-of-line 0)
9055 (markdown-table-insert-row 'below)))
9056 (markdown-table-goto-column col)
9057 (skip-chars-backward "^|\n\r")
9058 (when (looking-at " ") (forward-char 1)))))
9060 (defun markdown-table-forward-cell ()
9061 "Go to the next cell in the table.
9062 Create new table lines if required."
9063 (interactive)
9064 (unless (markdown-table-at-point-p)
9065 (user-error "Not at a table"))
9066 (markdown-table-align)
9067 (let ((end (markdown-table-end)))
9068 (when (markdown-table-hline-at-point-p) (end-of-line 1))
9069 (condition-case nil
9070 (progn
9071 (re-search-forward "|" end)
9072 (if (looking-at "[ \t]*$")
9073 (re-search-forward "|" end))
9074 (if (and (looking-at "[-:]")
9075 (re-search-forward "^[ \t]*|\\([^-:]\\)" end t))
9076 (goto-char (match-beginning 1)))
9077 (if (looking-at "[-:]")
9078 (progn
9079 (beginning-of-line 0)
9080 (markdown-table-insert-row 'below))
9081 (when (looking-at " ") (forward-char 1))))
9082 (error (markdown-table-insert-row 'below)))))
9084 (defun markdown-table-backward-cell ()
9085 "Go to the previous cell in the table."
9086 (interactive)
9087 (unless (markdown-table-at-point-p)
9088 (user-error "Not at a table"))
9089 (markdown-table-align)
9090 (when (markdown-table-hline-at-point-p) (end-of-line 1))
9091 (condition-case nil
9092 (progn
9093 (re-search-backward "|" (markdown-table-begin))
9094 (re-search-backward "|" (markdown-table-begin)))
9095 (error (user-error "Cannot move to previous table cell")))
9096 (while (looking-at "|\\([-:]\\|[ \t]*$\\)")
9097 (re-search-backward "|" (markdown-table-begin)))
9098 (when (looking-at "| ?") (goto-char (match-end 0))))
9100 (defun markdown-table-transpose ()
9101 "Transpose table at point.
9102 Horizontal separator lines will be eliminated."
9103 (interactive)
9104 (unless (markdown-table-at-point-p)
9105 (user-error "Not at a table"))
9106 (let* ((table (buffer-substring-no-properties
9107 (markdown-table-begin) (markdown-table-end)))
9108 ;; Convert table to a Lisp structure
9109 (table (delq nil
9110 (mapcar
9111 (lambda (x)
9112 (unless (string-match-p
9113 markdown-table-hline-regexp x)
9114 (markdown--split-string x "\\s-*|\\s-*")))
9115 (markdown--split-string table "[ \t]*\n[ \t]*"))))
9116 (dline_old (markdown-table-get-dline))
9117 (col_old (markdown-table-get-column))
9118 (contents (mapcar (lambda (_)
9119 (let ((tp table))
9120 (mapcar
9121 (lambda (_)
9122 (prog1
9123 (pop (car tp))
9124 (setq tp (cdr tp))))
9125 table)))
9126 (car table))))
9127 (goto-char (markdown-table-begin))
9128 (re-search-forward "|") (backward-char)
9129 (delete-region (point) (markdown-table-end))
9130 (insert (mapconcat
9131 (lambda(x)
9132 (concat "| " (mapconcat 'identity x " | " ) " |\n"))
9133 contents ""))
9134 (markdown-table-goto-dline col_old)
9135 (markdown-table-goto-column dline_old))
9136 (markdown-table-align))
9138 (defun markdown-table-sort-lines (&optional sorting-type)
9139 "Sort table lines according to the column at point.
9141 The position of point indicates the column to be used for
9142 sorting, and the range of lines is the range between the nearest
9143 horizontal separator lines, or the entire table of no such lines
9144 exist. If point is before the first column, user will be prompted
9145 for the sorting column. If there is an active region, the mark
9146 specifies the first line and the sorting column, while point
9147 should be in the last line to be included into the sorting.
9149 The command then prompts for the sorting type which can be
9150 alphabetically or numerically. Sorting in reverse order is also
9151 possible.
9153 If SORTING-TYPE is specified when this function is called from a
9154 Lisp program, no prompting will take place. SORTING-TYPE must be
9155 a character, any of (?a ?A ?n ?N) where the capital letters
9156 indicate that sorting should be done in reverse order."
9157 (interactive)
9158 (unless (markdown-table-at-point-p)
9159 (user-error "Not at a table"))
9160 ;; Set sorting type and column used for sorting
9161 (let ((column (let ((c (markdown-table-get-column)))
9162 (cond ((> c 0) c)
9163 ((called-interactively-p 'any)
9164 (read-number "Use column N for sorting: "))
9165 (t 1))))
9166 (sorting-type
9167 (or sorting-type
9168 (read-char-exclusive
9169 "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))
9170 (save-restriction
9171 ;; Narrow buffer to appropriate sorting area
9172 (if (region-active-p)
9173 (narrow-to-region
9174 (save-excursion
9175 (progn
9176 (goto-char (region-beginning)) (line-beginning-position)))
9177 (save-excursion
9178 (progn
9179 (goto-char (region-end)) (line-end-position))))
9180 (let ((start (markdown-table-begin))
9181 (end (markdown-table-end)))
9182 (narrow-to-region
9183 (save-excursion
9184 (if (re-search-backward
9185 markdown-table-hline-regexp start t)
9186 (line-beginning-position 2)
9187 start))
9188 (if (save-excursion (re-search-forward
9189 markdown-table-hline-regexp end t))
9190 (match-beginning 0)
9191 end))))
9192 ;; Determine arguments for `sort-subr'
9193 (let* ((extract-key-from-cell
9194 (cl-case sorting-type
9195 ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity)
9196 ((?n ?N) #'string-to-number)
9197 (t (user-error "Invalid sorting type: %c" sorting-type))))
9198 (predicate
9199 (cl-case sorting-type
9200 ((?n ?N) #'<)
9201 ((?a ?A) #'string<))))
9202 ;; Sort selected area
9203 (goto-char (point-min))
9204 (sort-subr (memq sorting-type '(?A ?N))
9205 (lambda ()
9206 (forward-line)
9207 (while (and (not (eobp))
9208 (not (looking-at
9209 markdown-table-dline-regexp)))
9210 (forward-line)))
9211 #'end-of-line
9212 (lambda ()
9213 (funcall extract-key-from-cell
9214 (markdown-table-get-cell column)))
9216 predicate)
9217 (goto-char (point-min))))))
9219 (defun markdown-table-convert-region (begin end &optional separator)
9220 "Convert region from BEGIN to END to table with SEPARATOR.
9222 If every line contains at least one TAB character, the function
9223 assumes that the material is tab separated (TSV). If every line
9224 contains a comma, comma-separated values (CSV) are assumed. If
9225 not, lines are split at whitespace into cells.
9227 You can use a prefix argument to force a specific separator:
9228 \\[universal-argument] once forces CSV, \\[universal-argument]
9229 twice forces TAB, and \\[universal-argument] three times will
9230 prompt for a regular expression to match the separator, and a
9231 numeric argument N indicates that at least N consecutive
9232 spaces, or alternatively a TAB should be used as the separator."
9234 (interactive "r\nP")
9235 (let* ((begin (min begin end)) (end (max begin end)) re)
9236 (goto-char begin) (beginning-of-line 1)
9237 (setq begin (point-marker))
9238 (goto-char end)
9239 (if (bolp) (backward-char 1) (end-of-line 1))
9240 (setq end (point-marker))
9241 (when (equal separator '(64))
9242 (setq separator (read-regexp "Regexp for cell separator: ")))
9243 (unless separator
9244 ;; Get the right cell separator
9245 (goto-char begin)
9246 (setq separator
9247 (cond
9248 ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
9249 ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
9250 (t 1))))
9251 (goto-char begin)
9252 (if (equal separator '(4))
9253 ;; Parse CSV
9254 (while (< (point) end)
9255 (cond
9256 ((looking-at "^") (insert "| "))
9257 ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
9258 ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
9259 (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
9260 ((looking-at "[^,\n]+") (goto-char (match-end 0)))
9261 ((looking-at "[ \t]*,") (replace-match " | "))
9262 (t (beginning-of-line 2))))
9263 (setq re
9264 (cond
9265 ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
9266 ((equal separator '(16)) "^\\|\t")
9267 ((integerp separator)
9268 (if (< separator 1)
9269 (user-error "Cell separator must contain one or more spaces")
9270 (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
9271 ((stringp separator) (format "^ *\\|%s" separator))
9272 (t (error "Invalid cell separator"))))
9273 (while (re-search-forward re end t) (replace-match "| " t t)))
9274 (goto-char begin)
9275 (markdown-table-align)))
9278 ;;; ElDoc Support
9280 (defun markdown-eldoc-function ()
9281 "Return a helpful string when appropriate based on context.
9282 * Report URL when point is at a hidden URL.
9283 * Report language name when point is a code block with hidden markup."
9284 (cond
9285 ;; Hidden URL or reference for inline link
9286 ((and (or (thing-at-point-looking-at markdown-regex-link-inline)
9287 (thing-at-point-looking-at markdown-regex-link-reference))
9288 (or markdown-hide-urls markdown-hide-markup))
9289 (let* ((imagep (string-equal (match-string 1) "!"))
9290 (edit-keys (markdown--substitute-command-keys
9291 (if imagep
9292 "\\[markdown-insert-image]"
9293 "\\[markdown-insert-link]")))
9294 (edit-str (propertize edit-keys 'face 'font-lock-constant-face))
9295 (referencep (string-equal (match-string 5) "["))
9296 (object (if referencep "reference" "URL")))
9297 (format "Hidden %s (%s to edit): %s" object edit-str
9298 (if referencep
9299 (concat
9300 (propertize "[" 'face 'markdown-markup-face)
9301 (propertize (match-string-no-properties 6)
9302 'face 'markdown-reference-face)
9303 (propertize "]" 'face 'markdown-markup-face))
9304 (propertize (match-string-no-properties 6)
9305 'face 'markdown-url-face)))))
9306 ;; Hidden language name for fenced code blocks
9307 ((and (markdown-code-block-at-point-p)
9308 (not (get-text-property (point) 'markdown-pre))
9309 markdown-hide-markup)
9310 (let ((lang (save-excursion (markdown-code-block-lang))))
9311 (unless lang (setq lang "[unspecified]"))
9312 (format "Hidden code block language: %s (%s to toggle markup)"
9313 (propertize lang 'face 'markdown-language-keyword-face)
9314 (markdown--substitute-command-keys
9315 "\\[markdown-toggle-markup-hiding]"))))))
9318 ;;; Mode Definition ==========================================================
9320 (defun markdown-show-version ()
9321 "Show the version number in the minibuffer."
9322 (interactive)
9323 (message "markdown-mode, version %s" markdown-mode-version))
9325 (defun markdown-mode-info ()
9326 "Open the `markdown-mode' homepage."
9327 (interactive)
9328 (browse-url "https://jblevins.org/projects/markdown-mode/"))
9330 ;;;###autoload
9331 (define-derived-mode markdown-mode text-mode "Markdown"
9332 "Major mode for editing Markdown files."
9333 ;; Natural Markdown tab width
9334 (setq tab-width 4)
9335 ;; Comments
9336 (setq-local comment-start "<!-- ")
9337 (setq-local comment-end " -->")
9338 (setq-local comment-start-skip "<!--[ \t]*")
9339 (setq-local comment-column 0)
9340 (setq-local comment-auto-fill-only-comments nil)
9341 (setq-local comment-use-syntax t)
9342 ;; Syntax
9343 (add-hook 'syntax-propertize-extend-region-functions
9344 #'markdown-syntax-propertize-extend-region)
9345 (add-hook 'jit-lock-after-change-extend-region-functions
9346 #'markdown-font-lock-extend-region-function t t)
9347 (setq-local syntax-propertize-function #'markdown-syntax-propertize)
9348 (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
9349 ;; Font lock.
9350 (setq font-lock-defaults
9351 '(markdown-mode-font-lock-keywords
9352 nil nil nil nil
9353 (font-lock-multiline . t)
9354 (font-lock-syntactic-face-function . markdown-syntactic-face)
9355 (font-lock-extra-managed-props
9356 . (composition display invisible rear-nonsticky
9357 keymap help-echo mouse-face))))
9358 (if markdown-hide-markup
9359 (add-to-invisibility-spec 'markdown-markup)
9360 (remove-from-invisibility-spec 'markdown-markup))
9361 ;; Wiki links
9362 (markdown-setup-wiki-link-hooks)
9363 ;; Math mode
9364 (when markdown-enable-math (markdown-toggle-math t))
9365 ;; Add a buffer-local hook to reload after file-local variables are read
9366 (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t)
9367 ;; For imenu support
9368 (setq imenu-create-index-function
9369 (if markdown-nested-imenu-heading-index
9370 #'markdown-imenu-create-nested-index
9371 #'markdown-imenu-create-flat-index))
9372 ;; For menu support in XEmacs
9373 (easy-menu-add markdown-mode-menu markdown-mode-map)
9374 ;; Defun movement
9375 (setq-local beginning-of-defun-function #'markdown-beginning-of-defun)
9376 (setq-local end-of-defun-function #'markdown-end-of-defun)
9377 ;; Paragraph filling
9378 (setq-local fill-paragraph-function #'markdown-fill-paragraph)
9379 (setq-local paragraph-start
9380 ;; Should match start of lines that start or separate paragraphs
9381 (mapconcat #'identity
9383 "\f" ; starts with a literal line-feed
9384 "[ \t\f]*$" ; space-only line
9385 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9386 "[ \t]*[*+-][ \t]+" ; unordered list item
9387 "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
9388 "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
9389 "[ \t]*:[ \t]+" ; definition
9390 "^|" ; table or Pandoc line block
9392 "\\|"))
9393 (setq-local paragraph-separate
9394 ;; Should match lines that separate paragraphs without being
9395 ;; part of any paragraph:
9396 (mapconcat #'identity
9397 '("[ \t\f]*$" ; space-only line
9398 "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
9399 ;; The following is not ideal, but the Fill customization
9400 ;; options really only handle paragraph-starting prefixes,
9401 ;; not paragraph-ending suffixes:
9402 ".* $" ; line ending in two spaces
9403 "^#+"
9404 "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
9405 "\\|"))
9406 (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'")
9407 (setq-local adaptive-fill-regexp "\\s-*")
9408 (setq-local adaptive-fill-function #'markdown-adaptive-fill-function)
9409 (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph)
9410 ;; Outline mode
9411 (setq-local outline-regexp markdown-regex-header)
9412 (setq-local outline-level #'markdown-outline-level)
9413 ;; Cause use of ellipses for invisible text.
9414 (add-to-invisibility-spec '(outline . t))
9415 ;; ElDoc support
9416 (if (eval-when-compile (fboundp 'add-function))
9417 (add-function :before-until (local 'eldoc-documentation-function)
9418 #'markdown-eldoc-function)
9419 (setq-local eldoc-documentation-function #'markdown-eldoc-function))
9420 ;; Inhibiting line-breaking:
9421 ;; Separating out each condition into a separate function so that users can
9422 ;; override if desired (with remove-hook)
9423 (add-hook 'fill-nobreak-predicate
9424 #'markdown-line-is-reference-definition-p nil t)
9425 (add-hook 'fill-nobreak-predicate
9426 #'markdown-pipe-at-bol-p nil t)
9428 ;; Indentation
9429 (setq-local indent-line-function markdown-indent-function)
9431 ;; Flyspell
9432 (setq-local flyspell-generic-check-word-predicate
9433 #'markdown-flyspell-check-word-p)
9435 ;; Electric quoting
9436 (add-hook 'electric-quote-inhibit-functions
9437 #'markdown--inhibit-electric-quote nil :local)
9439 ;; Backwards compatibility with markdown-css-path
9440 (when (boundp 'markdown-css-path)
9441 (warn "markdown-css-path is deprecated, see markdown-css-paths.")
9442 (add-to-list 'markdown-css-paths markdown-css-path))
9444 ;; Prepare hooks for XEmacs compatibility
9445 (when (featurep 'xemacs)
9446 (make-local-hook 'after-change-functions)
9447 (make-local-hook 'font-lock-extend-region-functions)
9448 (make-local-hook 'window-configuration-change-hook))
9450 ;; Make checkboxes buttons
9451 (when markdown-make-gfm-checkboxes-buttons
9452 (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
9453 (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t)
9454 (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t))
9456 ;; edit-indirect
9457 (add-hook 'edit-indirect-after-commit-functions
9458 #'markdown--edit-indirect-after-commit-function
9459 nil 'local)
9461 ;; Marginalized headings
9462 (when markdown-marginalize-headers
9463 (add-hook 'window-configuration-change-hook
9464 #'markdown-marginalize-update-current nil t))
9466 ;; add live preview export hook
9467 (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t)
9468 (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t))
9470 ;;;###autoload
9471 (add-to-list 'auto-mode-alist '("\\.markdown\\'" . markdown-mode) t)
9472 ;;;###autoload
9473 (add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode) t)
9476 ;;; GitHub Flavored Markdown Mode ============================================
9478 (defvar gfm-mode-hook nil
9479 "Hook run when entering GFM mode.")
9481 ;;;###autoload
9482 (define-derived-mode gfm-mode markdown-mode "GFM"
9483 "Major mode for editing GitHub Flavored Markdown files."
9484 (setq markdown-link-space-sub-char "-")
9485 (setq markdown-wiki-link-search-subdirectories t)
9486 (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p)
9487 (markdown-gfm-parse-buffer-for-languages))
9489 (define-obsolete-variable-alias
9490 'gfm-font-lock-keywords
9491 'markdown-mode-font-lock-keywords "v2.4")
9494 ;;; Viewing modes
9496 (defcustom markdown-hide-markup-in-view-modes t
9497 "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
9498 :group 'markdown
9499 :type 'boolean
9500 :safe 'booleanp)
9502 (defvar markdown-view-mode-map
9503 (let ((map (make-sparse-keymap)))
9504 (define-key map (kbd "p") #'markdown-outline-previous)
9505 (define-key map (kbd "n") #'markdown-outline-next)
9506 (define-key map (kbd "f") #'markdown-outline-next-same-level)
9507 (define-key map (kbd "b") #'markdown-outline-previous-same-level)
9508 (define-key map (kbd "u") #'markdown-outline-up)
9509 (define-key map (kbd "DEL") #'scroll-down-command)
9510 (define-key map (kbd "SPC") #'scroll-up-command)
9511 (define-key map (kbd ">") #'end-of-buffer)
9512 (define-key map (kbd "<") #'beginning-of-buffer)
9513 (define-key map (kbd "q") #'kill-this-buffer)
9514 (define-key map (kbd "?") #'describe-mode)
9515 map)
9516 "Keymap for `markdown-view-mode'.")
9518 ;;;###autoload
9519 (define-derived-mode markdown-view-mode markdown-mode "Markdown-View"
9520 "Major mode for viewing Markdown content."
9521 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
9522 (read-only-mode 1))
9524 (defvar gfm-view-mode-map
9525 markdown-view-mode-map
9526 "Keymap for `gfm-view-mode'.")
9528 ;;;###autoload
9529 (define-derived-mode gfm-view-mode gfm-mode "GFM-View"
9530 "Major mode for viewing GitHub Flavored Markdown content."
9531 (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
9532 (read-only-mode 1))
9535 ;;; Live Preview Mode ============================================
9536 ;;;###autoload
9537 (define-minor-mode markdown-live-preview-mode
9538 "Toggle native previewing on save for a specific markdown file."
9539 :lighter " MD-Preview"
9540 (if markdown-live-preview-mode
9541 (if (markdown-live-preview-get-filename)
9542 (markdown-display-buffer-other-window (markdown-live-preview-export))
9543 (markdown-live-preview-mode -1)
9544 (user-error "Buffer %s does not visit a file" (current-buffer)))
9545 (markdown-live-preview-remove)))
9548 (provide 'markdown-mode)
9550 ;; Local Variables:
9551 ;; indent-tabs-mode: nil
9552 ;; coding: utf-8
9553 ;; End:
9554 ;;; markdown-mode.el ends here