Personal emacs config
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

9721 lines
400 KiB

  1. ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2007-2020 Jason R. Blevins and markdown-mode
  3. ;; contributors (see the commit log for details).
  4. ;; Author: Jason R. Blevins <jblevins@xbeta.org>
  5. ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org>
  6. ;; Created: May 24, 2007
  7. ;; Version: 2.5-dev
  8. ;; Package-Version: 20210123.1547
  9. ;; Package-Commit: 779a4c637719f5a192c128ed60ecffed3ff1760c
  10. ;; Package-Requires: ((emacs "25.1"))
  11. ;; Keywords: Markdown, GitHub Flavored Markdown, itex
  12. ;; URL: https://jblevins.org/projects/markdown-mode/
  13. ;; This file is not part of GNU Emacs.
  14. ;; This program is free software; you can redistribute it and/or modify
  15. ;; it under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation, either version 3 of the License, or
  17. ;; (at your option) any later version.
  18. ;; This program is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. ;; GNU General Public License for more details.
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  24. ;;; Commentary:
  25. ;; See the README.md file for details.
  26. ;;; Code:
  27. (require 'easymenu)
  28. (require 'outline)
  29. (require 'thingatpt)
  30. (require 'cl-lib)
  31. (require 'url-parse)
  32. (require 'button)
  33. (require 'color)
  34. (require 'rx)
  35. (require 'subr-x)
  36. (defvar jit-lock-start)
  37. (defvar jit-lock-end)
  38. (defvar flyspell-generic-check-word-predicate)
  39. (defvar electric-pair-pairs)
  40. ;;; Constants =================================================================
  41. (defconst markdown-mode-version "2.5-dev"
  42. "Markdown mode version number.")
  43. (defconst markdown-output-buffer-name "*markdown-output*"
  44. "Name of temporary buffer for markdown command output.")
  45. ;;; Global Variables ==========================================================
  46. (defvar markdown-reference-label-history nil
  47. "History of used reference labels.")
  48. (defvar markdown-live-preview-mode nil
  49. "Sentinel variable for command `markdown-live-preview-mode'.")
  50. (defvar markdown-gfm-language-history nil
  51. "History list of languages used in the current buffer in GFM code blocks.")
  52. ;;; Customizable Variables ====================================================
  53. (defvar markdown-mode-hook nil
  54. "Hook run when entering Markdown mode.")
  55. (defvar markdown-before-export-hook nil
  56. "Hook run before running Markdown to export XHTML output.
  57. The hook may modify the buffer, which will be restored to it's
  58. original state after exporting is complete.")
  59. (defvar markdown-after-export-hook nil
  60. "Hook run after XHTML output has been saved.
  61. Any changes to the output buffer made by this hook will be saved.")
  62. (defgroup markdown nil
  63. "Major mode for editing text files in Markdown format."
  64. :prefix "markdown-"
  65. :group 'text
  66. :link '(url-link "https://jblevins.org/projects/markdown-mode/"))
  67. (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc")
  68. when (executable-find cmd)
  69. return (file-name-nondirectory it))))
  70. (or command "markdown"))
  71. "Command to run markdown."
  72. :group 'markdown
  73. :type '(choice (string :tag "Shell command") (repeat (string)) function))
  74. (defcustom markdown-command-needs-filename nil
  75. "Set to non-nil if `markdown-command' does not accept input from stdin.
  76. Instead, it will be passed a filename as the final command line
  77. option. As a result, you will only be able to run Markdown from
  78. buffers which are visiting a file."
  79. :group 'markdown
  80. :type 'boolean)
  81. (defcustom markdown-open-command nil
  82. "Command used for opening Markdown files directly.
  83. For example, a standalone Markdown previewer. This command will
  84. be called with a single argument: the filename of the current
  85. buffer. It can also be a function, which will be called without
  86. arguments."
  87. :group 'markdown
  88. :type '(choice file function (const :tag "None" nil)))
  89. (defcustom markdown-open-image-command nil
  90. "Command used for opening image files directly.
  91. This is used at `markdown-follow-link-at-point'."
  92. :group 'markdown
  93. :type '(choice file function (const :tag "None" nil)))
  94. (defcustom markdown-hr-strings
  95. '("-------------------------------------------------------------------------------"
  96. "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
  97. "---------------------------------------"
  98. "* * * * * * * * * * * * * * * * * * * *"
  99. "---------"
  100. "* * * * *")
  101. "Strings to use when inserting horizontal rules.
  102. The first string in the list will be the default when inserting a
  103. horizontal rule. Strings should be listed in decreasing order of
  104. prominence (as in headings from level one to six) for use with
  105. promotion and demotion functions."
  106. :group 'markdown
  107. :type '(repeat string))
  108. (defcustom markdown-bold-underscore nil
  109. "Use two underscores when inserting bold text instead of two asterisks."
  110. :group 'markdown
  111. :type 'boolean)
  112. (defcustom markdown-italic-underscore nil
  113. "Use underscores when inserting italic text instead of asterisks."
  114. :group 'markdown
  115. :type 'boolean)
  116. (defcustom markdown-marginalize-headers nil
  117. "When non-nil, put opening atx header markup in a left margin.
  118. This setting goes well with `markdown-asymmetric-header'. But
  119. sadly it conflicts with `linum-mode' since they both use the
  120. same margin."
  121. :group 'markdown
  122. :type 'boolean
  123. :safe 'booleanp
  124. :package-version '(markdown-mode . "2.4"))
  125. (defcustom markdown-marginalize-headers-margin-width 6
  126. "Character width of margin used for marginalized headers.
  127. The default value is based on there being six heading levels
  128. defined by Markdown and HTML. Increasing this produces extra
  129. whitespace on the left. Decreasing it may be preferred when
  130. fewer than six nested heading levels are used."
  131. :group 'markdown
  132. :type 'natnump
  133. :safe 'natnump
  134. :package-version '(markdown-mode . "2.4"))
  135. (defcustom markdown-asymmetric-header nil
  136. "Determines if atx header style will be asymmetric.
  137. Set to a non-nil value to use asymmetric header styling, placing
  138. header markup only at the beginning of the line. By default,
  139. balanced markup will be inserted at the beginning and end of the
  140. line around the header title."
  141. :group 'markdown
  142. :type 'boolean)
  143. (defcustom markdown-indent-function 'markdown-indent-line
  144. "Function to use to indent."
  145. :group 'markdown
  146. :type 'function)
  147. (defcustom markdown-indent-on-enter t
  148. "Determines indentation behavior when pressing \\[newline].
  149. Possible settings are nil, t, and 'indent-and-new-item.
  150. When non-nil, pressing \\[newline] will call `newline-and-indent'
  151. to indent the following line according to the context using
  152. `markdown-indent-function'. In this case, note that
  153. \\[electric-newline-and-maybe-indent] can still be used to insert
  154. a newline without indentation.
  155. When set to 'indent-and-new-item and the point is in a list item
  156. when \\[newline] is pressed, the list will be continued on the next
  157. line, where a new item will be inserted.
  158. When set to nil, simply call `newline' as usual. In this case,
  159. you can still indent lines using \\[markdown-cycle] and continue
  160. lists with \\[markdown-insert-list-item].
  161. Note that this assumes the variable `electric-indent-mode' is
  162. non-nil (enabled). When it is *disabled*, the behavior of
  163. \\[newline] and `\\[electric-newline-and-maybe-indent]' are
  164. reversed."
  165. :group 'markdown
  166. :type '(choice (const :tag "Don't automatically indent" nil)
  167. (const :tag "Automatically indent" t)
  168. (const :tag "Automatically indent and insert new list items" indent-and-new-item)))
  169. (defcustom markdown-enable-wiki-links nil
  170. "Syntax highlighting for wiki links.
  171. Set this to a non-nil value to turn on wiki link support by default.
  172. Support can be toggled later using the `markdown-toggle-wiki-links'
  173. function or \\[markdown-toggle-wiki-links]."
  174. :group 'markdown
  175. :type 'boolean
  176. :safe 'booleanp
  177. :package-version '(markdown-mode . "2.2"))
  178. (defcustom markdown-wiki-link-alias-first t
  179. "When non-nil, treat aliased wiki links like [[alias text|PageName]].
  180. Otherwise, they will be treated as [[PageName|alias text]]."
  181. :group 'markdown
  182. :type 'boolean
  183. :safe 'booleanp)
  184. (defcustom markdown-wiki-link-search-subdirectories nil
  185. "When non-nil, search for wiki link targets in subdirectories.
  186. This is the default search behavior for GitHub and is
  187. automatically set to t in `gfm-mode'."
  188. :group 'markdown
  189. :type 'boolean
  190. :safe 'booleanp
  191. :package-version '(markdown-mode . "2.2"))
  192. (defcustom markdown-wiki-link-search-parent-directories nil
  193. "When non-nil, search for wiki link targets in parent directories.
  194. This is the default search behavior of Ikiwiki."
  195. :group 'markdown
  196. :type 'boolean
  197. :safe 'booleanp
  198. :package-version '(markdown-mode . "2.2"))
  199. (defcustom markdown-wiki-link-fontify-missing nil
  200. "When non-nil, change wiki link face according to existence of target files.
  201. This is expensive because it requires checking for the file each time the buffer
  202. changes or the user switches windows. It is disabled by default because it may
  203. cause lag when typing on slower machines."
  204. :group 'markdown
  205. :type 'boolean
  206. :safe 'booleanp
  207. :package-version '(markdown-mode . "2.2"))
  208. (defcustom markdown-uri-types
  209. '("acap" "cid" "data" "dav" "fax" "file" "ftp"
  210. "gopher" "http" "https" "imap" "ldap" "mailto"
  211. "mid" "message" "modem" "news" "nfs" "nntp"
  212. "pop" "prospero" "rtsp" "service" "sip" "tel"
  213. "telnet" "tip" "urn" "vemmi" "wais")
  214. "Link types for syntax highlighting of URIs."
  215. :group 'markdown
  216. :type '(repeat (string :tag "URI scheme")))
  217. (defcustom markdown-url-compose-char
  218. '(?∞ ?… ?⋯ ?# ?★ ?⚓)
  219. "Placeholder character for hidden URLs.
  220. This may be a single character or a list of characters. In case
  221. of a list, the first one that satisfies `char-displayable-p' will
  222. be used."
  223. :type '(choice
  224. (character :tag "Single URL replacement character")
  225. (repeat :tag "List of possible URL replacement characters"
  226. character))
  227. :package-version '(markdown-mode . "2.3"))
  228. (defcustom markdown-blockquote-display-char
  229. '("" "" ">")
  230. "String to display when hiding blockquote markup.
  231. This may be a single string or a list of string. In case of a
  232. list, the first one that satisfies `char-displayable-p' will be
  233. used."
  234. :type 'string
  235. :type '(choice
  236. (string :tag "Single blockquote display string")
  237. (repeat :tag "List of possible blockquote display strings" string))
  238. :package-version '(markdown-mode . "2.3"))
  239. (defcustom markdown-hr-display-char
  240. '(?─ ?━ ?-)
  241. "Character for hiding horizontal rule markup.
  242. This may be a single character or a list of characters. In case
  243. of a list, the first one that satisfies `char-displayable-p' will
  244. be used."
  245. :group 'markdown
  246. :type '(choice
  247. (character :tag "Single HR display character")
  248. (repeat :tag "List of possible HR display characters" character))
  249. :package-version '(markdown-mode . "2.3"))
  250. (defcustom markdown-definition-display-char
  251. '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:)
  252. "Character for replacing definition list markup.
  253. This may be a single character or a list of characters. In case
  254. of a list, the first one that satisfies `char-displayable-p' will
  255. be used."
  256. :type '(choice
  257. (character :tag "Single definition list character")
  258. (repeat :tag "List of possible definition list characters" character))
  259. :package-version '(markdown-mode . "2.3"))
  260. (defcustom markdown-enable-math nil
  261. "Syntax highlighting for inline LaTeX and itex expressions.
  262. Set this to a non-nil value to turn on math support by default.
  263. Math support can be enabled, disabled, or toggled later using
  264. `markdown-toggle-math' or \\[markdown-toggle-math]."
  265. :group 'markdown
  266. :type 'boolean
  267. :safe 'booleanp)
  268. (make-variable-buffer-local 'markdown-enable-math)
  269. (defcustom markdown-enable-html t
  270. "Enable font-lock support for HTML tags and attributes."
  271. :group 'markdown
  272. :type 'boolean
  273. :safe 'booleanp
  274. :package-version '(markdown-mode . "2.4"))
  275. (defcustom markdown-css-paths nil
  276. "List of URLs of CSS files to link to in the output XHTML."
  277. :group 'markdown
  278. :type '(repeat (string :tag "CSS File Path")))
  279. (defcustom markdown-content-type "text/html"
  280. "Content type string for the http-equiv header in XHTML output.
  281. When set to an empty string, this attribute is omitted. Defaults to
  282. `text/html'."
  283. :group 'markdown
  284. :type 'string)
  285. (defcustom markdown-coding-system nil
  286. "Character set string for the http-equiv header in XHTML output.
  287. Defaults to `buffer-file-coding-system' (and falling back to
  288. `utf-8' when not available). Common settings are `iso-8859-1'
  289. and `iso-latin-1'. Use `list-coding-systems' for more choices."
  290. :group 'markdown
  291. :type 'coding-system)
  292. (defcustom markdown-export-kill-buffer t
  293. "Kill output buffer after HTML export.
  294. When non-nil, kill the HTML output buffer after
  295. exporting with `markdown-export'."
  296. :group 'markdown
  297. :type 'boolean
  298. :safe 'booleanp
  299. :package-version '(markdown-mode . "2.4"))
  300. (defcustom markdown-xhtml-header-content ""
  301. "Additional content to include in the XHTML <head> block."
  302. :group 'markdown
  303. :type 'string)
  304. (defcustom markdown-xhtml-body-preamble ""
  305. "Content to include in the XHTML <body> block, before the output."
  306. :group 'markdown
  307. :type 'string
  308. :safe 'stringp
  309. :package-version '(markdown-mode . "2.4"))
  310. (defcustom markdown-xhtml-body-epilogue ""
  311. "Content to include in the XHTML <body> block, after the output."
  312. :group 'markdown
  313. :type 'string
  314. :safe 'stringp
  315. :package-version '(markdown-mode . "2.4"))
  316. (defcustom markdown-xhtml-standalone-regexp
  317. "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
  318. "Regexp indicating whether `markdown-command' output is standalone XHTML."
  319. :group 'markdown
  320. :type 'regexp)
  321. (defcustom markdown-link-space-sub-char "_"
  322. "Character to use instead of spaces when mapping wiki links to filenames."
  323. :group 'markdown
  324. :type 'string)
  325. (defcustom markdown-reference-location 'header
  326. "Position where new reference definitions are inserted in the document."
  327. :group 'markdown
  328. :type '(choice (const :tag "At the end of the document" end)
  329. (const :tag "Immediately after the current block" immediately)
  330. (const :tag "At the end of the subtree" subtree)
  331. (const :tag "Before next header" header)))
  332. (defcustom markdown-footnote-location 'end
  333. "Position where new footnotes are inserted in the document."
  334. :group 'markdown
  335. :type '(choice (const :tag "At the end of the document" end)
  336. (const :tag "Immediately after the current block" immediately)
  337. (const :tag "At the end of the subtree" subtree)
  338. (const :tag "Before next header" header)))
  339. (defcustom markdown-footnote-display '((raise 0.2) (height 0.8))
  340. "Display specification for footnote markers and inline footnotes.
  341. By default, footnote text is reduced in size and raised. Set to
  342. nil to disable this."
  343. :group 'markdown
  344. :type '(choice (sexp :tag "Display specification")
  345. (const :tag "Don't set display property" nil))
  346. :package-version '(markdown-mode . "2.4"))
  347. (defcustom markdown-sub-superscript-display
  348. '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7)))
  349. "Display specification for subscript and superscripts.
  350. The car is used for subscript, the cdr is used for superscripts."
  351. :group 'markdown
  352. :type '(cons (choice (sexp :tag "Subscript form")
  353. (const :tag "No lowering" nil))
  354. (choice (sexp :tag "Superscript form")
  355. (const :tag "No raising" nil)))
  356. :package-version '(markdown-mode . "2.4"))
  357. (defcustom markdown-unordered-list-item-prefix " * "
  358. "String inserted before unordered list items."
  359. :group 'markdown
  360. :type 'string)
  361. (defcustom markdown-ordered-list-enumeration t
  362. "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker.
  363. While nil, always uses '1.' for the marker"
  364. :group 'markdown
  365. :type 'boolean
  366. :package-version '(markdown-mode . "2.5"))
  367. (defcustom markdown-nested-imenu-heading-index t
  368. "Use nested or flat imenu heading index.
  369. A nested index may provide more natural browsing from the menu,
  370. but a flat list may allow for faster keyboard navigation via tab
  371. completion."
  372. :group 'markdown
  373. :type 'boolean
  374. :safe 'booleanp
  375. :package-version '(markdown-mode . "2.2"))
  376. (defcustom markdown-add-footnotes-to-imenu t
  377. "Add footnotes to end of imenu heading index."
  378. :group 'markdown
  379. :type 'boolean
  380. :safe 'booleanp
  381. :package-version '(markdown-mode . "2.4"))
  382. (defcustom markdown-make-gfm-checkboxes-buttons t
  383. "When non-nil, make GFM checkboxes into buttons."
  384. :group 'markdown
  385. :type 'boolean)
  386. (defcustom markdown-use-pandoc-style-yaml-metadata nil
  387. "When non-nil, allow YAML metadata anywhere in the document."
  388. :group 'markdown
  389. :type 'boolean)
  390. (defcustom markdown-split-window-direction 'any
  391. "Preference for splitting windows for static and live preview.
  392. The default value is 'any, which instructs Emacs to use
  393. `split-window-sensibly' to automatically choose how to split
  394. windows based on the values of `split-width-threshold' and
  395. `split-height-threshold' and the available windows. To force
  396. vertically split (left and right) windows, set this to 'vertical
  397. or 'right. To force horizontally split (top and bottom) windows,
  398. set this to 'horizontal or 'below.
  399. If this value is 'any and `display-buffer-alist' is set then
  400. `display-buffer' is used for open buffer function"
  401. :group 'markdown
  402. :type '(choice (const :tag "Automatic" any)
  403. (const :tag "Right (vertical)" right)
  404. (const :tag "Below (horizontal)" below))
  405. :package-version '(markdown-mode . "2.2"))
  406. (defcustom markdown-live-preview-window-function
  407. 'markdown-live-preview-window-eww
  408. "Function to display preview of Markdown output within Emacs.
  409. Function must update the buffer containing the preview and return
  410. the buffer."
  411. :group 'markdown
  412. :type 'function)
  413. (defcustom markdown-live-preview-delete-export 'delete-on-destroy
  414. "Delete exported HTML file when using `markdown-live-preview-export'.
  415. If set to 'delete-on-export, delete on every export. When set to
  416. 'delete-on-destroy delete when quitting from command
  417. `markdown-live-preview-mode'. Never delete if set to nil."
  418. :group 'markdown
  419. :type '(choice
  420. (const :tag "Delete on every export" delete-on-export)
  421. (const :tag "Delete when quitting live preview" delete-on-destroy)
  422. (const :tag "Never delete" nil)))
  423. (defcustom markdown-list-indent-width 4
  424. "Depth of indentation for markdown lists.
  425. Used in `markdown-demote-list-item' and
  426. `markdown-promote-list-item'."
  427. :group 'markdown
  428. :type 'integer)
  429. (defcustom markdown-enable-prefix-prompts t
  430. "Display prompts for certain prefix commands.
  431. Set to nil to disable these prompts."
  432. :group 'markdown
  433. :type 'boolean
  434. :safe 'booleanp
  435. :package-version '(markdown-mode . "2.3"))
  436. (defcustom markdown-gfm-additional-languages nil
  437. "Extra languages made available when inserting GFM code blocks.
  438. Language strings must have be trimmed of whitespace and not
  439. contain any curly braces. They may be of arbitrary
  440. capitalization, though."
  441. :group 'markdown
  442. :type '(repeat (string :validate markdown-validate-language-string)))
  443. (defcustom markdown-gfm-use-electric-backquote t
  444. "Use `markdown-electric-backquote' when backquote is hit three times."
  445. :group 'markdown
  446. :type 'boolean)
  447. (defcustom markdown-gfm-downcase-languages t
  448. "If non-nil, downcase suggested languages.
  449. This applies to insertions done with
  450. `markdown-electric-backquote'."
  451. :group 'markdown
  452. :type 'boolean)
  453. (defcustom markdown-edit-code-block-default-mode 'normal-mode
  454. "Default mode to use for editing code blocks.
  455. This mode is used when automatic detection fails, such as for GFM
  456. code blocks with no language specified."
  457. :group 'markdown
  458. :type '(choice function (const :tag "None" nil))
  459. :package-version '(markdown-mode . "2.4"))
  460. (defcustom markdown-gfm-uppercase-checkbox nil
  461. "If non-nil, use [X] for completed checkboxes, [x] otherwise."
  462. :group 'markdown
  463. :type 'boolean
  464. :safe 'booleanp)
  465. (defcustom markdown-hide-urls nil
  466. "Hide URLs of inline links and reference tags of reference links.
  467. Such URLs will be replaced by a single customizable
  468. character, defined by `markdown-url-compose-char', but are still part
  469. of the buffer. Links can be edited interactively with
  470. \\[markdown-insert-link] or, for example, by deleting the final
  471. parenthesis to remove the invisibility property. You can also
  472. hover your mouse pointer over the link text to see the URL.
  473. Set this to a non-nil value to turn this feature on by default.
  474. You can interactively set the value of this variable by calling
  475. `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
  476. or from the menu Markdown > Links & Images menu."
  477. :group 'markdown
  478. :type 'boolean
  479. :safe 'booleanp
  480. :package-version '(markdown-mode . "2.3"))
  481. (make-variable-buffer-local 'markdown-hide-urls)
  482. (defcustom markdown-translate-filename-function #'identity
  483. "Function to use to translate filenames when following links.
  484. \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
  485. call this function with the filename as only argument whenever
  486. they encounter a filename (instead of a URL) to be visited and
  487. use its return value instead of the filename in the link. For
  488. example, if absolute filenames are actually relative to a server
  489. root directory, you can set
  490. `markdown-translate-filename-function' to a function that
  491. prepends the root directory to the given filename."
  492. :group 'markdown
  493. :type 'function
  494. :risky t
  495. :package-version '(markdown-mode . "2.4"))
  496. (defcustom markdown-max-image-size nil
  497. "Maximum width and height for displayed inline images.
  498. This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
  499. When nil, use the actual size. Otherwise, use ImageMagick to
  500. resize larger images to be of the given maximum dimensions. This
  501. requires Emacs to be built with ImageMagick support."
  502. :group 'markdown
  503. :package-version '(markdown-mode . "2.4")
  504. :type '(choice
  505. (const :tag "Use actual image width" nil)
  506. (cons (choice (sexp :tag "Maximum width in pixels")
  507. (const :tag "No maximum width" nil))
  508. (choice (sexp :tag "Maximum height in pixels")
  509. (const :tag "No maximum height" nil)))))
  510. (defcustom markdown-mouse-follow-link t
  511. "Non-nil means mouse on a link will follow the link.
  512. This variable must be set before loading markdown-mode."
  513. :group 'markdown
  514. :type 'bool
  515. :safe 'booleanp
  516. :package-version '(markdown-mode . "2.5"))
  517. ;;; Markdown-Specific `rx' Macro ==============================================
  518. ;; Based on python-rx from python.el.
  519. (eval-and-compile
  520. (defconst markdown-rx-constituents
  521. `((newline . ,(rx "\n"))
  522. ;; Note: #405 not consider markdown-list-indent-width however this is never used
  523. (indent . ,(rx (or (repeat 4 " ") "\t")))
  524. (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end))))
  525. (numeral . ,(rx (and (one-or-more (any "0-9#")) ".")))
  526. (bullet . ,(rx (any "*+:-")))
  527. (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".")
  528. (any "*+:-"))))
  529. (checkbox . ,(rx "[" (any " xX") "]")))
  530. "Markdown-specific sexps for `markdown-rx'")
  531. (defun markdown-rx-to-string (form &optional no-group)
  532. "Markdown mode specialized `rx-to-string' function.
  533. This variant supports named Markdown expressions in FORM.
  534. NO-GROUP non-nil means don't put shy groups around the result."
  535. (let ((rx-constituents (append markdown-rx-constituents rx-constituents)))
  536. (rx-to-string form no-group)))
  537. (defmacro markdown-rx (&rest regexps)
  538. "Markdown mode specialized rx macro.
  539. This variant of `rx' supports common Markdown named REGEXPS."
  540. (cond ((null regexps)
  541. (error "No regexp"))
  542. ((cdr regexps)
  543. (markdown-rx-to-string `(and ,@regexps) t))
  544. (t
  545. (markdown-rx-to-string (car regexps) t)))))
  546. ;;; Regular Expressions =======================================================
  547. (defconst markdown-regex-comment-start
  548. "<!--"
  549. "Regular expression matches HTML comment opening.")
  550. (defconst markdown-regex-comment-end
  551. "--[ \t]*>"
  552. "Regular expression matches HTML comment closing.")
  553. (defconst markdown-regex-link-inline
  554. "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)"
  555. "Regular expression for a [text](file) or an image link ![text](file).
  556. Group 1 matches the leading exclamation point (optional).
  557. Group 2 matches the opening square bracket.
  558. Group 3 matches the text inside the square brackets.
  559. Group 4 matches the closing square bracket.
  560. Group 5 matches the opening parenthesis.
  561. Group 6 matches the URL.
  562. Group 7 matches the title (optional).
  563. Group 8 matches the closing parenthesis.")
  564. (defconst markdown-regex-link-reference
  565. "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)"
  566. "Regular expression for a reference link [text][id].
  567. Group 1 matches the leading exclamation point (optional).
  568. Group 2 matches the opening square bracket for the link text.
  569. Group 3 matches the text inside the square brackets.
  570. Group 4 matches the closing square bracket for the link text.
  571. Group 5 matches the opening square bracket for the reference label.
  572. Group 6 matches the reference label.
  573. Group 7 matches the closing square bracket for the reference label.")
  574. (defconst markdown-regex-reference-definition
  575. "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)"
  576. "Regular expression for a reference definition.
  577. Group 1 matches the opening square bracket.
  578. Group 2 matches the reference label.
  579. Group 3 matches the closing square bracket.
  580. Group 4 matches the colon.
  581. Group 5 matches the URL.
  582. Group 6 matches the title attribute (optional).")
  583. (defconst markdown-regex-footnote
  584. "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)"
  585. "Regular expression for a footnote marker [^fn].
  586. Group 1 matches the opening square bracket and carat.
  587. Group 2 matches only the label, without the surrounding markup.
  588. Group 3 matches the closing square bracket.")
  589. (defconst markdown-regex-header
  590. "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$"
  591. "Regexp identifying Markdown headings.
  592. Group 1 matches the text of a setext heading.
  593. Group 2 matches the underline of a level-1 setext heading.
  594. Group 3 matches the underline of a level-2 setext heading.
  595. Group 4 matches the opening hash marks of an atx heading and whitespace.
  596. Group 5 matches the text, without surrounding whitespace, of an atx heading.
  597. Group 6 matches the closing whitespace and hash marks of an atx heading.")
  598. (defconst markdown-regex-header-setext
  599. "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
  600. "Regular expression for generic setext-style (underline) headers.")
  601. (defconst markdown-regex-header-atx
  602. "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
  603. "Regular expression for generic atx-style (hash mark) headers.")
  604. (defconst markdown-regex-hr
  605. (rx line-start
  606. (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* ")))
  607. (and (repeat 3 (and "-" (? " "))) (* (any "- ")))
  608. (and (repeat 3 (and "_" (? " "))) (* (any "_ ")))))
  609. line-end)
  610. "Regular expression for matching Markdown horizontal rules.")
  611. (defconst markdown-regex-code
  612. "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)"
  613. "Regular expression for matching inline code fragments.
  614. Group 1 matches the entire code fragment including the backquotes.
  615. Group 2 matches the opening backquotes.
  616. Group 3 matches the code fragment itself, without backquotes.
  617. Group 4 matches the closing backquotes.
  618. The leading, unnumbered group ensures that the leading backquote
  619. character is not escaped.
  620. The last group, also unnumbered, requires that the character
  621. following the code fragment is not a backquote.
  622. Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
  623. but not two newlines in a row.")
  624. (defconst markdown-regex-kbd
  625. "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)"
  626. "Regular expression for matching <kbd> tags.
  627. Groups 1 and 3 match the opening and closing tags.
  628. Group 2 matches the key sequence.")
  629. (defconst markdown-regex-gfm-code-block-open
  630. "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$"
  631. "Regular expression matching opening of GFM code blocks.
  632. Group 1 matches the opening three backquotes and any following whitespace.
  633. Group 2 matches the opening brace (optional) and surrounding whitespace.
  634. Group 3 matches the language identifier (optional).
  635. Group 4 matches the info string (optional).
  636. Group 5 matches the closing brace (optional), whitespace, and newline.
  637. Groups need to agree with `markdown-regex-tilde-fence-begin'.")
  638. (defconst markdown-regex-gfm-code-block-close
  639. "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$"
  640. "Regular expression matching closing of GFM code blocks.
  641. Group 1 matches the closing three backquotes.
  642. Group 2 matches any whitespace and the final newline.")
  643. (defconst markdown-regex-pre
  644. "^\\( \\|\t\\).*$"
  645. "Regular expression for matching preformatted text sections.")
  646. (defconst markdown-regex-list
  647. (markdown-rx line-start
  648. ;; 1. Leading whitespace
  649. (group (* blank))
  650. ;; 2. List marker: a numeral, bullet, or colon
  651. (group list-marker)
  652. ;; 3. Trailing whitespace
  653. (group (+ blank))
  654. ;; 4. Optional checkbox for GFM task list items
  655. (opt (group (and checkbox (* blank)))))
  656. "Regular expression for matching list items.")
  657. (defconst markdown-regex-bold
  658. "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)"
  659. "Regular expression for matching bold text.
  660. Group 1 matches the character before the opening asterisk or
  661. underscore, if any, ensuring that it is not a backslash escape.
  662. Group 2 matches the entire expression, including delimiters.
  663. Groups 3 and 5 matches the opening and closing delimiters.
  664. Group 4 matches the text inside the delimiters.")
  665. (defconst markdown-regex-italic
  666. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)"
  667. "Regular expression for matching italic text.
  668. The leading unnumbered matches the character before the opening
  669. asterisk or underscore, if any, ensuring that it is not a
  670. backslash escape.
  671. Group 1 matches the entire expression, including delimiters.
  672. Groups 2 and 4 matches the opening and closing delimiters.
  673. Group 3 matches the text inside the delimiters.")
  674. (defconst markdown-regex-strike-through
  675. "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)"
  676. "Regular expression for matching strike-through text.
  677. Group 1 matches the character before the opening tilde, if any,
  678. ensuring that it is not a backslash escape.
  679. Group 2 matches the entire expression, including delimiters.
  680. Groups 3 and 5 matches the opening and closing delimiters.
  681. Group 4 matches the text inside the delimiters.")
  682. (defconst markdown-regex-gfm-italic
  683. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)"
  684. "Regular expression for matching italic text in GitHub Flavored Markdown.
  685. Underscores in words are not treated as special.
  686. Group 1 matches the entire expression, including delimiters.
  687. Groups 2 and 4 matches the opening and closing delimiters.
  688. Group 3 matches the text inside the delimiters.")
  689. (defconst markdown-regex-blockquote
  690. "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$"
  691. "Regular expression for matching blockquote lines.
  692. Also accounts for a potential capital letter preceding the angle
  693. bracket, for use with Leanpub blocks (asides, warnings, info
  694. blocks, etc.).
  695. Group 1 matches the leading angle bracket.
  696. Group 2 matches the separating whitespace.
  697. Group 3 matches the text.")
  698. (defconst markdown-regex-line-break
  699. "[^ \n\t][ \t]*\\( \\)$"
  700. "Regular expression for matching line breaks.")
  701. (defconst markdown-regex-wiki-link
  702. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)"
  703. "Regular expression for matching wiki links.
  704. This matches typical bracketed [[WikiLinks]] as well as 'aliased'
  705. wiki links of the form [[PageName|link text]].
  706. The meanings of the first and second components depend
  707. on the value of `markdown-wiki-link-alias-first'.
  708. Group 1 matches the entire link.
  709. Group 2 matches the opening square brackets.
  710. Group 3 matches the first component of the wiki link.
  711. Group 4 matches the pipe separator, when present.
  712. Group 5 matches the second component of the wiki link, when present.
  713. Group 6 matches the closing square brackets.")
  714. (defconst markdown-regex-uri
  715. (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)")
  716. "Regular expression for matching inline URIs.")
  717. (defconst markdown-regex-angle-uri
  718. (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)")
  719. "Regular expression for matching inline URIs in angle brackets.")
  720. (defconst markdown-regex-email
  721. "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
  722. "Regular expression for matching inline email addresses.")
  723. (defsubst markdown-make-regex-link-generic ()
  724. "Make regular expression for matching any recognized link."
  725. (concat "\\(?:" markdown-regex-link-inline
  726. (when markdown-enable-wiki-links
  727. (concat "\\|" markdown-regex-wiki-link))
  728. "\\|" markdown-regex-link-reference
  729. "\\|" markdown-regex-angle-uri "\\)"))
  730. (defconst markdown-regex-gfm-checkbox
  731. " \\(\\[[ xX]\\]\\) "
  732. "Regular expression for matching GFM checkboxes.
  733. Group 1 matches the text to become a button.")
  734. (defconst markdown-regex-blank-line
  735. "^[[:blank:]]*$"
  736. "Regular expression that matches a blank line.")
  737. (defconst markdown-regex-block-separator
  738. "\n[\n\t\f ]*\n"
  739. "Regular expression for matching block boundaries.")
  740. (defconst markdown-regex-block-separator-noindent
  741. (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)")
  742. "Regexp for block separators before lines with no indentation.")
  743. (defconst markdown-regex-math-inline-single
  744. "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)"
  745. "Regular expression for itex $..$ math mode expressions.
  746. Groups 1 and 3 match the opening and closing dollar signs.
  747. Group 2 matches the mathematical expression contained within.")
  748. (defconst markdown-regex-math-inline-double
  749. "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)"
  750. "Regular expression for itex $$..$$ math mode expressions.
  751. Groups 1 and 3 match opening and closing dollar signs.
  752. Group 2 matches the mathematical expression contained within.")
  753. (defconst markdown-regex-math-display
  754. (rx line-start (* blank)
  755. (group (group (repeat 1 2 "\\")) "[")
  756. (group (*? anything))
  757. (group (backref 2) "]")
  758. line-end)
  759. "Regular expression for \[..\] or \\[..\\] display math.
  760. Groups 1 and 4 match the opening and closing markup.
  761. Group 3 matches the mathematical expression contained within.
  762. Group 2 matches the opening slashes, and is used internally to
  763. match the closing slashes.")
  764. (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line)
  765. "Return regexp matching a tilde code fence at least NUM-TILDES long.
  766. END-OF-LINE is the regexp construct to indicate end of line; $ if
  767. missing."
  768. (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)"
  769. (or end-of-line "$")))
  770. (defconst markdown-regex-tilde-fence-begin
  771. (markdown-make-tilde-fence-regex
  772. 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
  773. "Regular expression for matching tilde-fenced code blocks.
  774. Group 1 matches the opening tildes.
  775. Group 2 matches (optional) opening brace and surrounding whitespace.
  776. Group 3 matches the language identifier (optional).
  777. Group 4 matches the info string (optional).
  778. Group 5 matches the closing brace (optional) and any surrounding whitespace.
  779. Groups need to agree with `markdown-regex-gfm-code-block-open'.")
  780. (defconst markdown-regex-declarative-metadata
  781. "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
  782. "Regular expression for matching declarative metadata statements.
  783. This matches MultiMarkdown metadata as well as YAML and TOML
  784. assignments such as the following:
  785. variable: value
  786. or
  787. variable = value")
  788. (defconst markdown-regex-pandoc-metadata
  789. "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
  790. "Regular expression for matching Pandoc metadata.")
  791. (defconst markdown-regex-yaml-metadata-border
  792. "\\(-\\{3\\}\\)$"
  793. "Regular expression for matching YAML metadata.")
  794. (defconst markdown-regex-yaml-pandoc-metadata-end-border
  795. "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
  796. "Regular expression for matching YAML metadata end borders.")
  797. (defsubst markdown-get-yaml-metadata-start-border ()
  798. "Return YAML metadata start border depending upon whether Pandoc is used."
  799. (concat
  800. (if markdown-use-pandoc-style-yaml-metadata "^" "\\`")
  801. markdown-regex-yaml-metadata-border))
  802. (defsubst markdown-get-yaml-metadata-end-border (_)
  803. "Return YAML metadata end border depending upon whether Pandoc is used."
  804. (if markdown-use-pandoc-style-yaml-metadata
  805. markdown-regex-yaml-pandoc-metadata-end-border
  806. markdown-regex-yaml-metadata-border))
  807. (defconst markdown-regex-inline-attributes
  808. "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$"
  809. "Regular expression for matching inline identifiers or attribute lists.
  810. Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
  811. (defconst markdown-regex-leanpub-sections
  812. (concat
  813. "^\\({\\)\\("
  814. (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
  815. "\\)\\(}\\)[ \t]*\n")
  816. "Regular expression for Leanpub section markers and related syntax.")
  817. (defconst markdown-regex-sub-superscript
  818. "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[[:alnum:]]+\\)\\(?4:\\2\\)\\)"
  819. "The regular expression matching a sub- or superscript.
  820. The leading un-numbered group matches the character before the
  821. opening tilde or carat, if any, ensuring that it is not a
  822. backslash escape, carat, or tilde.
  823. Group 1 matches the entire expression, including markup.
  824. Group 2 matches the opening markup--a tilde or carat.
  825. Group 3 matches the text inside the delimiters.
  826. Group 4 matches the closing markup--a tilde or carat.")
  827. (defconst markdown-regex-include
  828. "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$"
  829. "Regular expression matching common forms of include syntax.
  830. Marked 2, Leanpub, and other processors support some of these forms:
  831. <<[sections/section1.md]
  832. <<(folder/filename)
  833. <<[Code title](folder/filename)
  834. <<{folder/raw_file.html}
  835. Group 1 matches the opening two angle brackets.
  836. Groups 2-4 match the opening square bracket, the text inside,
  837. and the closing square bracket, respectively.
  838. Groups 5-7 match the opening parenthesis, the text inside, and
  839. the closing parenthesis.
  840. Groups 8-10 match the opening brace, the text inside, and the brace.")
  841. (defconst markdown-regex-pandoc-inline-footnote
  842. "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)"
  843. "Regular expression for Pandoc inline footnote^[footnote text].
  844. Group 1 matches the opening caret.
  845. Group 2 matches the opening square bracket.
  846. Group 3 matches the footnote text, without the surrounding markup.
  847. Group 4 matches the closing square bracket.")
  848. (defconst markdown-regex-html-attr
  849. "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
  850. "Regular expression for matching HTML attributes and values.
  851. Group 1 matches the attribute name.
  852. Group 2 matches the following whitespace, equals sign, and value, if any.
  853. Group 3 matches the equals sign, if any.
  854. Group 4 matches single-, double-, or un-quoted attribute values.")
  855. (defconst markdown-regex-html-tag
  856. (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
  857. "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
  858. "Regular expression for matching HTML tags.
  859. Groups 1 and 9 match the beginning and ending angle brackets and slashes.
  860. Group 2 matches the tag name.
  861. Group 3 matches all attributes and whitespace following the tag name.")
  862. (defconst markdown-regex-html-entity
  863. "\\(&#?[[:alnum:]]+;\\)"
  864. "Regular expression for matching HTML entities.")
  865. ;;; Syntax ====================================================================
  866. (defvar markdown--syntax-properties
  867. (list 'markdown-tilde-fence-begin nil
  868. 'markdown-tilde-fence-end nil
  869. 'markdown-fenced-code nil
  870. 'markdown-yaml-metadata-begin nil
  871. 'markdown-yaml-metadata-end nil
  872. 'markdown-yaml-metadata-section nil
  873. 'markdown-gfm-block-begin nil
  874. 'markdown-gfm-block-end nil
  875. 'markdown-gfm-code nil
  876. 'markdown-list-item nil
  877. 'markdown-pre nil
  878. 'markdown-blockquote nil
  879. 'markdown-hr nil
  880. 'markdown-comment nil
  881. 'markdown-heading nil
  882. 'markdown-heading-1-setext nil
  883. 'markdown-heading-2-setext nil
  884. 'markdown-heading-1-atx nil
  885. 'markdown-heading-2-atx nil
  886. 'markdown-heading-3-atx nil
  887. 'markdown-heading-4-atx nil
  888. 'markdown-heading-5-atx nil
  889. 'markdown-heading-6-atx nil
  890. 'markdown-metadata-key nil
  891. 'markdown-metadata-value nil
  892. 'markdown-metadata-markup nil)
  893. "Property list of all Markdown syntactic properties.")
  894. (defsubst markdown-in-comment-p (&optional pos)
  895. "Return non-nil if POS is in a comment.
  896. If POS is not given, use point instead."
  897. (get-text-property (or pos (point)) 'markdown-comment))
  898. (defun markdown--face-p (pos faces)
  899. "Return non-nil if face of POS contain FACES."
  900. (let ((face-prop (get-text-property pos 'face)))
  901. (if (listp face-prop)
  902. (cl-loop for face in face-prop
  903. thereis (memq face faces))
  904. (memq face-prop faces))))
  905. (defun markdown-syntax-propertize-extend-region (start end)
  906. "Extend START to END region to include an entire block of text.
  907. This helps improve syntax analysis for block constructs.
  908. Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
  909. Function is called repeatedly until it returns nil. For details, see
  910. `syntax-propertize-extend-region-functions'."
  911. (save-match-data
  912. (save-excursion
  913. (let* ((new-start (progn (goto-char start)
  914. (skip-chars-forward "\n")
  915. (if (re-search-backward "\n\n" nil t)
  916. (min start (match-end 0))
  917. (point-min))))
  918. (new-end (progn (goto-char end)
  919. (skip-chars-backward "\n")
  920. (if (re-search-forward "\n\n" nil t)
  921. (max end (match-beginning 0))
  922. (point-max))))
  923. (code-match (markdown-code-block-at-pos new-start))
  924. (new-start (or (and code-match (cl-first code-match)) new-start))
  925. (code-match (and (< end (point-max)) (markdown-code-block-at-pos end)))
  926. (new-end (or (and code-match (cl-second code-match)) new-end)))
  927. (unless (and (eq new-start start) (eq new-end end))
  928. (cons new-start (min new-end (point-max))))))))
  929. (defun markdown-font-lock-extend-region-function (start end _)
  930. "Used in `jit-lock-after-change-extend-region-functions'.
  931. Delegates to `markdown-syntax-propertize-extend-region'. START
  932. and END are the previous region to refontify."
  933. (let ((res (markdown-syntax-propertize-extend-region start end)))
  934. (when res
  935. ;; syntax-propertize-function is not called when character at
  936. ;; (point-max) is deleted, but font-lock-extend-region-functions
  937. ;; are called. Force a syntax property update in that case.
  938. (when (= end (point-max))
  939. ;; This function is called in a buffer modification hook.
  940. ;; `markdown-syntax-propertize' doesn't save the match data,
  941. ;; so we have to do it here.
  942. (save-match-data
  943. (markdown-syntax-propertize (car res) (cdr res))))
  944. (setq jit-lock-start (car res)
  945. jit-lock-end (cdr res)))))
  946. (defun markdown--cur-list-item-bounds ()
  947. "Return a list describing the list item at point.
  948. Assumes that match data is set for `markdown-regex-list'. See the
  949. documentation for `markdown-cur-list-item-bounds' for the format of
  950. the returned list."
  951. (save-excursion
  952. (let* ((begin (match-beginning 0))
  953. (indent (length (match-string-no-properties 1)))
  954. (nonlist-indent (- (match-end 3) (match-beginning 0)))
  955. (marker (buffer-substring-no-properties
  956. (match-beginning 2) (match-end 3)))
  957. (checkbox (match-string-no-properties 4))
  958. (match (butlast (match-data t)))
  959. (end (markdown-cur-list-item-end nonlist-indent)))
  960. (list begin end indent nonlist-indent marker checkbox match))))
  961. (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds)
  962. "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
  963. Here, MARKER is a string representing the type of list and INDENT
  964. is an integer giving the indentation, in spaces, of the current
  965. block. CUR-BOUNDS is a list of the form returned by
  966. `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
  967. values for parent list items. When BOUNDS is nil, it means we are
  968. at baseline (not inside of a nested list)."
  969. (let ((prev-indent (or (cl-third (car bounds)) 0)))
  970. (cond
  971. ;; New list item at baseline.
  972. ((and marker (null bounds))
  973. (list cur-bounds))
  974. ;; List item with greater indentation (four or more spaces).
  975. ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
  976. ((and marker (>= indent (+ prev-indent markdown-list-indent-width)))
  977. (cons cur-bounds bounds))
  978. ;; List item with greater or equal indentation (less than four spaces).
  979. ;; Keep list level the same by replacing the car of BOUNDS.
  980. ((and marker (>= indent prev-indent))
  981. (cons cur-bounds (cdr bounds)))
  982. ;; Lesser indentation level.
  983. ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
  984. ;; indentation could move back more than one list level). Note
  985. ;; that this block need not be the beginning of list item.
  986. ((< indent prev-indent)
  987. (while (and (> (length bounds) 1)
  988. (setq prev-indent (cl-third (cadr bounds)))
  989. (< indent (+ prev-indent markdown-list-indent-width)))
  990. (setq bounds (cdr bounds)))
  991. (cons cur-bounds bounds))
  992. ;; Otherwise, do nothing.
  993. (t bounds))))
  994. (defun markdown-syntax-propertize-list-items (start end)
  995. "Propertize list items from START to END.
  996. Stores nested list item information in the `markdown-list-item'
  997. text property to make later syntax analysis easier. The value of
  998. this property is a list with elements of the form (begin . end)
  999. giving the bounds of the current and parent list items."
  1000. (save-excursion
  1001. (goto-char start)
  1002. (let ((prev-list-line -100)
  1003. bounds level pre-regexp)
  1004. ;; Find a baseline point with zero list indentation
  1005. (markdown-search-backward-baseline)
  1006. ;; Search for all list items between baseline and END
  1007. (while (and (< (point) end)
  1008. (re-search-forward markdown-regex-list end 'limit))
  1009. ;; Level of list nesting
  1010. (setq level (length bounds))
  1011. ;; Pre blocks need to be indented one level past the list level
  1012. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level)))
  1013. (beginning-of-line)
  1014. (cond
  1015. ;; Reset at headings, horizontal rules, and top-level blank lines.
  1016. ;; Propertize baseline when in range.
  1017. ((markdown-new-baseline)
  1018. (setq bounds nil))
  1019. ;; Make sure this is not a line from a pre block
  1020. ((and (looking-at-p pre-regexp)
  1021. ;; too indented line is also treated as list if previous line is list
  1022. (>= (- (line-number-at-pos) prev-list-line) 2)))
  1023. ;; If not, then update levels and propertize list item when in range.
  1024. (t
  1025. (let* ((indent (current-indentation))
  1026. (cur-bounds (markdown--cur-list-item-bounds))
  1027. (first (cl-first cur-bounds))
  1028. (last (cl-second cur-bounds))
  1029. (marker (cl-fifth cur-bounds)))
  1030. (setq bounds (markdown--append-list-item-bounds
  1031. marker indent cur-bounds bounds))
  1032. (when (and (<= start (point)) (<= (point) end))
  1033. (setq prev-list-line (line-number-at-pos first))
  1034. (put-text-property first last 'markdown-list-item bounds)))))
  1035. (end-of-line)))))
  1036. (defun markdown-syntax-propertize-pre-blocks (start end)
  1037. "Match preformatted text blocks from START to END."
  1038. (save-excursion
  1039. (goto-char start)
  1040. (let (finish)
  1041. ;; Use loop for avoiding too many recursive calls
  1042. ;; https://github.com/jrblevin/markdown-mode/issues/512
  1043. (while (not finish)
  1044. (let ((levels (markdown-calculate-list-levels))
  1045. indent pre-regexp close-regexp open close)
  1046. (while (and (< (point) end) (not close))
  1047. ;; Search for a region with sufficient indentation
  1048. (if (null levels)
  1049. (setq indent 1)
  1050. (setq indent (1+ (length levels))))
  1051. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent))
  1052. (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent)))
  1053. (cond
  1054. ;; If not at the beginning of a line, move forward
  1055. ((not (bolp)) (forward-line))
  1056. ;; Move past blank lines
  1057. ((markdown-cur-line-blank-p) (forward-line))
  1058. ;; At headers and horizontal rules, reset levels
  1059. ((markdown-new-baseline) (forward-line) (setq levels nil))
  1060. ;; If the current line has sufficient indentation, mark out pre block
  1061. ;; The opening should be preceded by a blank line.
  1062. ((and (markdown-prev-line-blank) (looking-at pre-regexp))
  1063. (setq open (match-beginning 0))
  1064. (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p))
  1065. (not (eobp)))
  1066. (forward-line))
  1067. (skip-syntax-backward "-")
  1068. (setq close (point)))
  1069. ;; If current line has a list marker, update levels, move to end of block
  1070. ((looking-at markdown-regex-list)
  1071. (setq levels (markdown-update-list-levels
  1072. (match-string 2) (current-indentation) levels))
  1073. (markdown-end-of-text-block))
  1074. ;; If this is the end of the indentation level, adjust levels accordingly.
  1075. ;; Only match end of indentation level if levels is not the empty list.
  1076. ((and (car levels) (looking-at-p close-regexp))
  1077. (setq levels (markdown-update-list-levels
  1078. nil (current-indentation) levels))
  1079. (markdown-end-of-text-block))
  1080. (t (markdown-end-of-text-block))))
  1081. (if (and open close)
  1082. ;; Set text property data and continue to search
  1083. (put-text-property open close 'markdown-pre (list open close))
  1084. (setq finish t))))
  1085. nil)))
  1086. (defconst markdown-fenced-block-pairs
  1087. `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin)
  1088. (markdown-make-tilde-fence-regex markdown-tilde-fence-end)
  1089. markdown-fenced-code)
  1090. ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin)
  1091. (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end)
  1092. markdown-yaml-metadata-section)
  1093. ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin)
  1094. (,markdown-regex-gfm-code-block-close markdown-gfm-block-end)
  1095. markdown-gfm-code))
  1096. "Mapping of regular expressions to \"fenced-block\" constructs.
  1097. These constructs are distinguished by having a distinctive start
  1098. and end pattern, both of which take up an entire line of text,
  1099. but no special pattern to identify text within the fenced
  1100. blocks (unlike blockquotes and indented-code sections).
  1101. Each element within this list takes the form:
  1102. ((START-REGEX-OR-FUN START-PROPERTY)
  1103. (END-REGEX-OR-FUN END-PROPERTY)
  1104. MIDDLE-PROPERTY)
  1105. Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
  1106. function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
  1107. arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
  1108. which is the length of the first group of the START-REGEX-OR-FUN match, which
  1109. can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
  1110. evaluate these into \"real\" regexps.
  1111. The *-PROPERTY elements are the text properties applied to each part of the
  1112. block construct when it is matched using
  1113. `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
  1114. to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
  1115. MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
  1116. `match-data' when the regexp was matched to the text. In the case of
  1117. MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with
  1118. begin and end set to the edges of the \"middle\" text. This makes fontification
  1119. easier.")
  1120. (defun markdown-text-property-at-point (prop)
  1121. (get-text-property (point) prop))
  1122. (defsubst markdown-maybe-funcall-regexp (object &optional arg)
  1123. (cond ((functionp object)
  1124. (if arg (funcall object arg) (funcall object)))
  1125. ((stringp object) object)
  1126. (t (error "Object cannot be turned into regex"))))
  1127. (defsubst markdown-get-start-fence-regexp ()
  1128. "Return regexp to find all \"start\" sections of fenced block constructs.
  1129. Which construct is actually contained in the match must be found separately."
  1130. (mapconcat
  1131. #'identity
  1132. (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry)))
  1133. markdown-fenced-block-pairs)
  1134. "\\|"))
  1135. (defun markdown-get-fenced-block-begin-properties ()
  1136. (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs))
  1137. (defun markdown-get-fenced-block-end-properties ()
  1138. (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs))
  1139. (defun markdown-get-fenced-block-middle-properties ()
  1140. (cl-mapcar #'cl-third markdown-fenced-block-pairs))
  1141. (defun markdown-find-previous-prop (prop &optional lim)
  1142. "Find previous place where property PROP is non-nil, up to LIM.
  1143. Return a cons of (pos . property). pos is point if point contains
  1144. non-nil PROP."
  1145. (let ((res
  1146. (if (get-text-property (point) prop) (point)
  1147. (previous-single-property-change
  1148. (point) prop nil (or lim (point-min))))))
  1149. (when (and (not (get-text-property res prop))
  1150. (> res (point-min))
  1151. (get-text-property (1- res) prop))
  1152. (cl-decf res))
  1153. (when (and res (get-text-property res prop)) (cons res prop))))
  1154. (defun markdown-find-next-prop (prop &optional lim)
  1155. "Find next place where property PROP is non-nil, up to LIM.
  1156. Return a cons of (POS . PROPERTY) where POS is point if point
  1157. contains non-nil PROP."
  1158. (let ((res
  1159. (if (get-text-property (point) prop) (point)
  1160. (next-single-property-change
  1161. (point) prop nil (or lim (point-max))))))
  1162. (when (and res (get-text-property res prop)) (cons res prop))))
  1163. (defun markdown-min-of-seq (map-fn seq)
  1164. "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
  1165. (cl-loop for el in seq
  1166. with min = 1.0e+INF ; infinity
  1167. with min-el = nil
  1168. do (let ((res (funcall map-fn el)))
  1169. (when (< res min)
  1170. (setq min res)
  1171. (setq min-el el)))
  1172. finally return min-el))
  1173. (defun markdown-max-of-seq (map-fn seq)
  1174. "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
  1175. (cl-loop for el in seq
  1176. with max = -1.0e+INF ; negative infinity
  1177. with max-el = nil
  1178. do (let ((res (funcall map-fn el)))
  1179. (when (and res (> res max))
  1180. (setq max res)
  1181. (setq max-el el)))
  1182. finally return max-el))
  1183. (defun markdown-find-previous-block ()
  1184. "Find previous block.
  1185. Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
  1186. unable to propertize the entire block, but was able to propertize the beginning
  1187. of the block. If so, return a cons of (pos . property) where the beginning of
  1188. the block was propertized."
  1189. (let ((start-pt (point))
  1190. (closest-open
  1191. (markdown-max-of-seq
  1192. #'car
  1193. (cl-remove-if
  1194. #'null
  1195. (cl-mapcar
  1196. #'markdown-find-previous-prop
  1197. (markdown-get-fenced-block-begin-properties))))))
  1198. (when closest-open
  1199. (let* ((length-of-open-match
  1200. (let ((match-d
  1201. (get-text-property (car closest-open) (cdr closest-open))))
  1202. (- (cl-fourth match-d) (cl-third match-d))))
  1203. (end-regexp
  1204. (markdown-maybe-funcall-regexp
  1205. (cl-caadr
  1206. (cl-find-if
  1207. (lambda (entry) (eq (cl-cadar entry) (cdr closest-open)))
  1208. markdown-fenced-block-pairs))
  1209. length-of-open-match))
  1210. (end-prop-loc
  1211. (save-excursion
  1212. (save-match-data
  1213. (goto-char (car closest-open))
  1214. (and (re-search-forward end-regexp start-pt t)
  1215. (match-beginning 0))))))
  1216. (and (not end-prop-loc) closest-open)))))
  1217. (defun markdown-get-fenced-block-from-start (prop)
  1218. "Return limits of an enclosing fenced block from its start, using PROP.
  1219. Return value is a list usable as `match-data'."
  1220. (catch 'no-rest-of-block
  1221. (let* ((correct-entry
  1222. (cl-find-if
  1223. (lambda (entry) (eq (cl-cadar entry) prop))
  1224. markdown-fenced-block-pairs))
  1225. (begin-of-begin (cl-first (markdown-text-property-at-point prop)))
  1226. (middle-prop (cl-third correct-entry))
  1227. (end-prop (cl-cadadr correct-entry))
  1228. (end-of-end
  1229. (save-excursion
  1230. (goto-char (match-end 0)) ; end of begin
  1231. (unless (eobp) (forward-char))
  1232. (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
  1233. (if (not mid-prop-v) ; no middle
  1234. (progn
  1235. ;; try to find end by advancing one
  1236. (let ((end-prop-v
  1237. (markdown-text-property-at-point end-prop)))
  1238. (if end-prop-v (cl-second end-prop-v)
  1239. (throw 'no-rest-of-block nil))))
  1240. (set-match-data mid-prop-v)
  1241. (goto-char (match-end 0)) ; end of middle
  1242. (beginning-of-line) ; into end
  1243. (cl-second (markdown-text-property-at-point end-prop)))))))
  1244. (list begin-of-begin end-of-end))))
  1245. (defun markdown-get-fenced-block-from-middle (prop)
  1246. "Return limits of an enclosing fenced block from its middle, using PROP.
  1247. Return value is a list usable as `match-data'."
  1248. (let* ((correct-entry
  1249. (cl-find-if
  1250. (lambda (entry) (eq (cl-third entry) prop))
  1251. markdown-fenced-block-pairs))
  1252. (begin-prop (cl-cadar correct-entry))
  1253. (begin-of-begin
  1254. (save-excursion
  1255. (goto-char (match-beginning 0))
  1256. (unless (bobp) (forward-line -1))
  1257. (beginning-of-line)
  1258. (cl-first (markdown-text-property-at-point begin-prop))))
  1259. (end-prop (cl-cadadr correct-entry))
  1260. (end-of-end
  1261. (save-excursion
  1262. (goto-char (match-end 0))
  1263. (beginning-of-line)
  1264. (cl-second (markdown-text-property-at-point end-prop)))))
  1265. (list begin-of-begin end-of-end)))
  1266. (defun markdown-get-fenced-block-from-end (prop)
  1267. "Return limits of an enclosing fenced block from its end, using PROP.
  1268. Return value is a list usable as `match-data'."
  1269. (let* ((correct-entry
  1270. (cl-find-if
  1271. (lambda (entry) (eq (cl-cadadr entry) prop))
  1272. markdown-fenced-block-pairs))
  1273. (end-of-end (cl-second (markdown-text-property-at-point prop)))
  1274. (middle-prop (cl-third correct-entry))
  1275. (begin-prop (cl-cadar correct-entry))
  1276. (begin-of-begin
  1277. (save-excursion
  1278. (goto-char (match-beginning 0)) ; beginning of end
  1279. (unless (bobp) (backward-char)) ; into middle
  1280. (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
  1281. (if (not mid-prop-v)
  1282. (progn
  1283. (beginning-of-line)
  1284. (cl-first (markdown-text-property-at-point begin-prop)))
  1285. (set-match-data mid-prop-v)
  1286. (goto-char (match-beginning 0)) ; beginning of middle
  1287. (unless (bobp) (forward-line -1)) ; into beginning
  1288. (beginning-of-line)
  1289. (cl-first (markdown-text-property-at-point begin-prop)))))))
  1290. (list begin-of-begin end-of-end)))
  1291. (defun markdown-get-enclosing-fenced-block-construct (&optional pos)
  1292. "Get \"fake\" match data for block enclosing POS.
  1293. Returns fake match data which encloses the start, middle, and end
  1294. of the block construct enclosing POS, if it exists. Used in
  1295. `markdown-code-block-at-pos'."
  1296. (save-excursion
  1297. (when pos (goto-char pos))
  1298. (beginning-of-line)
  1299. (car
  1300. (cl-remove-if
  1301. #'null
  1302. (cl-mapcar
  1303. (lambda (fun-and-prop)
  1304. (cl-destructuring-bind (fun prop) fun-and-prop
  1305. (when prop
  1306. (save-match-data
  1307. (set-match-data (markdown-text-property-at-point prop))
  1308. (funcall fun prop)))))
  1309. `((markdown-get-fenced-block-from-start
  1310. ,(cl-find-if
  1311. #'markdown-text-property-at-point
  1312. (markdown-get-fenced-block-begin-properties)))
  1313. (markdown-get-fenced-block-from-middle
  1314. ,(cl-find-if
  1315. #'markdown-text-property-at-point
  1316. (markdown-get-fenced-block-middle-properties)))
  1317. (markdown-get-fenced-block-from-end
  1318. ,(cl-find-if
  1319. #'markdown-text-property-at-point
  1320. (markdown-get-fenced-block-end-properties)))))))))
  1321. (defun markdown-propertize-end-match (reg end fence-spec middle-begin)
  1322. "Get match for REG up to END, if exists, and propertize appropriately.
  1323. FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
  1324. MIDDLE-BEGIN is the start of the \"middle\" section of the block."
  1325. (when (re-search-forward reg end t)
  1326. (let ((close-begin (match-beginning 0)) ; Start of closing line.
  1327. (close-end (match-end 0)) ; End of closing line.
  1328. (close-data (match-data t))) ; Match data for closing line.
  1329. ;; Propertize middle section of fenced block.
  1330. (put-text-property middle-begin close-begin
  1331. (cl-third fence-spec)
  1332. (list middle-begin close-begin))
  1333. ;; If the block is a YAML block, propertize the declarations inside
  1334. (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)
  1335. ;; Propertize closing line of fenced block.
  1336. (put-text-property close-begin close-end
  1337. (cl-cadadr fence-spec) close-data))))
  1338. (defun markdown-syntax-propertize-fenced-block-constructs (start end)
  1339. "Propertize according to `markdown-fenced-block-pairs' from START to END.
  1340. If unable to propertize an entire block (if the start of a block is within START
  1341. and END, but the end of the block is not), propertize the start section of a
  1342. block, then in a subsequent call propertize both middle and end by finding the
  1343. start which was previously propertized."
  1344. (let ((start-reg (markdown-get-start-fence-regexp)))
  1345. (save-excursion
  1346. (goto-char start)
  1347. ;; start from previous unclosed block, if exists
  1348. (let ((prev-begin-block (markdown-find-previous-block)))
  1349. (when prev-begin-block
  1350. (let* ((correct-entry
  1351. (cl-find-if (lambda (entry)
  1352. (eq (cdr prev-begin-block) (cl-cadar entry)))
  1353. markdown-fenced-block-pairs))
  1354. (enclosed-text-start (1+ (car prev-begin-block)))
  1355. (start-length
  1356. (save-excursion
  1357. (goto-char (car prev-begin-block))
  1358. (string-match
  1359. (markdown-maybe-funcall-regexp
  1360. (caar correct-entry))
  1361. (buffer-substring
  1362. (point-at-bol) (point-at-eol)))
  1363. (- (match-end 1) (match-beginning 1))))
  1364. (end-reg (markdown-maybe-funcall-regexp
  1365. (cl-caadr correct-entry) start-length)))
  1366. (markdown-propertize-end-match
  1367. end-reg end correct-entry enclosed-text-start))))
  1368. ;; find all new blocks within region
  1369. (while (re-search-forward start-reg end t)
  1370. ;; we assume the opening constructs take up (only) an entire line,
  1371. ;; so we re-check the current line
  1372. (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol)))
  1373. ;; find entry in `markdown-fenced-block-pairs' corresponding
  1374. ;; to regex which was matched
  1375. (correct-entry
  1376. (cl-find-if
  1377. (lambda (fenced-pair)
  1378. (string-match-p
  1379. (markdown-maybe-funcall-regexp (caar fenced-pair))
  1380. cur-line))
  1381. markdown-fenced-block-pairs))
  1382. (enclosed-text-start
  1383. (save-excursion (1+ (point-at-eol))))
  1384. (end-reg
  1385. (markdown-maybe-funcall-regexp
  1386. (cl-caadr correct-entry)
  1387. (if (and (match-beginning 1) (match-end 1))
  1388. (- (match-end 1) (match-beginning 1))
  1389. 0))))
  1390. ;; get correct match data
  1391. (save-excursion
  1392. (beginning-of-line)
  1393. (re-search-forward
  1394. (markdown-maybe-funcall-regexp (caar correct-entry))
  1395. (point-at-eol)))
  1396. ;; mark starting, even if ending is outside of region
  1397. (put-text-property (match-beginning 0) (match-end 0)
  1398. (cl-cadar correct-entry) (match-data t))
  1399. (markdown-propertize-end-match
  1400. end-reg end correct-entry enclosed-text-start))))))
  1401. (defun markdown-syntax-propertize-blockquotes (start end)
  1402. "Match blockquotes from START to END."
  1403. (save-excursion
  1404. (goto-char start)
  1405. (while (and (re-search-forward markdown-regex-blockquote end t)
  1406. (not (markdown-code-block-at-pos (match-beginning 0))))
  1407. (put-text-property (match-beginning 0) (match-end 0)
  1408. 'markdown-blockquote
  1409. (match-data t)))))
  1410. (defun markdown-syntax-propertize-hrs (start end)
  1411. "Match horizontal rules from START to END."
  1412. (save-excursion
  1413. (goto-char start)
  1414. (while (re-search-forward markdown-regex-hr end t)
  1415. (let ((beg (match-beginning 0))
  1416. (end (match-end 0)))
  1417. (goto-char beg)
  1418. (unless (or (markdown-on-heading-p)
  1419. (markdown-code-block-at-point-p))
  1420. (put-text-property beg end 'markdown-hr (match-data t)))
  1421. (goto-char end)))))
  1422. (defun markdown-syntax-propertize-yaml-metadata (start end)
  1423. "Propertize elements inside YAML metadata blocks from START to END.
  1424. Assumes region from START and END is already known to be the interior
  1425. region of a YAML metadata block as propertized by
  1426. `markdown-syntax-propertize-fenced-block-constructs'."
  1427. (save-excursion
  1428. (goto-char start)
  1429. (cl-loop
  1430. while (re-search-forward markdown-regex-declarative-metadata end t)
  1431. do (progn
  1432. (put-text-property (match-beginning 1) (match-end 1)
  1433. 'markdown-metadata-key (match-data t))
  1434. (put-text-property (match-beginning 2) (match-end 2)
  1435. 'markdown-metadata-markup (match-data t))
  1436. (put-text-property (match-beginning 3) (match-end 3)
  1437. 'markdown-metadata-value (match-data t))))))
  1438. (defun markdown-syntax-propertize-headings (start end)
  1439. "Match headings of type SYMBOL with REGEX from START to END."
  1440. (goto-char start)
  1441. (while (re-search-forward markdown-regex-header end t)
  1442. (unless (markdown-code-block-at-pos (match-beginning 0))
  1443. (put-text-property
  1444. (match-beginning 0) (match-end 0) 'markdown-heading
  1445. (match-data t))
  1446. (put-text-property
  1447. (match-beginning 0) (match-end 0)
  1448. (cond ((match-string-no-properties 2) 'markdown-heading-1-setext)
  1449. ((match-string-no-properties 3) 'markdown-heading-2-setext)
  1450. (t (let ((atx-level (length (markdown-trim-whitespace
  1451. (match-string-no-properties 4)))))
  1452. (intern (format "markdown-heading-%d-atx" atx-level)))))
  1453. (match-data t)))))
  1454. (defun markdown-syntax-propertize-comments (start end)
  1455. "Match HTML comments from the START to END."
  1456. ;; Implement by loop instead of recursive call for avoiding
  1457. ;; exceed max-lisp-eval-depth issue
  1458. ;; https://github.com/jrblevin/markdown-mode/issues/536
  1459. (let (finish)
  1460. (goto-char start)
  1461. (while (not finish)
  1462. (let* ((in-comment (nth 4 (syntax-ppss)))
  1463. (comment-begin (nth 8 (syntax-ppss))))
  1464. (cond
  1465. ;; Comment start
  1466. ((and (not in-comment)
  1467. (re-search-forward markdown-regex-comment-start end t)
  1468. (not (markdown-inline-code-at-point-p))
  1469. (not (markdown-code-block-at-point-p)))
  1470. (let ((open-beg (match-beginning 0)))
  1471. (put-text-property open-beg (1+ open-beg)
  1472. 'syntax-table (string-to-syntax "<"))
  1473. (goto-char (min (1+ (match-end 0)) end (point-max)))))
  1474. ;; Comment end
  1475. ((and in-comment comment-begin
  1476. (re-search-forward markdown-regex-comment-end end t))
  1477. (let ((comment-end (match-end 0)))
  1478. (put-text-property (1- comment-end) comment-end
  1479. 'syntax-table (string-to-syntax ">"))
  1480. ;; Remove any other text properties inside the comment
  1481. (remove-text-properties comment-begin comment-end
  1482. markdown--syntax-properties)
  1483. (put-text-property comment-begin comment-end
  1484. 'markdown-comment (list comment-begin comment-end))
  1485. (goto-char (min comment-end end (point-max)))))
  1486. ;; Nothing found
  1487. (t (setq finish t)))))
  1488. nil))
  1489. (defun markdown-syntax-propertize (start end)
  1490. "Function used as `syntax-propertize-function'.
  1491. START and END delimit region to propertize."
  1492. (with-silent-modifications
  1493. (save-excursion
  1494. (remove-text-properties start end markdown--syntax-properties)
  1495. (markdown-syntax-propertize-fenced-block-constructs start end)
  1496. (markdown-syntax-propertize-list-items start end)
  1497. (markdown-syntax-propertize-pre-blocks start end)
  1498. (markdown-syntax-propertize-blockquotes start end)
  1499. (markdown-syntax-propertize-headings start end)
  1500. (markdown-syntax-propertize-hrs start end)
  1501. (markdown-syntax-propertize-comments start end))))
  1502. ;;; Markup Hiding =============================================================
  1503. (defconst markdown-markup-properties
  1504. '(face markdown-markup-face invisible markdown-markup)
  1505. "List of properties and values to apply to markup.")
  1506. (defconst markdown-language-keyword-properties
  1507. '(face markdown-language-keyword-face invisible markdown-markup)
  1508. "List of properties and values to apply to code block language names.")
  1509. (defconst markdown-language-info-properties
  1510. '(face markdown-language-info-face invisible markdown-markup)
  1511. "List of properties and values to apply to code block language info strings.")
  1512. (defconst markdown-include-title-properties
  1513. '(face markdown-link-title-face invisible markdown-markup)
  1514. "List of properties and values to apply to included code titles.")
  1515. (defcustom markdown-hide-markup nil
  1516. "Determines whether markup in the buffer will be hidden.
  1517. When set to nil, all markup is displayed in the buffer as it
  1518. appears in the file. An exception is when `markdown-hide-urls'
  1519. is non-nil.
  1520. Set this to a non-nil value to turn this feature on by default.
  1521. You can interactively toggle the value of this variable with
  1522. `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
  1523. or from the Markdown > Show & Hide menu.
  1524. Markup hiding works by adding text properties to positions in the
  1525. buffer---either the `invisible' property or the `display' property
  1526. in cases where alternative glyphs are used (e.g., list bullets).
  1527. This does not, however, affect printing or other output.
  1528. Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
  1529. not honor these text properties. For printing, it would be better
  1530. to first convert to HTML or PDF (e.g,. using Pandoc)."
  1531. :group 'markdown
  1532. :type 'boolean
  1533. :safe 'booleanp
  1534. :package-version '(markdown-mode . "2.3"))
  1535. (make-variable-buffer-local 'markdown-hide-markup)
  1536. (defun markdown-toggle-markup-hiding (&optional arg)
  1537. "Toggle the display or hiding of markup.
  1538. With a prefix argument ARG, enable markup hiding if ARG is positive,
  1539. and disable it otherwise.
  1540. See `markdown-hide-markup' for additional details."
  1541. (interactive (list (or current-prefix-arg 'toggle)))
  1542. (setq markdown-hide-markup
  1543. (if (eq arg 'toggle)
  1544. (not markdown-hide-markup)
  1545. (> (prefix-numeric-value arg) 0)))
  1546. (if markdown-hide-markup
  1547. (progn (add-to-invisibility-spec 'markdown-markup)
  1548. (message "markdown-mode markup hiding enabled"))
  1549. (progn (remove-from-invisibility-spec 'markdown-markup)
  1550. (message "markdown-mode markup hiding disabled")))
  1551. (markdown-reload-extensions))
  1552. ;;; Font Lock =================================================================
  1553. (require 'font-lock)
  1554. (defgroup markdown-faces nil
  1555. "Faces used in Markdown Mode"
  1556. :group 'markdown
  1557. :group 'faces)
  1558. (defface markdown-italic-face
  1559. '((t (:inherit italic)))
  1560. "Face for italic text."
  1561. :group 'markdown-faces)
  1562. (defface markdown-bold-face
  1563. '((t (:inherit bold)))
  1564. "Face for bold text."
  1565. :group 'markdown-faces)
  1566. (defface markdown-strike-through-face
  1567. '((t (:strike-through t)))
  1568. "Face for strike-through text."
  1569. :group 'markdown-faces)
  1570. (defface markdown-markup-face
  1571. '((t (:inherit shadow :slant normal :weight normal)))
  1572. "Face for markup elements."
  1573. :group 'markdown-faces)
  1574. (defface markdown-header-rule-face
  1575. '((t (:inherit markdown-markup-face)))
  1576. "Base face for headers rules."
  1577. :group 'markdown-faces)
  1578. (defface markdown-header-delimiter-face
  1579. '((t (:inherit markdown-markup-face)))
  1580. "Base face for headers hash delimiter."
  1581. :group 'markdown-faces)
  1582. (defface markdown-list-face
  1583. '((t (:inherit markdown-markup-face)))
  1584. "Face for list item markers."
  1585. :group 'markdown-faces)
  1586. (defface markdown-blockquote-face
  1587. '((t (:inherit font-lock-doc-face)))
  1588. "Face for blockquote sections."
  1589. :group 'markdown-faces)
  1590. (defface markdown-code-face
  1591. '((t (:inherit fixed-pitch)))
  1592. "Face for inline code, pre blocks, and fenced code blocks.
  1593. This may be used, for example, to add a contrasting background to
  1594. inline code fragments and code blocks."
  1595. :group 'markdown-faces)
  1596. (defface markdown-inline-code-face
  1597. '((t (:inherit (markdown-code-face font-lock-constant-face))))
  1598. "Face for inline code."
  1599. :group 'markdown-faces)
  1600. (defface markdown-pre-face
  1601. '((t (:inherit (markdown-code-face font-lock-constant-face))))
  1602. "Face for preformatted text."
  1603. :group 'markdown-faces)
  1604. (defface markdown-table-face
  1605. '((t (:inherit (markdown-code-face))))
  1606. "Face for tables."
  1607. :group 'markdown-faces)
  1608. (defface markdown-language-keyword-face
  1609. '((t (:inherit font-lock-type-face)))
  1610. "Face for programming language identifiers."
  1611. :group 'markdown-faces)
  1612. (defface markdown-language-info-face
  1613. '((t (:inherit font-lock-string-face)))
  1614. "Face for programming language info strings."
  1615. :group 'markdown-faces)
  1616. (defface markdown-link-face
  1617. '((t (:inherit link)))
  1618. "Face for links."
  1619. :group 'markdown-faces)
  1620. (defface markdown-missing-link-face
  1621. '((t (:inherit font-lock-warning-face)))
  1622. "Face for missing links."
  1623. :group 'markdown-faces)
  1624. (defface markdown-reference-face
  1625. '((t (:inherit markdown-markup-face)))
  1626. "Face for link references."
  1627. :group 'markdown-faces)
  1628. (defface markdown-footnote-marker-face
  1629. '((t (:inherit markdown-markup-face)))
  1630. "Face for footnote markers."
  1631. :group 'markdown-faces)
  1632. (defface markdown-footnote-text-face
  1633. '((t (:inherit font-lock-comment-face)))
  1634. "Face for footnote text."
  1635. :group 'markdown-faces)
  1636. (defface markdown-url-face
  1637. '((t (:inherit font-lock-string-face)))
  1638. "Face for URLs that are part of markup.
  1639. For example, this applies to URLs in inline links:
  1640. [link text](http://example.com/)."
  1641. :group 'markdown-faces)
  1642. (defface markdown-plain-url-face
  1643. '((t (:inherit markdown-link-face)))
  1644. "Face for URLs that are also links.
  1645. For example, this applies to plain angle bracket URLs:
  1646. <http://example.com/>."
  1647. :group 'markdown-faces)
  1648. (defface markdown-link-title-face
  1649. '((t (:inherit font-lock-comment-face)))
  1650. "Face for reference link titles."
  1651. :group 'markdown-faces)
  1652. (defface markdown-line-break-face
  1653. '((t (:inherit font-lock-constant-face :underline t)))
  1654. "Face for hard line breaks."
  1655. :group 'markdown-faces)
  1656. (defface markdown-comment-face
  1657. '((t (:inherit font-lock-comment-face)))
  1658. "Face for HTML comments."
  1659. :group 'markdown-faces)
  1660. (defface markdown-math-face
  1661. '((t (:inherit font-lock-string-face)))
  1662. "Face for LaTeX expressions."
  1663. :group 'markdown-faces)
  1664. (defface markdown-metadata-key-face
  1665. '((t (:inherit font-lock-variable-name-face)))
  1666. "Face for metadata keys."
  1667. :group 'markdown-faces)
  1668. (defface markdown-metadata-value-face
  1669. '((t (:inherit font-lock-string-face)))
  1670. "Face for metadata values."
  1671. :group 'markdown-faces)
  1672. (defface markdown-gfm-checkbox-face
  1673. '((t (:inherit font-lock-builtin-face)))
  1674. "Face for GFM checkboxes."
  1675. :group 'markdown-faces)
  1676. (defface markdown-highlight-face
  1677. '((t (:inherit highlight)))
  1678. "Face for mouse highlighting."
  1679. :group 'markdown-faces)
  1680. (defface markdown-hr-face
  1681. '((t (:inherit markdown-markup-face)))
  1682. "Face for horizontal rules."
  1683. :group 'markdown-faces)
  1684. (defface markdown-html-tag-name-face
  1685. '((t (:inherit font-lock-type-face)))
  1686. "Face for HTML tag names."
  1687. :group 'markdown-faces)
  1688. (defface markdown-html-tag-delimiter-face
  1689. '((t (:inherit markdown-markup-face)))
  1690. "Face for HTML tag delimiters."
  1691. :group 'markdown-faces)
  1692. (defface markdown-html-attr-name-face
  1693. '((t (:inherit font-lock-variable-name-face)))
  1694. "Face for HTML attribute names."
  1695. :group 'markdown-faces)
  1696. (defface markdown-html-attr-value-face
  1697. '((t (:inherit font-lock-string-face)))
  1698. "Face for HTML attribute values."
  1699. :group 'markdown-faces)
  1700. (defface markdown-html-entity-face
  1701. '((t (:inherit font-lock-variable-name-face)))
  1702. "Face for HTML entities."
  1703. :group 'markdown-faces)
  1704. (defcustom markdown-header-scaling nil
  1705. "Whether to use variable-height faces for headers.
  1706. When non-nil, `markdown-header-face' will inherit from
  1707. `variable-pitch' and the scaling values in
  1708. `markdown-header-scaling-values' will be applied to
  1709. headers of levels one through six respectively."
  1710. :type 'boolean
  1711. :initialize 'custom-initialize-default
  1712. :set (lambda (symbol value)
  1713. (set-default symbol value)
  1714. (markdown-update-header-faces value))
  1715. :group 'markdown-faces
  1716. :package-version '(markdown-mode . "2.2"))
  1717. (defcustom markdown-header-scaling-values
  1718. '(2.0 1.7 1.4 1.1 1.0 1.0)
  1719. "List of scaling values for headers of level one through six.
  1720. Used when `markdown-header-scaling' is non-nil."
  1721. :type 'list
  1722. :initialize 'custom-initialize-default
  1723. :set (lambda (symbol value)
  1724. (set-default symbol value)
  1725. (markdown-update-header-faces markdown-header-scaling value))
  1726. :group 'markdown-faces)
  1727. (defun markdown-make-header-faces ()
  1728. "Build the faces used for Markdown headers."
  1729. (let ((inherit-faces '(font-lock-function-name-face)))
  1730. (when markdown-header-scaling
  1731. (setq inherit-faces (cons 'variable-pitch inherit-faces)))
  1732. (defface markdown-header-face
  1733. `((t (:inherit ,inherit-faces :weight bold)))
  1734. "Base face for headers."
  1735. :group 'markdown-faces))
  1736. (dotimes (num 6)
  1737. (let* ((num1 (1+ num))
  1738. (face-name (intern (format "markdown-header-face-%s" num1)))
  1739. (scale (if markdown-header-scaling
  1740. (float (nth num markdown-header-scaling-values))
  1741. 1.0)))
  1742. (eval
  1743. `(defface ,face-name
  1744. '((t (:inherit markdown-header-face :height ,scale)))
  1745. (format "Face for level %s headers.
  1746. You probably don't want to customize this face directly. Instead
  1747. you can customize the base face `markdown-header-face' or the
  1748. variable-height variable `markdown-header-scaling'." ,num1)
  1749. :group 'markdown-faces)))))
  1750. (markdown-make-header-faces)
  1751. (defun markdown-update-header-faces (&optional scaling scaling-values)
  1752. "Update header faces, depending on if header SCALING is desired.
  1753. If so, use given list of SCALING-VALUES relative to the baseline
  1754. size of `markdown-header-face'."
  1755. (dotimes (num 6)
  1756. (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num))))
  1757. (scale (cond ((not scaling) 1.0)
  1758. (scaling-values (float (nth num scaling-values)))
  1759. (t (float (nth num markdown-header-scaling-values))))))
  1760. (unless (get face-name 'saved-face) ; Don't update customized faces
  1761. (set-face-attribute face-name nil :height scale)))))
  1762. (defun markdown-syntactic-face (state)
  1763. "Return font-lock face for characters with given STATE.
  1764. See `font-lock-syntactic-face-function' for details."
  1765. (let ((in-comment (nth 4 state)))
  1766. (cond
  1767. (in-comment 'markdown-comment-face)
  1768. (t nil))))
  1769. (defcustom markdown-list-item-bullets
  1770. '("" "" "" "" "" "" "")
  1771. "List of bullets to use for unordered lists.
  1772. It can contain any number of symbols, which will be repeated.
  1773. Depending on your font, some reasonable choices are:
  1774. ."
  1775. :group 'markdown
  1776. :type '(repeat (string :tag "Bullet character"))
  1777. :package-version '(markdown-mode . "2.3"))
  1778. (defun markdown--footnote-marker-properties ()
  1779. "Return a font-lock facespec expression for footnote marker text."
  1780. `(face markdown-footnote-marker-face
  1781. ,@(when markdown-hide-markup
  1782. `(display ,markdown-footnote-display))))
  1783. (defun markdown--pandoc-inline-footnote-properties ()
  1784. "Return a font-lock facespec expression for Pandoc inline footnote text."
  1785. `(face markdown-footnote-text-face
  1786. ,@(when markdown-hide-markup
  1787. `(display ,markdown-footnote-display))))
  1788. (defvar markdown-mode-font-lock-keywords
  1789. `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face)))
  1790. (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face)))
  1791. (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face)
  1792. (2 'markdown-markup-face)
  1793. (3 'markdown-metadata-value-face)))
  1794. (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties)
  1795. (2 markdown-markup-properties nil t)
  1796. (3 markdown-language-keyword-properties nil t)
  1797. (4 markdown-language-info-properties nil t)
  1798. (5 markdown-markup-properties nil t)))
  1799. (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties)))
  1800. (markdown-fontify-gfm-code-blocks)
  1801. (markdown-fontify-tables)
  1802. (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties)
  1803. (2 markdown-markup-properties nil t)
  1804. (3 markdown-language-keyword-properties nil t)
  1805. (4 markdown-language-info-properties nil t)
  1806. (5 markdown-markup-properties nil t)))
  1807. (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties)))
  1808. (markdown-fontify-fenced-code-blocks)
  1809. (markdown-match-pre-blocks . ((0 'markdown-pre-face)))
  1810. (markdown-fontify-headings)
  1811. (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face)
  1812. (2 'markdown-markup-face)
  1813. (3 'markdown-metadata-value-face)))
  1814. (markdown-match-pandoc-metadata . ((1 'markdown-markup-face)
  1815. (2 'markdown-markup-face)
  1816. (3 'markdown-metadata-value-face)))
  1817. (markdown-fontify-hrs)
  1818. (markdown-match-code . ((1 markdown-markup-properties prepend)
  1819. (2 'markdown-inline-code-face prepend)
  1820. (3 markdown-markup-properties prepend)))
  1821. (,markdown-regex-kbd . ((1 markdown-markup-properties)
  1822. (2 'markdown-inline-code-face)
  1823. (3 markdown-markup-properties)))
  1824. (markdown-fontify-angle-uris)
  1825. (,markdown-regex-email . 'markdown-plain-url-face)
  1826. (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t)
  1827. (2 'markdown-html-tag-name-face t)
  1828. (3 'markdown-html-tag-delimiter-face t)
  1829. ;; Anchored matcher for HTML tag attributes
  1830. (,markdown-regex-html-attr
  1831. ;; Before searching, move past tag
  1832. ;; name; set limit at tag close.
  1833. (progn
  1834. (goto-char (match-end 2)) (match-end 3))
  1835. nil
  1836. . ((1 'markdown-html-attr-name-face)
  1837. (3 'markdown-html-tag-delimiter-face nil t)
  1838. (4 'markdown-html-attr-value-face nil t)))))
  1839. (,markdown-regex-html-entity . 'markdown-html-entity-face)
  1840. (markdown-fontify-list-items)
  1841. (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^
  1842. (2 (markdown--footnote-marker-properties)) ; label
  1843. (3 markdown-markup-properties))) ; ]
  1844. (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^
  1845. (2 markdown-markup-properties) ; [
  1846. (3 (markdown--pandoc-inline-footnote-properties)) ; text
  1847. (4 markdown-markup-properties))) ; ]
  1848. (markdown-match-includes . ((1 markdown-markup-properties)
  1849. (2 markdown-markup-properties nil t)
  1850. (3 markdown-include-title-properties nil t)
  1851. (4 markdown-markup-properties nil t)
  1852. (5 markdown-markup-properties)
  1853. (6 'markdown-url-face)
  1854. (7 markdown-markup-properties)))
  1855. (markdown-fontify-inline-links)
  1856. (markdown-fontify-reference-links)
  1857. (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [
  1858. (2 'markdown-reference-face) ; label
  1859. (3 'markdown-markup-face) ; ]
  1860. (4 'markdown-markup-face) ; :
  1861. (5 'markdown-url-face) ; url
  1862. (6 'markdown-link-title-face))) ; "title" (optional)
  1863. (markdown-fontify-plain-uris)
  1864. ;; Math mode $..$
  1865. (markdown-match-math-single . ((1 'markdown-markup-face prepend)
  1866. (2 'markdown-math-face append)
  1867. (3 'markdown-markup-face prepend)))
  1868. ;; Math mode $$..$$
  1869. (markdown-match-math-double . ((1 'markdown-markup-face prepend)
  1870. (2 'markdown-math-face append)
  1871. (3 'markdown-markup-face prepend)))
  1872. ;; Math mode \[..\] and \\[..\\]
  1873. (markdown-match-math-display . ((1 'markdown-markup-face prepend)
  1874. (3 'markdown-math-face append)
  1875. (4 'markdown-markup-face prepend)))
  1876. (markdown-match-bold . ((1 markdown-markup-properties prepend)
  1877. (2 'markdown-bold-face append)
  1878. (3 markdown-markup-properties prepend)))
  1879. (markdown-match-italic . ((1 markdown-markup-properties prepend)
  1880. (2 'markdown-italic-face append)
  1881. (3 markdown-markup-properties prepend)))
  1882. (,markdown-regex-strike-through . ((3 markdown-markup-properties)
  1883. (4 'markdown-strike-through-face)
  1884. (5 markdown-markup-properties)))
  1885. (,markdown-regex-line-break . (1 'markdown-line-break-face prepend))
  1886. (markdown-fontify-sub-superscripts)
  1887. (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend)))
  1888. (markdown-match-leanpub-sections . ((0 markdown-markup-properties)))
  1889. (markdown-fontify-blockquotes)
  1890. (markdown-match-wiki-link . ((0 'markdown-link-face prepend))))
  1891. "Syntax highlighting for Markdown files.")
  1892. ;; Footnotes
  1893. (defvar-local markdown-footnote-counter 0
  1894. "Counter for footnote numbers.")
  1895. (defconst markdown-footnote-chars
  1896. "[[:alnum:]-]"
  1897. "Regular expression matching any character for a footnote identifier.")
  1898. (defconst markdown-regex-footnote-definition
  1899. (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)")
  1900. "Regular expression matching a footnote definition, capturing the label.")
  1901. ;;; Compatibility =============================================================
  1902. (defun markdown-flyspell-check-word-p ()
  1903. "Return t if `flyspell' should check word just before point.
  1904. Used for `flyspell-generic-check-word-predicate'."
  1905. (save-excursion
  1906. (goto-char (1- (point)))
  1907. ;; https://github.com/jrblevin/markdown-mode/issues/560
  1908. ;; enable spell check YAML meta data
  1909. (if (or (and (markdown-code-block-at-point-p)
  1910. (not (markdown-text-property-at-point 'markdown-yaml-metadata-section)))
  1911. (markdown-inline-code-at-point-p)
  1912. (markdown-in-comment-p)
  1913. (markdown--face-p (point) '(markdown-reference-face
  1914. markdown-markup-face
  1915. markdown-plain-url-face
  1916. markdown-inline-code-face
  1917. markdown-url-face)))
  1918. (prog1 nil
  1919. ;; If flyspell overlay is put, then remove it
  1920. (let ((bounds (bounds-of-thing-at-point 'word)))
  1921. (when bounds
  1922. (cl-loop for ov in (overlays-in (car bounds) (cdr bounds))
  1923. when (overlay-get ov 'flyspell-overlay)
  1924. do
  1925. (delete-overlay ov)))))
  1926. t)))
  1927. ;;; Markdown Parsing Functions ================================================
  1928. (defun markdown-cur-line-blank-p ()
  1929. "Return t if the current line is blank and nil otherwise."
  1930. (save-excursion
  1931. (beginning-of-line)
  1932. (looking-at-p markdown-regex-blank-line)))
  1933. (defun markdown-prev-line-blank ()
  1934. "Return t if the previous line is blank and nil otherwise.
  1935. If we are at the first line, then consider the previous line to be blank."
  1936. (or (= (line-beginning-position) (point-min))
  1937. (save-excursion
  1938. (forward-line -1)
  1939. (looking-at markdown-regex-blank-line))))
  1940. (defun markdown-prev-line-blank-p ()
  1941. "Like `markdown-prev-line-blank', but preserve `match-data'."
  1942. (save-match-data (markdown-prev-line-blank)))
  1943. (defun markdown-next-line-blank-p ()
  1944. "Return t if the next line is blank and nil otherwise.
  1945. If we are at the last line, then consider the next line to be blank."
  1946. (or (= (line-end-position) (point-max))
  1947. (save-excursion
  1948. (forward-line 1)
  1949. (markdown-cur-line-blank-p))))
  1950. (defun markdown-prev-line-indent ()
  1951. "Return the number of leading whitespace characters in the previous line.
  1952. Return 0 if the current line is the first line in the buffer."
  1953. (save-excursion
  1954. (if (= (line-beginning-position) (point-min))
  1955. 0
  1956. (forward-line -1)
  1957. (current-indentation))))
  1958. (defun markdown-next-line-indent ()
  1959. "Return the number of leading whitespace characters in the next line.
  1960. Return 0 if line is the last line in the buffer."
  1961. (save-excursion
  1962. (if (= (line-end-position) (point-max))
  1963. 0
  1964. (forward-line 1)
  1965. (current-indentation))))
  1966. (defun markdown-new-baseline ()
  1967. "Determine if the current line begins a new baseline level.
  1968. Assume point is positioned at beginning of line."
  1969. (or (looking-at markdown-regex-header)
  1970. (looking-at markdown-regex-hr)
  1971. (and (= (current-indentation) 0)
  1972. (not (looking-at markdown-regex-list))
  1973. (markdown-prev-line-blank))))
  1974. (defun markdown-search-backward-baseline ()
  1975. "Search backward baseline point with no indentation and not a list item."
  1976. (end-of-line)
  1977. (let (stop)
  1978. (while (not (or stop (bobp)))
  1979. (re-search-backward markdown-regex-block-separator-noindent nil t)
  1980. (when (match-end 2)
  1981. (goto-char (match-end 2))
  1982. (cond
  1983. ((markdown-new-baseline)
  1984. (setq stop t))
  1985. ((looking-at-p markdown-regex-list)
  1986. (setq stop nil))
  1987. (t (setq stop t)))))))
  1988. (defun markdown-update-list-levels (marker indent levels)
  1989. "Update list levels given list MARKER, block INDENT, and current LEVELS.
  1990. Here, MARKER is a string representing the type of list, INDENT is an integer
  1991. giving the indentation, in spaces, of the current block, and LEVELS is a
  1992. list of the indentation levels of parent list items. When LEVELS is nil,
  1993. it means we are at baseline (not inside of a nested list)."
  1994. (cond
  1995. ;; New list item at baseline.
  1996. ((and marker (null levels))
  1997. (setq levels (list indent)))
  1998. ;; List item with greater indentation (four or more spaces).
  1999. ;; Increase list level.
  2000. ((and marker (>= indent (+ (car levels) markdown-list-indent-width)))
  2001. (setq levels (cons indent levels)))
  2002. ;; List item with greater or equal indentation (less than four spaces).
  2003. ;; Do not increase list level.
  2004. ((and marker (>= indent (car levels)))
  2005. levels)
  2006. ;; Lesser indentation level.
  2007. ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
  2008. ;; indentation could move back more than one list level). Note
  2009. ;; that this block need not be the beginning of list item.
  2010. ((< indent (car levels))
  2011. (while (and (> (length levels) 1)
  2012. (< indent (+ (cadr levels) markdown-list-indent-width)))
  2013. (setq levels (cdr levels)))
  2014. levels)
  2015. ;; Otherwise, do nothing.
  2016. (t levels)))
  2017. (defun markdown-calculate-list-levels ()
  2018. "Calculate list levels at point.
  2019. Return a list of the form (n1 n2 n3 ...) where n1 is the
  2020. indentation of the deepest nested list item in the branch of
  2021. the list at the point, n2 is the indentation of the parent
  2022. list item, and so on. The depth of the list item is therefore
  2023. the length of the returned list. If the point is not at or
  2024. immediately after a list item, return nil."
  2025. (save-excursion
  2026. (let ((first (point)) levels indent pre-regexp)
  2027. ;; Find a baseline point with zero list indentation
  2028. (markdown-search-backward-baseline)
  2029. ;; Search for all list items between baseline and LOC
  2030. (while (and (< (point) first)
  2031. (re-search-forward markdown-regex-list first t))
  2032. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels))))
  2033. (beginning-of-line)
  2034. (cond
  2035. ;; Make sure this is not a header or hr
  2036. ((markdown-new-baseline) (setq levels nil))
  2037. ;; Make sure this is not a line from a pre block
  2038. ((looking-at-p pre-regexp))
  2039. ;; If not, then update levels
  2040. (t
  2041. (setq indent (current-indentation))
  2042. (setq levels (markdown-update-list-levels (match-string 2)
  2043. indent levels))))
  2044. (end-of-line))
  2045. levels)))
  2046. (defun markdown-prev-list-item (level)
  2047. "Search backward from point for a list item with indentation LEVEL.
  2048. Set point to the beginning of the item, and return point, or nil
  2049. upon failure."
  2050. (let (bounds indent prev)
  2051. (setq prev (point))
  2052. (forward-line -1)
  2053. (setq indent (current-indentation))
  2054. (while
  2055. (cond
  2056. ;; List item
  2057. ((and (looking-at-p markdown-regex-list)
  2058. (setq bounds (markdown-cur-list-item-bounds)))
  2059. (cond
  2060. ;; Stop and return point at item of equal indentation
  2061. ((= (nth 3 bounds) level)
  2062. (setq prev (point))
  2063. nil)
  2064. ;; Stop and return nil at item with lesser indentation
  2065. ((< (nth 3 bounds) level)
  2066. (setq prev nil)
  2067. nil)
  2068. ;; Stop at beginning of buffer
  2069. ((bobp) (setq prev nil))
  2070. ;; Continue at item with greater indentation
  2071. ((> (nth 3 bounds) level) t)))
  2072. ;; Stop at beginning of buffer
  2073. ((bobp) (setq prev nil))
  2074. ;; Continue if current line is blank
  2075. ((markdown-cur-line-blank-p) t)
  2076. ;; Continue while indentation is the same or greater
  2077. ((>= indent level) t)
  2078. ;; Stop if current indentation is less than list item
  2079. ;; and the next is blank
  2080. ((and (< indent level)
  2081. (markdown-next-line-blank-p))
  2082. (setq prev nil))
  2083. ;; Stop at a header
  2084. ((looking-at-p markdown-regex-header) (setq prev nil))
  2085. ;; Stop at a horizontal rule
  2086. ((looking-at-p markdown-regex-hr) (setq prev nil))
  2087. ;; Otherwise, continue.
  2088. (t t))
  2089. (forward-line -1)
  2090. (setq indent (current-indentation)))
  2091. prev))
  2092. (defun markdown-next-list-item (level)
  2093. "Search forward from point for the next list item with indentation LEVEL.
  2094. Set point to the beginning of the item, and return point, or nil
  2095. upon failure."
  2096. (let (bounds indent next)
  2097. (setq next (point))
  2098. (if (looking-at markdown-regex-header-setext)
  2099. (goto-char (match-end 0)))
  2100. (forward-line)
  2101. (setq indent (current-indentation))
  2102. (while
  2103. (cond
  2104. ;; Stop at end of the buffer.
  2105. ((eobp) nil)
  2106. ;; Continue if the current line is blank
  2107. ((markdown-cur-line-blank-p) t)
  2108. ;; List item
  2109. ((and (looking-at-p markdown-regex-list)
  2110. (setq bounds (markdown-cur-list-item-bounds)))
  2111. (cond
  2112. ;; Continue at item with greater indentation
  2113. ((> (nth 3 bounds) level) t)
  2114. ;; Stop and return point at item of equal indentation
  2115. ((= (nth 3 bounds) level)
  2116. (setq next (point))
  2117. nil)
  2118. ;; Stop and return nil at item with lesser indentation
  2119. ((< (nth 3 bounds) level)
  2120. (setq next nil)
  2121. nil)))
  2122. ;; Continue while indentation is the same or greater
  2123. ((>= indent level) t)
  2124. ;; Stop if current indentation is less than list item
  2125. ;; and the previous line was blank.
  2126. ((and (< indent level)
  2127. (markdown-prev-line-blank-p))
  2128. (setq next nil))
  2129. ;; Stop at a header
  2130. ((looking-at-p markdown-regex-header) (setq next nil))
  2131. ;; Stop at a horizontal rule
  2132. ((looking-at-p markdown-regex-hr) (setq next nil))
  2133. ;; Otherwise, continue.
  2134. (t t))
  2135. (forward-line)
  2136. (setq indent (current-indentation)))
  2137. next))
  2138. (defun markdown-cur-list-item-end (level)
  2139. "Move to end of list item with pre-marker indentation LEVEL.
  2140. Return the point at the end when a list item was found at the
  2141. original point. If the point is not in a list item, do nothing."
  2142. (let (indent)
  2143. (forward-line)
  2144. (setq indent (current-indentation))
  2145. (while
  2146. (cond
  2147. ;; Stop at end of the buffer.
  2148. ((eobp) nil)
  2149. ;; Continue while indentation is the same or greater
  2150. ((>= indent level) t)
  2151. ;; Continue if the current line is blank
  2152. ((looking-at markdown-regex-blank-line) t)
  2153. ;; Stop if current indentation is less than list item
  2154. ;; and the previous line was blank.
  2155. ((and (< indent level)
  2156. (markdown-prev-line-blank))
  2157. nil)
  2158. ;; Stop at a new list items of the same or lesser
  2159. ;; indentation, headings, and horizontal rules.
  2160. ((looking-at (concat "\\(?:" markdown-regex-list
  2161. "\\|" markdown-regex-header
  2162. "\\|" markdown-regex-hr "\\)"))
  2163. nil)
  2164. ;; Otherwise, continue.
  2165. (t t))
  2166. (forward-line)
  2167. (setq indent (current-indentation)))
  2168. ;; Don't skip over whitespace for empty list items (marker and
  2169. ;; whitespace only), just move to end of whitespace.
  2170. (if (save-excursion
  2171. (beginning-of-line)
  2172. (looking-at (concat markdown-regex-list "[ \t]*$")))
  2173. (goto-char (match-end 3))
  2174. (skip-chars-backward " \t\n"))
  2175. (end-of-line)
  2176. (point)))
  2177. (defun markdown-cur-list-item-bounds ()
  2178. "Return bounds for list item at point.
  2179. Return a list of the following form:
  2180. (begin end indent nonlist-indent marker checkbox match)
  2181. The named components are:
  2182. - begin: Position of beginning of list item, including leading indentation.
  2183. - end: Position of the end of the list item, including list item text.
  2184. - indent: Number of characters of indentation before list marker (an integer).
  2185. - nonlist-indent: Number characters of indentation, list
  2186. marker, and whitespace following list marker (an integer).
  2187. - marker: String containing the list marker and following whitespace
  2188. (e.g., \"- \" or \"* \").
  2189. - checkbox: String containing the GFM checkbox portion, if any,
  2190. including any trailing whitespace before the text
  2191. begins (e.g., \"[x] \").
  2192. - match: match data for markdown-regex-list
  2193. As an example, for the following unordered list item
  2194. - item
  2195. the returned list would be
  2196. (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
  2197. If the point is not inside a list item, return nil."
  2198. (car (get-text-property (point-at-bol) 'markdown-list-item)))
  2199. (defun markdown-list-item-at-point-p ()
  2200. "Return t if there is a list item at the point and nil otherwise."
  2201. (save-match-data (markdown-cur-list-item-bounds)))
  2202. (defun markdown-prev-list-item-bounds ()
  2203. "Return bounds of previous item in the same list of any level.
  2204. The return value has the same form as that of
  2205. `markdown-cur-list-item-bounds'."
  2206. (save-excursion
  2207. (let ((cur-bounds (markdown-cur-list-item-bounds))
  2208. (beginning-of-list (save-excursion (markdown-beginning-of-list)))
  2209. stop)
  2210. (when cur-bounds
  2211. (goto-char (nth 0 cur-bounds))
  2212. (while (and (not stop) (not (bobp))
  2213. (re-search-backward markdown-regex-list
  2214. beginning-of-list t))
  2215. (unless (or (looking-at markdown-regex-hr)
  2216. (markdown-code-block-at-point-p))
  2217. (setq stop (point))))
  2218. (markdown-cur-list-item-bounds)))))
  2219. (defun markdown-next-list-item-bounds ()
  2220. "Return bounds of next item in the same list of any level.
  2221. The return value has the same form as that of
  2222. `markdown-cur-list-item-bounds'."
  2223. (save-excursion
  2224. (let ((cur-bounds (markdown-cur-list-item-bounds))
  2225. (end-of-list (save-excursion (markdown-end-of-list)))
  2226. stop)
  2227. (when cur-bounds
  2228. (goto-char (nth 0 cur-bounds))
  2229. (end-of-line)
  2230. (while (and (not stop) (not (eobp))
  2231. (re-search-forward markdown-regex-list
  2232. end-of-list t))
  2233. (unless (or (looking-at markdown-regex-hr)
  2234. (markdown-code-block-at-point-p))
  2235. (setq stop (point))))
  2236. (when stop
  2237. (markdown-cur-list-item-bounds))))))
  2238. (defun markdown-beginning-of-list ()
  2239. "Move point to beginning of list at point, if any."
  2240. (interactive)
  2241. (let ((orig-point (point))
  2242. (list-begin (save-excursion
  2243. (markdown-search-backward-baseline)
  2244. ;; Stop at next list item, regardless of the indentation.
  2245. (markdown-next-list-item (point-max))
  2246. (when (looking-at markdown-regex-list)
  2247. (point)))))
  2248. (when (and list-begin (<= list-begin orig-point))
  2249. (goto-char list-begin))))
  2250. (defun markdown-end-of-list ()
  2251. "Move point to end of list at point, if any."
  2252. (interactive)
  2253. (let ((start (point))
  2254. (end (save-excursion
  2255. (when (markdown-beginning-of-list)
  2256. ;; Items can't have nonlist-indent <= 1, so this
  2257. ;; moves past all list items.
  2258. (markdown-next-list-item 1)
  2259. (skip-syntax-backward "-")
  2260. (unless (eobp) (forward-char 1))
  2261. (point)))))
  2262. (when (and end (>= end start))
  2263. (goto-char end))))
  2264. (defun markdown-up-list ()
  2265. "Move point to beginning of parent list item."
  2266. (interactive)
  2267. (let ((cur-bounds (markdown-cur-list-item-bounds)))
  2268. (when cur-bounds
  2269. (markdown-prev-list-item (1- (nth 3 cur-bounds)))
  2270. (let ((up-bounds (markdown-cur-list-item-bounds)))
  2271. (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds)))
  2272. (point))))))
  2273. (defun markdown-bounds-of-thing-at-point (thing)
  2274. "Call `bounds-of-thing-at-point' for THING with slight modifications.
  2275. Does not include trailing newlines when THING is 'line. Handles the
  2276. end of buffer case by setting both endpoints equal to the value of
  2277. `point-max', since an empty region will trigger empty markup insertion.
  2278. Return bounds of form (beg . end) if THING is found, or nil otherwise."
  2279. (let* ((bounds (bounds-of-thing-at-point thing))
  2280. (a (car bounds))
  2281. (b (cdr bounds)))
  2282. (when bounds
  2283. (when (eq thing 'line)
  2284. (cond ((and (eobp) (markdown-cur-line-blank-p))
  2285. (setq a b))
  2286. ((char-equal (char-before b) ?\^J)
  2287. (setq b (1- b)))))
  2288. (cons a b))))
  2289. (defun markdown-reference-definition (reference)
  2290. "Find out whether Markdown REFERENCE is defined.
  2291. REFERENCE should not include the square brackets.
  2292. When REFERENCE is defined, return a list of the form (text start end)
  2293. containing the definition text itself followed by the start and end
  2294. locations of the text. Otherwise, return nil.
  2295. Leave match data for `markdown-regex-reference-definition'
  2296. intact additional processing."
  2297. (let ((reference (downcase reference)))
  2298. (save-excursion
  2299. (goto-char (point-min))
  2300. (catch 'found
  2301. (while (re-search-forward markdown-regex-reference-definition nil t)
  2302. (when (string= reference (downcase (match-string-no-properties 2)))
  2303. (throw 'found
  2304. (list (match-string-no-properties 5)
  2305. (match-beginning 5) (match-end 5)))))))))
  2306. (defun markdown-get-defined-references ()
  2307. "Return all defined reference labels and their line numbers (not including square brackets)."
  2308. (save-excursion
  2309. (goto-char (point-min))
  2310. (let (refs)
  2311. (while (re-search-forward markdown-regex-reference-definition nil t)
  2312. (let ((target (match-string-no-properties 2)))
  2313. (cl-pushnew
  2314. (cons (downcase target)
  2315. (markdown-line-number-at-pos (match-beginning 2)))
  2316. refs :test #'equal :key #'car)))
  2317. (reverse refs))))
  2318. (defun markdown-get-used-uris ()
  2319. "Return a list of all used URIs in the buffer."
  2320. (save-excursion
  2321. (goto-char (point-min))
  2322. (let (uris)
  2323. (while (re-search-forward
  2324. (concat "\\(?:" markdown-regex-link-inline
  2325. "\\|" markdown-regex-angle-uri
  2326. "\\|" markdown-regex-uri
  2327. "\\|" markdown-regex-email
  2328. "\\)")
  2329. nil t)
  2330. (unless (or (markdown-inline-code-at-point-p)
  2331. (markdown-code-block-at-point-p))
  2332. (cl-pushnew (or (match-string-no-properties 6)
  2333. (match-string-no-properties 10)
  2334. (match-string-no-properties 12)
  2335. (match-string-no-properties 13))
  2336. uris :test #'equal)))
  2337. (reverse uris))))
  2338. (defun markdown-inline-code-at-pos (pos)
  2339. "Return non-nil if there is an inline code fragment at POS.
  2340. Return nil otherwise. Set match data according to
  2341. `markdown-match-code' upon success.
  2342. This function searches the block for a code fragment that
  2343. contains the point using `markdown-match-code'. We do this
  2344. because `thing-at-point-looking-at' does not work reliably with
  2345. `markdown-regex-code'.
  2346. The match data is set as follows:
  2347. Group 1 matches the opening backquotes.
  2348. Group 2 matches the code fragment itself, without backquotes.
  2349. Group 3 matches the closing backquotes."
  2350. (save-excursion
  2351. (goto-char pos)
  2352. (let ((old-point (point))
  2353. (end-of-block (progn (markdown-end-of-text-block) (point)))
  2354. found)
  2355. (markdown-beginning-of-text-block)
  2356. (while (and (markdown-match-code end-of-block)
  2357. (setq found t)
  2358. (< (match-end 0) old-point)))
  2359. (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1)))
  2360. (and found ; matched something
  2361. (<= (match-beginning match-group) old-point) ; match contains old-point
  2362. (> (match-end 0) old-point))))))
  2363. (defun markdown-inline-code-at-pos-p (pos)
  2364. "Return non-nil if there is an inline code fragment at POS.
  2365. Like `markdown-inline-code-at-pos`, but preserves match data."
  2366. (save-match-data (markdown-inline-code-at-pos pos)))
  2367. (defun markdown-inline-code-at-point ()
  2368. "Return non-nil if the point is at an inline code fragment.
  2369. See `markdown-inline-code-at-pos' for details."
  2370. (markdown-inline-code-at-pos (point)))
  2371. (defun markdown-inline-code-at-point-p (&optional pos)
  2372. "Return non-nil if there is inline code at the POS.
  2373. This is a predicate function counterpart to
  2374. `markdown-inline-code-at-point' which does not modify the match
  2375. data. See `markdown-code-block-at-point-p' for code blocks."
  2376. (save-match-data (markdown-inline-code-at-pos (or pos (point)))))
  2377. (defun markdown-code-block-at-pos (pos)
  2378. "Return match data list if there is a code block at POS.
  2379. Uses text properties at the beginning of the line position.
  2380. This includes pre blocks, tilde-fenced code blocks, and GFM
  2381. quoted code blocks. Return nil otherwise."
  2382. (let ((bol (save-excursion (goto-char pos) (point-at-bol))))
  2383. (or (get-text-property bol 'markdown-pre)
  2384. (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos))
  2385. (second (cl-second bounds)))
  2386. (if second
  2387. ;; chunks are right open
  2388. (when (< pos second)
  2389. bounds)
  2390. bounds)))))
  2391. ;; Function was renamed to emphasize that it does not modify match-data.
  2392. (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p)
  2393. (defun markdown-code-block-at-point-p (&optional pos)
  2394. "Return non-nil if there is a code block at the POS.
  2395. This includes pre blocks, tilde-fenced code blocks, and GFM
  2396. quoted code blocks. This function does not modify the match
  2397. data. See `markdown-inline-code-at-point-p' for inline code."
  2398. (save-match-data (markdown-code-block-at-pos (or pos (point)))))
  2399. (defun markdown-heading-at-point (&optional pos)
  2400. "Return non-nil if there is a heading at the POS.
  2401. Set match data for `markdown-regex-header'."
  2402. (let ((match-data (get-text-property (or pos (point)) 'markdown-heading)))
  2403. (when match-data
  2404. (set-match-data match-data)
  2405. t)))
  2406. (defun markdown-pipe-at-bol-p ()
  2407. "Return non-nil if the line begins with a pipe symbol.
  2408. This may be useful for tables and Pandoc's line_blocks extension."
  2409. (char-equal (char-after (point-at-bol)) ?|))
  2410. ;;; Markdown Font Lock Matching Functions =====================================
  2411. (defun markdown-range-property-any (begin end prop prop-values)
  2412. "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
  2413. Also returns t if PROP is a list containing one of the PROP-VALUES.
  2414. Return nil otherwise."
  2415. (let (props)
  2416. (catch 'found
  2417. (dolist (loc (number-sequence begin end))
  2418. (when (setq props (get-text-property loc prop))
  2419. (cond ((listp props)
  2420. ;; props is a list, check for membership
  2421. (dolist (val prop-values)
  2422. (when (memq val props) (throw 'found loc))))
  2423. (t
  2424. ;; props is a scalar, check for equality
  2425. (dolist (val prop-values)
  2426. (when (eq val props) (throw 'found loc))))))))))
  2427. (defun markdown-range-properties-exist (begin end props)
  2428. (cl-loop
  2429. for loc in (number-sequence begin end)
  2430. with result = nil
  2431. while (not
  2432. (setq result
  2433. (cl-some (lambda (prop) (get-text-property loc prop)) props)))
  2434. finally return result))
  2435. (defun markdown-match-inline-generic (regex last &optional faceless)
  2436. "Match inline REGEX from the point to LAST.
  2437. When FACELESS is non-nil, do not return matches where faces have been applied."
  2438. (when (re-search-forward regex last t)
  2439. (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
  2440. (face (and faceless (text-property-not-all
  2441. (match-beginning 0) (match-end 0) 'face nil))))
  2442. (cond
  2443. ;; In code block: move past it and recursively search again
  2444. (bounds
  2445. (when (< (goto-char (cl-second bounds)) last)
  2446. (markdown-match-inline-generic regex last faceless)))
  2447. ;; When faces are found in the match range, skip over the match and
  2448. ;; recursively search again.
  2449. (face
  2450. (when (< (goto-char (match-end 0)) last)
  2451. (markdown-match-inline-generic regex last faceless)))
  2452. ;; Keep match data and return t when in bounds.
  2453. (t
  2454. (<= (match-end 0) last))))))
  2455. (defun markdown-match-code (last)
  2456. "Match inline code fragments from point to LAST."
  2457. (unless (bobp)
  2458. (backward-char 1))
  2459. (when (markdown-search-until-condition
  2460. (lambda ()
  2461. (and
  2462. ;; Advance point in case of failure, but without exceeding last.
  2463. (goto-char (min (1+ (match-beginning 1)) last))
  2464. (not (markdown-in-comment-p (match-beginning 1)))
  2465. (not (markdown-in-comment-p (match-end 1)))
  2466. (not (markdown-code-block-at-pos (match-beginning 1)))))
  2467. markdown-regex-code last t)
  2468. (set-match-data (list (match-beginning 1) (match-end 1)
  2469. (match-beginning 2) (match-end 2)
  2470. (match-beginning 3) (match-end 3)
  2471. (match-beginning 4) (match-end 4)))
  2472. (goto-char (min (1+ (match-end 0)) last (point-max)))
  2473. t))
  2474. (defun markdown--gfm-markup-underscore-p (begin end)
  2475. (let ((is-underscore (eql (char-after begin) ?_)))
  2476. (if (not is-underscore)
  2477. t
  2478. (save-excursion
  2479. (save-match-data
  2480. (goto-char begin)
  2481. (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin))
  2482. (progn
  2483. (goto-char end)
  2484. (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)"))))))))
  2485. (defun markdown-match-bold (last)
  2486. "Match inline bold from the point to LAST."
  2487. (when (markdown-match-inline-generic markdown-regex-bold last)
  2488. (let ((is-gfm (derived-mode-p 'gfm-mode))
  2489. (begin (match-beginning 2))
  2490. (end (match-end 2)))
  2491. (if (or (markdown-inline-code-at-pos-p begin)
  2492. (markdown-inline-code-at-pos-p end)
  2493. (markdown-in-comment-p)
  2494. (markdown-range-property-any
  2495. begin begin 'face '(markdown-url-face
  2496. markdown-plain-url-face))
  2497. (markdown-range-property-any
  2498. begin end 'face '(markdown-hr-face
  2499. markdown-math-face))
  2500. (and is-gfm (not (markdown--gfm-markup-underscore-p begin end))))
  2501. (progn (goto-char (min (1+ begin) last))
  2502. (when (< (point) last)
  2503. (markdown-match-bold last)))
  2504. (set-match-data (list (match-beginning 2) (match-end 2)
  2505. (match-beginning 3) (match-end 3)
  2506. (match-beginning 4) (match-end 4)
  2507. (match-beginning 5) (match-end 5)))
  2508. t))))
  2509. (defun markdown-match-italic (last)
  2510. "Match inline italics from the point to LAST."
  2511. (let* ((is-gfm (derived-mode-p 'gfm-mode))
  2512. (regex (if is-gfm
  2513. markdown-regex-gfm-italic
  2514. markdown-regex-italic)))
  2515. (when (and (markdown-match-inline-generic regex last)
  2516. (not (markdown--face-p
  2517. (match-beginning 1)
  2518. '(markdown-html-attr-name-face markdown-html-attr-value-face))))
  2519. (let ((begin (match-beginning 1))
  2520. (end (match-end 1))
  2521. (close-end (match-end 4)))
  2522. (if (or (eql (char-before begin) (char-after begin))
  2523. (markdown-inline-code-at-pos-p begin)
  2524. (markdown-inline-code-at-pos-p (1- end))
  2525. (markdown-in-comment-p)
  2526. (markdown-range-property-any
  2527. begin begin 'face '(markdown-url-face
  2528. markdown-plain-url-face))
  2529. (markdown-range-property-any
  2530. begin end 'face '(markdown-bold-face
  2531. markdown-list-face
  2532. markdown-hr-face
  2533. markdown-math-face))
  2534. (and is-gfm
  2535. (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case
  2536. (not (markdown--gfm-markup-underscore-p begin close-end)))))
  2537. (progn (goto-char (min (1+ begin) last))
  2538. (when (< (point) last)
  2539. (markdown-match-italic last)))
  2540. (set-match-data (list (match-beginning 1) (match-end 1)
  2541. (match-beginning 2) (match-end 2)
  2542. (match-beginning 3) (match-end 3)
  2543. (match-beginning 4) (match-end 4)))
  2544. t)))))
  2545. (defun markdown-match-math-generic (regex last)
  2546. "Match REGEX from point to LAST.
  2547. REGEX is either `markdown-regex-math-inline-single' for matching
  2548. $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
  2549. (when (markdown-match-inline-generic regex last)
  2550. (let ((begin (match-beginning 1)) (end (match-end 1)))
  2551. (prog1
  2552. (if (or (markdown-range-property-any
  2553. begin end 'face
  2554. '(markdown-inline-code-face markdown-bold-face))
  2555. (markdown-range-properties-exist
  2556. begin end
  2557. (markdown-get-fenced-block-middle-properties)))
  2558. (markdown-match-math-generic regex last)
  2559. t)
  2560. (goto-char (1+ (match-end 0)))))))
  2561. (defun markdown-match-list-items (last)
  2562. "Match list items from point to LAST."
  2563. (let* ((first (point))
  2564. (pos first)
  2565. (prop 'markdown-list-item)
  2566. (bounds (car (get-text-property pos prop))))
  2567. (while
  2568. (and (or (null (setq bounds (car (get-text-property pos prop))))
  2569. (< (cl-first bounds) pos))
  2570. (< (point) last)
  2571. (setq pos (next-single-property-change pos prop nil last))
  2572. (goto-char pos)))
  2573. (when bounds
  2574. (set-match-data (cl-seventh bounds))
  2575. ;; Step at least one character beyond point. Otherwise
  2576. ;; `font-lock-fontify-keywords-region' infloops.
  2577. (goto-char (min (1+ (max (point-at-eol) first))
  2578. (point-max)))
  2579. t)))
  2580. (defun markdown-match-math-single (last)
  2581. "Match single quoted $..$ math from point to LAST."
  2582. (when markdown-enable-math
  2583. (when (and (char-equal (char-after) ?$)
  2584. (not (bolp))
  2585. (not (char-equal (char-before) ?\\))
  2586. (not (char-equal (char-before) ?$)))
  2587. (forward-char -1))
  2588. (markdown-match-math-generic markdown-regex-math-inline-single last)))
  2589. (defun markdown-match-math-double (last)
  2590. "Match double quoted $$..$$ math from point to LAST."
  2591. (when markdown-enable-math
  2592. (when (and (char-equal (char-after) ?$)
  2593. (char-equal (char-after (1+ (point))) ?$)
  2594. (not (bolp))
  2595. (not (char-equal (char-before) ?\\))
  2596. (not (char-equal (char-before) ?$)))
  2597. (forward-char -1))
  2598. (markdown-match-math-generic markdown-regex-math-inline-double last)))
  2599. (defun markdown-match-math-display (last)
  2600. "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
  2601. (when markdown-enable-math
  2602. (markdown-match-math-generic markdown-regex-math-display last)))
  2603. (defun markdown-match-propertized-text (property last)
  2604. "Match text with PROPERTY from point to LAST.
  2605. Restore match data previously stored in PROPERTY."
  2606. (let ((saved (get-text-property (point) property))
  2607. pos)
  2608. (unless saved
  2609. (setq pos (next-single-property-change (point) property nil last))
  2610. (unless (= pos last)
  2611. (setq saved (get-text-property pos property))))
  2612. (when saved
  2613. (set-match-data saved)
  2614. ;; Step at least one character beyond point. Otherwise
  2615. ;; `font-lock-fontify-keywords-region' infloops.
  2616. (goto-char (min (1+ (max (match-end 0) (point)))
  2617. (point-max)))
  2618. saved)))
  2619. (defun markdown-match-pre-blocks (last)
  2620. "Match preformatted blocks from point to LAST.
  2621. Use data stored in 'markdown-pre text property during syntax
  2622. analysis."
  2623. (markdown-match-propertized-text 'markdown-pre last))
  2624. (defun markdown-match-gfm-code-blocks (last)
  2625. "Match GFM quoted code blocks from point to LAST.
  2626. Use data stored in 'markdown-gfm-code text property during syntax
  2627. analysis."
  2628. (markdown-match-propertized-text 'markdown-gfm-code last))
  2629. (defun markdown-match-gfm-open-code-blocks (last)
  2630. (markdown-match-propertized-text 'markdown-gfm-block-begin last))
  2631. (defun markdown-match-gfm-close-code-blocks (last)
  2632. (markdown-match-propertized-text 'markdown-gfm-block-end last))
  2633. (defun markdown-match-fenced-code-blocks (last)
  2634. "Match fenced code blocks from the point to LAST."
  2635. (markdown-match-propertized-text 'markdown-fenced-code last))
  2636. (defun markdown-match-fenced-start-code-block (last)
  2637. (markdown-match-propertized-text 'markdown-tilde-fence-begin last))
  2638. (defun markdown-match-fenced-end-code-block (last)
  2639. (markdown-match-propertized-text 'markdown-tilde-fence-end last))
  2640. (defun markdown-match-blockquotes (last)
  2641. "Match blockquotes from point to LAST.
  2642. Use data stored in 'markdown-blockquote text property during syntax
  2643. analysis."
  2644. (markdown-match-propertized-text 'markdown-blockquote last))
  2645. (defun markdown-match-hr (last)
  2646. "Match horizontal rules comments from the point to LAST."
  2647. (markdown-match-propertized-text 'markdown-hr last))
  2648. (defun markdown-match-comments (last)
  2649. "Match HTML comments from the point to LAST."
  2650. (when (and (skip-syntax-forward "^<" last))
  2651. (let ((beg (point)))
  2652. (when (and (skip-syntax-forward "^>" last) (< (point) last))
  2653. (forward-char)
  2654. (set-match-data (list beg (point)))
  2655. t))))
  2656. (defun markdown-match-generic-links (last ref)
  2657. "Match inline links from point to LAST.
  2658. When REF is non-nil, match reference links instead of standard
  2659. links with URLs.
  2660. This function should only be used during font-lock, as it
  2661. determines syntax based on the presence of faces for previously
  2662. processed elements."
  2663. ;; Search for the next potential link (not in a code block).
  2664. (let ((prohibited-faces '(markdown-pre-face
  2665. markdown-code-face
  2666. markdown-inline-code-face
  2667. markdown-comment-face))
  2668. found)
  2669. (while
  2670. (and (not found) (< (point) last)
  2671. (progn
  2672. ;; Clear match data to test for a match after functions returns.
  2673. (set-match-data nil)
  2674. ;; Preliminary regular expression search so we can return
  2675. ;; quickly upon failure. This doesn't handle malformed links
  2676. ;; or nested square brackets well, so if it passes we back up
  2677. ;; continue with a more precise search.
  2678. (re-search-forward
  2679. (if ref
  2680. markdown-regex-link-reference
  2681. markdown-regex-link-inline)
  2682. last 'limit)))
  2683. ;; Keep searching if this is in a code block, inline code, or a
  2684. ;; comment, or if it is include syntax. The link text portion
  2685. ;; (group 3) may contain inline code or comments, but the
  2686. ;; markup, URL, and title should not be part of such elements.
  2687. (if (or (markdown-range-property-any
  2688. (match-beginning 0) (match-end 2) 'face prohibited-faces)
  2689. (markdown-range-property-any
  2690. (match-beginning 4) (match-end 0) 'face prohibited-faces)
  2691. (and (char-equal (char-after (point-at-bol)) ?<)
  2692. (char-equal (char-after (1+ (point-at-bol))) ?<)))
  2693. (set-match-data nil)
  2694. (setq found t))))
  2695. ;; Match opening exclamation point (optional) and left bracket.
  2696. (when (match-beginning 2)
  2697. (let* ((bang (match-beginning 1))
  2698. (first-begin (match-beginning 2))
  2699. ;; Find end of block to prevent matching across blocks.
  2700. (end-of-block (save-excursion
  2701. (progn
  2702. (goto-char (match-beginning 2))
  2703. (markdown-end-of-text-block)
  2704. (point))))
  2705. ;; Move over balanced expressions to closing right bracket.
  2706. ;; Catch unbalanced expression errors and return nil.
  2707. (first-end (condition-case nil
  2708. (and (goto-char first-begin)
  2709. (scan-sexps (point) 1))
  2710. (error nil)))
  2711. ;; Continue with point at CONT-POINT upon failure.
  2712. (cont-point (min (1+ first-begin) last))
  2713. second-begin second-end url-begin url-end
  2714. title-begin title-end)
  2715. ;; When bracket found, in range, and followed by a left paren/bracket...
  2716. (when (and first-end (< first-end end-of-block) (goto-char first-end)
  2717. (char-equal (char-after (point)) (if ref ?\[ ?\()))
  2718. ;; Scan across balanced expressions for closing parenthesis/bracket.
  2719. (setq second-begin (point)
  2720. second-end (condition-case nil
  2721. (scan-sexps (point) 1)
  2722. (error nil)))
  2723. ;; Check that closing parenthesis/bracket is in range.
  2724. (if (and second-end (<= second-end end-of-block) (<= second-end last))
  2725. (progn
  2726. ;; Search for (optional) title inside closing parenthesis
  2727. (when (and (not ref) (search-forward "\"" second-end t))
  2728. (setq title-begin (1- (point))
  2729. title-end (and (goto-char second-end)
  2730. (search-backward "\"" (1+ title-begin) t))
  2731. title-end (and title-end (1+ title-end))))
  2732. ;; Store URL/reference range
  2733. (setq url-begin (1+ second-begin)
  2734. url-end (1- (or title-begin second-end)))
  2735. ;; Set match data, move point beyond link, and return
  2736. (set-match-data
  2737. (list (or bang first-begin) second-end ; 0 - all
  2738. bang (and bang (1+ bang)) ; 1 - bang
  2739. first-begin (1+ first-begin) ; 2 - markup
  2740. (1+ first-begin) (1- first-end) ; 3 - link text
  2741. (1- first-end) first-end ; 4 - markup
  2742. second-begin (1+ second-begin) ; 5 - markup
  2743. url-begin url-end ; 6 - url/reference
  2744. title-begin title-end ; 7 - title
  2745. (1- second-end) second-end)) ; 8 - markup
  2746. ;; Nullify cont-point and leave point at end and
  2747. (setq cont-point nil)
  2748. (goto-char second-end))
  2749. ;; If no closing parenthesis in range, update continuation point
  2750. (setq cont-point (min end-of-block second-begin))))
  2751. (cond
  2752. ;; On failure, continue searching at cont-point
  2753. ((and cont-point (< cont-point last))
  2754. (goto-char cont-point)
  2755. (markdown-match-generic-links last ref))
  2756. ;; No more text, return nil
  2757. ((and cont-point (= cont-point last))
  2758. nil)
  2759. ;; Return t if a match occurred
  2760. (t t)))))
  2761. (defun markdown-match-angle-uris (last)
  2762. "Match angle bracket URIs from point to LAST."
  2763. (when (markdown-match-inline-generic markdown-regex-angle-uri last)
  2764. (goto-char (1+ (match-end 0)))))
  2765. (defun markdown-match-plain-uris (last)
  2766. "Match plain URIs from point to LAST."
  2767. (when (markdown-match-inline-generic markdown-regex-uri last t)
  2768. (goto-char (1+ (match-end 0)))))
  2769. (defvar markdown-conditional-search-function #'re-search-forward
  2770. "Conditional search function used in `markdown-search-until-condition'.
  2771. Made into a variable to allow for dynamic let-binding.")
  2772. (defun markdown-search-until-condition (condition &rest args)
  2773. (let (ret)
  2774. (while (and (not ret) (apply markdown-conditional-search-function args))
  2775. (setq ret (funcall condition)))
  2776. ret))
  2777. (defun markdown-metadata-line-p (pos regexp)
  2778. (save-excursion
  2779. (or (= (line-number-at-pos pos) 1)
  2780. (progn
  2781. (forward-line -1)
  2782. ;; skip multi-line metadata
  2783. (while (and (looking-at-p "^\\s-+[[:alpha:]]")
  2784. (> (line-number-at-pos (point)) 1))
  2785. (forward-line -1))
  2786. (looking-at-p regexp)))))
  2787. (defun markdown-match-generic-metadata (regexp last)
  2788. "Match metadata declarations specified by REGEXP from point to LAST.
  2789. These declarations must appear inside a metadata block that begins at
  2790. the beginning of the buffer and ends with a blank line (or the end of
  2791. the buffer)."
  2792. (let* ((first (point))
  2793. (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
  2794. (block-begin (goto-char 1))
  2795. (block-end (re-search-forward end-re nil t)))
  2796. (if (and block-end (> first block-end))
  2797. ;; Don't match declarations if there is no metadata block or if
  2798. ;; the point is beyond the block. Move point to point-max to
  2799. ;; prevent additional searches and return return nil since nothing
  2800. ;; was found.
  2801. (progn (goto-char (point-max)) nil)
  2802. ;; If a block was found that begins before LAST and ends after
  2803. ;; point, search for declarations inside it. If the starting is
  2804. ;; before the beginning of the block, start there. Otherwise,
  2805. ;; move back to FIRST.
  2806. (goto-char (if (< first block-begin) block-begin first))
  2807. (if (and (re-search-forward regexp (min last block-end) t)
  2808. (markdown-metadata-line-p (point) regexp))
  2809. ;; If a metadata declaration is found, set match-data and return t.
  2810. (let ((key-beginning (match-beginning 1))
  2811. (key-end (match-end 1))
  2812. (markup-begin (match-beginning 2))
  2813. (markup-end (match-end 2))
  2814. (value-beginning (match-beginning 3)))
  2815. (set-match-data (list key-beginning (point) ; complete metadata
  2816. key-beginning key-end ; key
  2817. markup-begin markup-end ; markup
  2818. value-beginning (point))) ; value
  2819. t)
  2820. ;; Otherwise, move the point to last and return nil
  2821. (goto-char last)
  2822. nil))))
  2823. (defun markdown-match-declarative-metadata (last)
  2824. "Match declarative metadata from the point to LAST."
  2825. (markdown-match-generic-metadata markdown-regex-declarative-metadata last))
  2826. (defun markdown-match-pandoc-metadata (last)
  2827. "Match Pandoc metadata from the point to LAST."
  2828. (markdown-match-generic-metadata markdown-regex-pandoc-metadata last))
  2829. (defun markdown-match-yaml-metadata-begin (last)
  2830. (markdown-match-propertized-text 'markdown-yaml-metadata-begin last))
  2831. (defun markdown-match-yaml-metadata-end (last)
  2832. (markdown-match-propertized-text 'markdown-yaml-metadata-end last))
  2833. (defun markdown-match-yaml-metadata-key (last)
  2834. (markdown-match-propertized-text 'markdown-metadata-key last))
  2835. (defun markdown-match-wiki-link (last)
  2836. "Match wiki links from point to LAST."
  2837. (when (and markdown-enable-wiki-links
  2838. (not markdown-wiki-link-fontify-missing)
  2839. (markdown-match-inline-generic markdown-regex-wiki-link last))
  2840. (let ((begin (match-beginning 1)) (end (match-end 1)))
  2841. (if (or (markdown-in-comment-p begin)
  2842. (markdown-in-comment-p end)
  2843. (markdown-inline-code-at-pos-p begin)
  2844. (markdown-inline-code-at-pos-p end)
  2845. (markdown-code-block-at-pos begin))
  2846. (progn (goto-char (min (1+ begin) last))
  2847. (when (< (point) last)
  2848. (markdown-match-wiki-link last)))
  2849. (set-match-data (list begin end))
  2850. t))))
  2851. (defun markdown-match-inline-attributes (last)
  2852. "Match inline attributes from point to LAST."
  2853. ;; #428 re-search-forward markdown-regex-inline-attributes is very slow.
  2854. ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes
  2855. ;; against matched string.
  2856. (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last)
  2857. (if (not (string-match-p markdown-regex-inline-attributes (match-string 0)))
  2858. (markdown-match-inline-attributes last)
  2859. (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
  2860. (markdown-inline-code-at-pos-p (match-end 0))
  2861. (markdown-in-comment-p))
  2862. t))))
  2863. (defun markdown-match-leanpub-sections (last)
  2864. "Match Leanpub section markers from point to LAST."
  2865. (when (markdown-match-inline-generic markdown-regex-leanpub-sections last)
  2866. (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
  2867. (markdown-inline-code-at-pos-p (match-end 0))
  2868. (markdown-in-comment-p))
  2869. t)))
  2870. (defun markdown-match-includes (last)
  2871. "Match include statements from point to LAST.
  2872. Sets match data for the following seven groups:
  2873. Group 1: opening two angle brackets
  2874. Group 2: opening title delimiter (optional)
  2875. Group 3: title text (optional)
  2876. Group 4: closing title delimiter (optional)
  2877. Group 5: opening filename delimiter
  2878. Group 6: filename
  2879. Group 7: closing filename delimiter"
  2880. (when (markdown-match-inline-generic markdown-regex-include last)
  2881. (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
  2882. (markdown-in-comment-p (match-end 0))
  2883. (markdown-code-block-at-pos (match-beginning 0))))))
  2884. (cond
  2885. ;; Parentheses and maybe square brackets, but no curly braces:
  2886. ;; match optional title in square brackets and file in parentheses.
  2887. ((and valid (match-beginning 5)
  2888. (not (match-beginning 8)))
  2889. (set-match-data (list (match-beginning 1) (match-end 7)
  2890. (match-beginning 1) (match-end 1)
  2891. (match-beginning 2) (match-end 2)
  2892. (match-beginning 3) (match-end 3)
  2893. (match-beginning 4) (match-end 4)
  2894. (match-beginning 5) (match-end 5)
  2895. (match-beginning 6) (match-end 6)
  2896. (match-beginning 7) (match-end 7))))
  2897. ;; Only square brackets present: match file in square brackets.
  2898. ((and valid (match-beginning 2)
  2899. (not (match-beginning 5))
  2900. (not (match-beginning 7)))
  2901. (set-match-data (list (match-beginning 1) (match-end 4)
  2902. (match-beginning 1) (match-end 1)
  2903. nil nil
  2904. nil nil
  2905. nil nil
  2906. (match-beginning 2) (match-end 2)
  2907. (match-beginning 3) (match-end 3)
  2908. (match-beginning 4) (match-end 4))))
  2909. ;; Only curly braces present: match file in curly braces.
  2910. ((and valid (match-beginning 8)
  2911. (not (match-beginning 2))
  2912. (not (match-beginning 5)))
  2913. (set-match-data (list (match-beginning 1) (match-end 10)
  2914. (match-beginning 1) (match-end 1)
  2915. nil nil
  2916. nil nil
  2917. nil nil
  2918. (match-beginning 8) (match-end 8)
  2919. (match-beginning 9) (match-end 9)
  2920. (match-beginning 10) (match-end 10))))
  2921. (t
  2922. ;; Not a valid match, move to next line and search again.
  2923. (forward-line)
  2924. (when (< (point) last)
  2925. (setq valid (markdown-match-includes last)))))
  2926. valid)))
  2927. (defun markdown-match-html-tag (last)
  2928. "Match HTML tags from point to LAST."
  2929. (when (and markdown-enable-html
  2930. (markdown-match-inline-generic markdown-regex-html-tag last t))
  2931. (set-match-data (list (match-beginning 0) (match-end 0)
  2932. (match-beginning 1) (match-end 1)
  2933. (match-beginning 2) (match-end 2)
  2934. (match-beginning 9) (match-end 9)))
  2935. t))
  2936. ;;; Markdown Font Fontification Functions =====================================
  2937. (defun markdown--first-displayable (seq)
  2938. "Return the first displayable character or string in SEQ.
  2939. SEQ may be an atom or a sequence."
  2940. (let ((seq (if (listp seq) seq (list seq))))
  2941. (cond ((stringp (car seq))
  2942. (cl-find-if
  2943. (lambda (str)
  2944. (and (mapcar #'char-displayable-p (string-to-list str))))
  2945. seq))
  2946. ((characterp (car seq))
  2947. (cl-find-if #'char-displayable-p seq)))))
  2948. (defun markdown--marginalize-string (level)
  2949. "Generate atx markup string of given LEVEL for left margin."
  2950. (let ((margin-left-space-count
  2951. (- markdown-marginalize-headers-margin-width level)))
  2952. (concat (make-string margin-left-space-count ? )
  2953. (make-string level ?#))))
  2954. (defun markdown-marginalize-update-current ()
  2955. "Update the window configuration to create a left margin."
  2956. (if window-system
  2957. (let* ((header-delimiter-font-width
  2958. (window-font-width nil 'markdown-header-delimiter-face))
  2959. (margin-pixel-width (* markdown-marginalize-headers-margin-width
  2960. header-delimiter-font-width))
  2961. (margin-char-width (/ margin-pixel-width (default-font-width))))
  2962. (set-window-margins nil margin-char-width))
  2963. ;; As a fallback, simply set margin based on character count.
  2964. (set-window-margins nil markdown-marginalize-headers-margin-width)))
  2965. (defun markdown-fontify-headings (last)
  2966. "Add text properties to headings from point to LAST."
  2967. (when (markdown-match-propertized-text 'markdown-heading last)
  2968. (let* ((level (markdown-outline-level))
  2969. (heading-face
  2970. (intern (format "markdown-header-face-%d" level)))
  2971. (heading-props `(face ,heading-face))
  2972. (left-markup-props
  2973. `(face markdown-header-delimiter-face
  2974. ,@(cond
  2975. (markdown-hide-markup
  2976. `(display ""))
  2977. (markdown-marginalize-headers
  2978. `(display ((margin left-margin)
  2979. ,(markdown--marginalize-string level)))))))
  2980. (right-markup-props
  2981. `(face markdown-header-delimiter-face
  2982. ,@(when markdown-hide-markup `(display ""))))
  2983. (rule-props `(face markdown-header-rule-face
  2984. ,@(when markdown-hide-markup `(display "")))))
  2985. (if (match-end 1)
  2986. ;; Setext heading
  2987. (progn (add-text-properties
  2988. (match-beginning 1) (match-end 1) heading-props)
  2989. (if (= level 1)
  2990. (add-text-properties
  2991. (match-beginning 2) (match-end 2) rule-props)
  2992. (add-text-properties
  2993. (match-beginning 3) (match-end 3) rule-props)))
  2994. ;; atx heading
  2995. (add-text-properties
  2996. (match-beginning 4) (match-end 4) left-markup-props)
  2997. (add-text-properties
  2998. (match-beginning 5) (match-end 5) heading-props)
  2999. (when (match-end 6)
  3000. (add-text-properties
  3001. (match-beginning 6) (match-end 6) right-markup-props))))
  3002. t))
  3003. (defun markdown-fontify-tables (last)
  3004. (when (and (re-search-forward "|" last t)
  3005. (markdown-table-at-point-p))
  3006. (font-lock-append-text-property
  3007. (line-beginning-position) (min (1+ (line-end-position)) (point-max))
  3008. 'face 'markdown-table-face)
  3009. (forward-line 1)
  3010. t))
  3011. (defun markdown-fontify-blockquotes (last)
  3012. "Apply font-lock properties to blockquotes from point to LAST."
  3013. (when (markdown-match-blockquotes last)
  3014. (let ((display-string
  3015. (markdown--first-displayable markdown-blockquote-display-char)))
  3016. (add-text-properties
  3017. (match-beginning 1) (match-end 1)
  3018. (if markdown-hide-markup
  3019. `(face markdown-blockquote-face display ,display-string)
  3020. `(face markdown-markup-face)))
  3021. (font-lock-append-text-property
  3022. (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face)
  3023. t)))
  3024. (defun markdown-fontify-list-items (last)
  3025. "Apply font-lock properties to list markers from point to LAST."
  3026. (when (markdown-match-list-items last)
  3027. (let* ((indent (length (match-string-no-properties 1)))
  3028. (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ...
  3029. (bullet (nth (mod level (length markdown-list-item-bullets))
  3030. markdown-list-item-bullets)))
  3031. (add-text-properties
  3032. (match-beginning 2) (match-end 2) '(face markdown-list-face))
  3033. (when markdown-hide-markup
  3034. (cond
  3035. ;; Unordered lists
  3036. ((string-match-p "[\\*\\+-]" (match-string 2))
  3037. (add-text-properties
  3038. (match-beginning 2) (match-end 2) `(display ,bullet)))
  3039. ;; Definition lists
  3040. ((string-equal ":" (match-string 2))
  3041. (let ((display-string
  3042. (char-to-string (markdown--first-displayable
  3043. markdown-definition-display-char))))
  3044. (add-text-properties (match-beginning 2) (match-end 2)
  3045. `(display ,display-string)))))))
  3046. t))
  3047. (defun markdown-fontify-hrs (last)
  3048. "Add text properties to horizontal rules from point to LAST."
  3049. (when (markdown-match-hr last)
  3050. (let ((hr-char (markdown--first-displayable markdown-hr-display-char)))
  3051. (add-text-properties
  3052. (match-beginning 0) (match-end 0)
  3053. `(face markdown-hr-face
  3054. font-lock-multiline t
  3055. ,@(when (and markdown-hide-markup hr-char)
  3056. `(display ,(make-string
  3057. (window-body-width) hr-char)))))
  3058. t)))
  3059. (defun markdown-fontify-sub-superscripts (last)
  3060. "Apply text properties to sub- and superscripts from point to LAST."
  3061. (when (markdown-search-until-condition
  3062. (lambda () (and (not (markdown-code-block-at-point-p))
  3063. (not (markdown-inline-code-at-point-p))
  3064. (not (markdown-in-comment-p))))
  3065. markdown-regex-sub-superscript last t)
  3066. (let* ((subscript-p (string= (match-string 2) "~"))
  3067. (props
  3068. (if subscript-p
  3069. (car markdown-sub-superscript-display)
  3070. (cdr markdown-sub-superscript-display)))
  3071. (mp (list 'face 'markdown-markup-face
  3072. 'invisible 'markdown-markup)))
  3073. (when markdown-hide-markup
  3074. (put-text-property (match-beginning 3) (match-end 3)
  3075. 'display props))
  3076. (add-text-properties (match-beginning 2) (match-end 2) mp)
  3077. (add-text-properties (match-beginning 4) (match-end 4) mp)
  3078. t)))
  3079. ;;; Syntax Table ==============================================================
  3080. (defvar markdown-mode-syntax-table
  3081. (let ((tab (make-syntax-table text-mode-syntax-table)))
  3082. (modify-syntax-entry ?\" "." tab)
  3083. tab)
  3084. "Syntax table for `markdown-mode'.")
  3085. ;;; Element Insertion =========================================================
  3086. (defun markdown-ensure-blank-line-before ()
  3087. "If previous line is not already blank, insert a blank line before point."
  3088. (unless (bolp) (insert "\n"))
  3089. (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n")))
  3090. (defun markdown-ensure-blank-line-after ()
  3091. "If following line is not already blank, insert a blank line after point.
  3092. Return the point where it was originally."
  3093. (save-excursion
  3094. (unless (eolp) (insert "\n"))
  3095. (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
  3096. (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end)
  3097. "Insert the strings S1 and S2, wrapping around region or THING.
  3098. If a region is specified by the optional BEG and END arguments,
  3099. wrap the strings S1 and S2 around that region.
  3100. If there is an active region, wrap the strings S1 and S2 around
  3101. the region. If there is not an active region but the point is at
  3102. THING, wrap that thing (which defaults to word). Otherwise, just
  3103. insert S1 and S2 and place the point in between. Return the
  3104. bounds of the entire wrapped string, or nil if nothing was wrapped
  3105. and S1 and S2 were only inserted."
  3106. (let (a b bounds new-point)
  3107. (cond
  3108. ;; Given region
  3109. ((and beg end)
  3110. (setq a beg
  3111. b end
  3112. new-point (+ (point) (length s1))))
  3113. ;; Active region
  3114. ((use-region-p)
  3115. (setq a (region-beginning)
  3116. b (region-end)
  3117. new-point (+ (point) (length s1))))
  3118. ;; Thing (word) at point
  3119. ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word)))
  3120. (setq a (car bounds)
  3121. b (cdr bounds)
  3122. new-point (+ (point) (length s1))))
  3123. ;; No active region and no word
  3124. (t
  3125. (setq a (point)
  3126. b (point))))
  3127. (goto-char b)
  3128. (insert s2)
  3129. (goto-char a)
  3130. (insert s1)
  3131. (when new-point (goto-char new-point))
  3132. (if (= a b)
  3133. nil
  3134. (setq b (+ b (length s1) (length s2)))
  3135. (cons a b))))
  3136. (defun markdown-point-after-unwrap (cur prefix suffix)
  3137. "Return desired position of point after an unwrapping operation.
  3138. CUR gives the position of the point before the operation.
  3139. Additionally, two cons cells must be provided. PREFIX gives the
  3140. bounds of the prefix string and SUFFIX gives the bounds of the
  3141. suffix string."
  3142. (cond ((< cur (cdr prefix)) (car prefix))
  3143. ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix))))
  3144. ((<= cur (cdr suffix))
  3145. (- cur (+ (- (cdr prefix) (car prefix))
  3146. (- cur (car suffix)))))
  3147. (t cur)))
  3148. (defun markdown-unwrap-thing-at-point (regexp all text)
  3149. "Remove prefix and suffix of thing at point and reposition the point.
  3150. When the thing at point matches REGEXP, replace the subexpression
  3151. ALL with the string in subexpression TEXT. Reposition the point
  3152. in an appropriate location accounting for the removal of prefix
  3153. and suffix strings. Return new bounds of string from group TEXT.
  3154. When REGEXP is nil, assumes match data is already set."
  3155. (when (or (null regexp)
  3156. (thing-at-point-looking-at regexp))
  3157. (let ((cur (point))
  3158. (prefix (cons (match-beginning all) (match-beginning text)))
  3159. (suffix (cons (match-end text) (match-end all)))
  3160. (bounds (cons (match-beginning text) (match-end text))))
  3161. ;; Replace the thing at point
  3162. (replace-match (match-string text) t t nil all)
  3163. ;; Reposition the point
  3164. (goto-char (markdown-point-after-unwrap cur prefix suffix))
  3165. ;; Adjust bounds
  3166. (setq bounds (cons (car prefix)
  3167. (- (cdr bounds) (- (cdr prefix) (car prefix))))))))
  3168. (defun markdown-unwrap-things-in-region (beg end regexp all text)
  3169. "Remove prefix and suffix of all things in region from BEG to END.
  3170. When a thing in the region matches REGEXP, replace the
  3171. subexpression ALL with the string in subexpression TEXT.
  3172. Return a cons cell containing updated bounds for the region."
  3173. (save-excursion
  3174. (goto-char beg)
  3175. (let ((removed 0) len-all len-text)
  3176. (while (re-search-forward regexp (- end removed) t)
  3177. (setq len-all (length (match-string-no-properties all)))
  3178. (setq len-text (length (match-string-no-properties text)))
  3179. (setq removed (+ removed (- len-all len-text)))
  3180. (replace-match (match-string text) t t nil all))
  3181. (cons beg (- end removed)))))
  3182. (defun markdown-insert-hr (arg)
  3183. "Insert or replace a horizontal rule.
  3184. By default, use the first element of `markdown-hr-strings'. When
  3185. ARG is non-nil, as when given a prefix, select a different
  3186. element as follows. When prefixed with \\[universal-argument],
  3187. use the last element of `markdown-hr-strings' instead. When
  3188. prefixed with an integer from 1 to the length of
  3189. `markdown-hr-strings', use the element in that position instead."
  3190. (interactive "*P")
  3191. (when (thing-at-point-looking-at markdown-regex-hr)
  3192. (delete-region (match-beginning 0) (match-end 0)))
  3193. (markdown-ensure-blank-line-before)
  3194. (cond ((equal arg '(4))
  3195. (insert (car (reverse markdown-hr-strings))))
  3196. ((and (integerp arg) (> arg 0)
  3197. (<= arg (length markdown-hr-strings)))
  3198. (insert (nth (1- arg) markdown-hr-strings)))
  3199. (t
  3200. (insert (car markdown-hr-strings))))
  3201. (markdown-ensure-blank-line-after))
  3202. (defun markdown--insert-common (start-delim end-delim regex start-group end-group face)
  3203. (if (use-region-p)
  3204. ;; Active region
  3205. (let ((bounds (markdown-unwrap-things-in-region
  3206. (region-beginning) (region-end)
  3207. regex start-group end-group)))
  3208. (markdown-wrap-or-insert start-delim end-delim nil (car bounds) (cdr bounds)))
  3209. (if (markdown--face-p (point) (list face))
  3210. (save-excursion
  3211. (while (and (markdown--face-p (point) (list face)) (not (bobp)))
  3212. (forward-char -1))
  3213. (forward-char (- (1- (length start-delim)))) ;; for delimiter
  3214. (unless (bolp)
  3215. (forward-char -1))
  3216. (when (looking-at regex)
  3217. (markdown-unwrap-thing-at-point nil start-group end-group)))
  3218. (if (thing-at-point-looking-at regex)
  3219. (markdown-unwrap-thing-at-point nil start-group end-group)
  3220. (markdown-wrap-or-insert start-delim end-delim 'word nil nil)))))
  3221. (defun markdown-insert-bold ()
  3222. "Insert markup to make a region or word bold.
  3223. If there is an active region, make the region bold. If the point
  3224. is at a non-bold word, make the word bold. If the point is at a
  3225. bold word or phrase, remove the bold markup. Otherwise, simply
  3226. insert bold delimiters and place the point in between them."
  3227. (interactive)
  3228. (let ((delim (if markdown-bold-underscore "__" "**")))
  3229. (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face)))
  3230. (defun markdown-insert-italic ()
  3231. "Insert markup to make a region or word italic.
  3232. If there is an active region, make the region italic. If the point
  3233. is at a non-italic word, make the word italic. If the point is at an
  3234. italic word or phrase, remove the italic markup. Otherwise, simply
  3235. insert italic delimiters and place the point in between them."
  3236. (interactive)
  3237. (let ((delim (if markdown-italic-underscore "_" "*")))
  3238. (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face)))
  3239. (defun markdown-insert-strike-through ()
  3240. "Insert markup to make a region or word strikethrough.
  3241. If there is an active region, make the region strikethrough. If the point
  3242. is at a non-bold word, make the word strikethrough. If the point is at a
  3243. strikethrough word or phrase, remove the strikethrough markup. Otherwise,
  3244. simply insert bold delimiters and place the point in between them."
  3245. (interactive)
  3246. (markdown--insert-common
  3247. "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face))
  3248. (defun markdown-insert-code ()
  3249. "Insert markup to make a region or word an inline code fragment.
  3250. If there is an active region, make the region an inline code
  3251. fragment. If the point is at a word, make the word an inline
  3252. code fragment. Otherwise, simply insert code delimiters and
  3253. place the point in between them."
  3254. (interactive)
  3255. (if (use-region-p)
  3256. ;; Active region
  3257. (let ((bounds (markdown-unwrap-things-in-region
  3258. (region-beginning) (region-end)
  3259. markdown-regex-code 1 3)))
  3260. (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds)))
  3261. ;; Code markup removal, code markup for word, or empty markup insertion
  3262. (if (markdown-inline-code-at-point)
  3263. (markdown-unwrap-thing-at-point nil 0 2)
  3264. (markdown-wrap-or-insert "`" "`" 'word nil nil))))
  3265. (defun markdown-insert-kbd ()
  3266. "Insert markup to wrap region or word in <kbd> tags.
  3267. If there is an active region, use the region. If the point is at
  3268. a word, use the word. Otherwise, simply insert <kbd> tags and
  3269. place the point in between them."
  3270. (interactive)
  3271. (if (use-region-p)
  3272. ;; Active region
  3273. (let ((bounds (markdown-unwrap-things-in-region
  3274. (region-beginning) (region-end)
  3275. markdown-regex-kbd 0 2)))
  3276. (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds)))
  3277. ;; Markup removal, markup for word, or empty markup insertion
  3278. (if (thing-at-point-looking-at markdown-regex-kbd)
  3279. (markdown-unwrap-thing-at-point nil 0 2)
  3280. (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil))))
  3281. (defun markdown-insert-inline-link (text url &optional title)
  3282. "Insert an inline link with TEXT pointing to URL.
  3283. Optionally, the user can provide a TITLE."
  3284. (let ((cur (point)))
  3285. (setq title (and title (concat " \"" title "\"")))
  3286. (insert (concat "[" text "](" url title ")"))
  3287. (cond ((not text) (goto-char (+ 1 cur)))
  3288. ((not url) (goto-char (+ 3 (length text) cur))))))
  3289. (defun markdown-insert-inline-image (text url &optional title)
  3290. "Insert an inline link with alt TEXT pointing to URL.
  3291. Optionally, also provide a TITLE."
  3292. (let ((cur (point)))
  3293. (setq title (and title (concat " \"" title "\"")))
  3294. (insert (concat "![" text "](" url title ")"))
  3295. (cond ((not text) (goto-char (+ 2 cur)))
  3296. ((not url) (goto-char (+ 4 (length text) cur))))))
  3297. (defun markdown-insert-reference-link (text label &optional url title)
  3298. "Insert a reference link and, optionally, a reference definition.
  3299. The link TEXT will be inserted followed by the optional LABEL.
  3300. If a URL is given, also insert a definition for the reference
  3301. LABEL according to `markdown-reference-location'. If a TITLE is
  3302. given, it will be added to the end of the reference definition
  3303. and will be used to populate the title attribute when converted
  3304. to XHTML. If URL is nil, insert only the link portion (for
  3305. example, when a reference label is already defined)."
  3306. (insert (concat "[" text "][" label "]"))
  3307. (when url
  3308. (markdown-insert-reference-definition
  3309. (if (string-equal label "") text label)
  3310. url title)))
  3311. (defun markdown-insert-reference-image (text label &optional url title)
  3312. "Insert a reference image and, optionally, a reference definition.
  3313. The alt TEXT will be inserted followed by the optional LABEL.
  3314. If a URL is given, also insert a definition for the reference
  3315. LABEL according to `markdown-reference-location'. If a TITLE is
  3316. given, it will be added to the end of the reference definition
  3317. and will be used to populate the title attribute when converted
  3318. to XHTML. If URL is nil, insert only the link portion (for
  3319. example, when a reference label is already defined)."
  3320. (insert (concat "![" text "][" label "]"))
  3321. (when url
  3322. (markdown-insert-reference-definition
  3323. (if (string-equal label "") text label)
  3324. url title)))
  3325. (defun markdown-insert-reference-definition (label &optional url title)
  3326. "Add definition for reference LABEL with URL and TITLE.
  3327. LABEL is a Markdown reference label without square brackets.
  3328. URL and TITLE are optional. When given, the TITLE will
  3329. be used to populate the title attribute when converted to XHTML."
  3330. ;; END specifies where to leave the point upon return
  3331. (let ((end (point)))
  3332. (cl-case markdown-reference-location
  3333. (end (goto-char (point-max)))
  3334. (immediately (markdown-end-of-text-block))
  3335. (subtree (markdown-end-of-subtree))
  3336. (header (markdown-end-of-defun)))
  3337. ;; Skip backwards over local variables. This logic is similar to the one
  3338. ;; used in ‘hack-local-variables’.
  3339. (when (and enable-local-variables (eobp))
  3340. (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move)
  3341. (when (let ((case-fold-search t))
  3342. (search-forward "Local Variables:" nil :move))
  3343. (beginning-of-line 0)
  3344. (when (eq (char-before) ?\n) (backward-char))))
  3345. (unless (or (markdown-cur-line-blank-p)
  3346. (thing-at-point-looking-at markdown-regex-reference-definition))
  3347. (insert "\n"))
  3348. (insert "\n[" label "]: ")
  3349. (if url
  3350. (insert url)
  3351. ;; When no URL is given, leave point at END following the colon
  3352. (setq end (point)))
  3353. (when (> (length title) 0)
  3354. (insert " \"" title "\""))
  3355. (unless (looking-at-p "\n")
  3356. (insert "\n"))
  3357. (goto-char end)
  3358. (when url
  3359. (message
  3360. (markdown--substitute-command-keys
  3361. "Reference [%s] was defined, press \\[markdown-do] to jump there")
  3362. label))))
  3363. (defcustom markdown-link-make-text-function nil
  3364. "Function that automatically generates a link text for a URL.
  3365. If non-nil, this function will be called by
  3366. `markdown--insert-link-or-image' and the result will be the
  3367. default link text. The function should receive exactly one
  3368. argument that corresponds to the link URL."
  3369. :group 'markdown
  3370. :type 'function
  3371. :package-version '(markdown-mode . "2.5"))
  3372. (defcustom markdown-disable-tooltip-prompt nil
  3373. "Disable prompt for tooltip when inserting a link or image.
  3374. If non-nil, `markdown-insert-link' and `markdown-insert-link'
  3375. will not prompt the user to insert a tooltip text for the given
  3376. link or image."
  3377. :group 'markdown
  3378. :type 'boolean
  3379. :safe 'booleanp
  3380. :package-version '(markdown-mode . "2.5"))
  3381. (defun markdown--insert-link-or-image (image)
  3382. "Interactively insert new or update an existing link or image.
  3383. When IMAGE is non-nil, insert an image. Otherwise, insert a link.
  3384. This is an internal function called by
  3385. `markdown-insert-link' and `markdown-insert-image'."
  3386. (cl-multiple-value-bind (begin end text uri ref title)
  3387. (if (use-region-p)
  3388. ;; Use region as either link text or URL as appropriate.
  3389. (let ((region (buffer-substring-no-properties
  3390. (region-beginning) (region-end))))
  3391. (if (string-match markdown-regex-uri region)
  3392. ;; Region contains a URL; use it as such.
  3393. (list (region-beginning) (region-end)
  3394. nil (match-string 0 region) nil nil)
  3395. ;; Region doesn't contain a URL, so use it as text.
  3396. (list (region-beginning) (region-end)
  3397. region nil nil nil)))
  3398. ;; Extract and use properties of existing link, if any.
  3399. (markdown-link-at-pos (point)))
  3400. (let* ((ref (when ref (concat "[" ref "]")))
  3401. (defined-refs (mapcar #'car (markdown-get-defined-references)))
  3402. (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs))
  3403. (used-uris (markdown-get-used-uris))
  3404. (uri-or-ref (completing-read
  3405. "URL or [reference]: "
  3406. (append defined-ref-cands used-uris)
  3407. nil nil (or uri ref)))
  3408. (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref)
  3409. (match-string 1 uri-or-ref))
  3410. ((string-equal "" uri-or-ref)
  3411. "")))
  3412. (uri (unless ref uri-or-ref))
  3413. (text-prompt (if image
  3414. "Alt text: "
  3415. (if ref
  3416. "Link text: "
  3417. "Link text (blank for plain URL): ")))
  3418. (text (or text (and markdown-link-make-text-function uri
  3419. (funcall markdown-link-make-text-function uri))))
  3420. (text (completing-read text-prompt defined-refs nil nil text))
  3421. (text (if (= (length text) 0) nil text))
  3422. (plainp (and uri (not text)))
  3423. (implicitp (string-equal ref ""))
  3424. (ref (if implicitp text ref))
  3425. (definedp (and ref (markdown-reference-definition ref)))
  3426. (ref-url (unless (or uri definedp)
  3427. (completing-read "Reference URL: " used-uris)))
  3428. (title (unless (or plainp definedp markdown-disable-tooltip-prompt)
  3429. (read-string "Title (tooltip text, optional): " title)))
  3430. (title (if (= (length title) 0) nil title)))
  3431. (when (and image implicitp)
  3432. (user-error "Reference required: implicit image references are invalid"))
  3433. (when (and begin end)
  3434. (delete-region begin end))
  3435. (cond
  3436. ((and (not image) uri text)
  3437. (markdown-insert-inline-link text uri title))
  3438. ((and image uri text)
  3439. (markdown-insert-inline-image text uri title))
  3440. ((and ref text)
  3441. (if image
  3442. (markdown-insert-reference-image text (unless implicitp ref) nil title)
  3443. (markdown-insert-reference-link text (unless implicitp ref) nil title))
  3444. (unless definedp
  3445. (markdown-insert-reference-definition ref ref-url title)))
  3446. ((and (not image) uri)
  3447. (markdown-insert-uri uri))))))
  3448. (defun markdown-insert-link ()
  3449. "Insert new or update an existing link, with interactive prompts.
  3450. If the point is at an existing link or URL, update the link text,
  3451. URL, reference label, and/or title. Otherwise, insert a new link.
  3452. The type of link inserted (inline, reference, or plain URL)
  3453. depends on which values are provided:
  3454. * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
  3455. * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
  3456. * If only TEXT is given, insert an implicit reference link: [TEXT][].
  3457. * If only a URL is given, insert a plain link: <URL>.
  3458. In other words, to create an implicit reference link, leave the
  3459. URL prompt empty and to create a plain URL link, leave the link
  3460. text empty.
  3461. If there is an active region, use the text as the default URL, if
  3462. it seems to be a URL, or link text value otherwise.
  3463. If a given reference is not defined, this function will
  3464. additionally prompt for the URL and optional title. In this case,
  3465. the reference definition is placed at the location determined by
  3466. `markdown-reference-location'. In addition, it is possible to
  3467. have the `markdown-link-make-text-function' function, if non-nil,
  3468. define the default link text before prompting the user for it.
  3469. If `markdown-disable-tooltip-prompt' is non-nil, the user will
  3470. not be prompted to add or modify a tooltip text.
  3471. Through updating the link, this function can be used to convert a
  3472. link of one type (inline, reference, or plain) to another type by
  3473. selectively adding or removing information via the prompts."
  3474. (interactive)
  3475. (markdown--insert-link-or-image nil))
  3476. (defun markdown-insert-image ()
  3477. "Insert new or update an existing image, with interactive prompts.
  3478. If the point is at an existing image, update the alt text, URL,
  3479. reference label, and/or title. Otherwise, insert a new image.
  3480. The type of image inserted (inline or reference) depends on which
  3481. values are provided:
  3482. * If a URL and ALT-TEXT are given, insert an inline image:
  3483. ![ALT-TEXT](URL).
  3484. * If [REF] and ALT-TEXT are given, insert a reference image:
  3485. ![ALT-TEXT][REF].
  3486. If there is an active region, use the text as the default URL, if
  3487. it seems to be a URL, or alt text value otherwise.
  3488. If a given reference is not defined, this function will
  3489. additionally prompt for the URL and optional title. In this case,
  3490. the reference definition is placed at the location determined by
  3491. `markdown-reference-location'.
  3492. Through updating the image, this function can be used to convert an
  3493. image of one type (inline or reference) to another type by
  3494. selectively adding or removing information via the prompts."
  3495. (interactive)
  3496. (markdown--insert-link-or-image t))
  3497. (defun markdown-insert-uri (&optional uri)
  3498. "Insert markup for an inline URI.
  3499. If there is an active region, use it as the URI. If the point is
  3500. at a URI, wrap it with angle brackets. If the point is at an
  3501. inline URI, remove the angle brackets. Otherwise, simply insert
  3502. angle brackets place the point between them."
  3503. (interactive)
  3504. (if (use-region-p)
  3505. ;; Active region
  3506. (let ((bounds (markdown-unwrap-things-in-region
  3507. (region-beginning) (region-end)
  3508. markdown-regex-angle-uri 0 2)))
  3509. (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds)))
  3510. ;; Markup removal, URI at point, new URI, or empty markup insertion
  3511. (if (thing-at-point-looking-at markdown-regex-angle-uri)
  3512. (markdown-unwrap-thing-at-point nil 0 2)
  3513. (if uri
  3514. (insert "<" uri ">")
  3515. (markdown-wrap-or-insert "<" ">" 'url nil nil)))))
  3516. (defun markdown-insert-wiki-link ()
  3517. "Insert a wiki link of the form [[WikiLink]].
  3518. If there is an active region, use the region as the link text.
  3519. If the point is at a word, use the word as the link text. If
  3520. there is no active region and the point is not at word, simply
  3521. insert link markup."
  3522. (interactive)
  3523. (if (use-region-p)
  3524. ;; Active region
  3525. (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end))
  3526. ;; Markup removal, wiki link at at point, or empty markup insertion
  3527. (if (thing-at-point-looking-at markdown-regex-wiki-link)
  3528. (if (or markdown-wiki-link-alias-first
  3529. (null (match-string 5)))
  3530. (markdown-unwrap-thing-at-point nil 1 3)
  3531. (markdown-unwrap-thing-at-point nil 1 5))
  3532. (markdown-wrap-or-insert "[[" "]]"))))
  3533. (defun markdown-remove-header ()
  3534. "Remove header markup if point is at a header.
  3535. Return bounds of remaining header text if a header was removed
  3536. and nil otherwise."
  3537. (interactive "*")
  3538. (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2)
  3539. (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1)))
  3540. (defun markdown-insert-header (&optional level text setext)
  3541. "Insert or replace header markup.
  3542. The level of the header is specified by LEVEL and header text is
  3543. given by TEXT. LEVEL must be an integer from 1 and 6, and the
  3544. default value is 1.
  3545. When TEXT is nil, the header text is obtained as follows.
  3546. If there is an active region, it is used as the header text.
  3547. Otherwise, the current line will be used as the header text.
  3548. If there is not an active region and the point is at a header,
  3549. remove the header markup and replace with level N header.
  3550. Otherwise, insert empty header markup and place the point in
  3551. between.
  3552. The style of the header will be atx (hash marks) unless
  3553. SETEXT is non-nil, in which case a setext-style (underlined)
  3554. header will be inserted."
  3555. (interactive "p\nsHeader text: ")
  3556. (setq level (min (max (or level 1) 1) (if setext 2 6)))
  3557. ;; Determine header text if not given
  3558. (when (null text)
  3559. (if (use-region-p)
  3560. ;; Active region
  3561. (setq text (delete-and-extract-region (region-beginning) (region-end)))
  3562. ;; No active region
  3563. (markdown-remove-header)
  3564. (setq text (delete-and-extract-region
  3565. (line-beginning-position) (line-end-position)))
  3566. (when (and setext (string-match-p "^[ \t]*$" text))
  3567. (setq text (read-string "Header text: "))))
  3568. (setq text (markdown-compress-whitespace-string text)))
  3569. ;; Insertion with given text
  3570. (markdown-ensure-blank-line-before)
  3571. (let (hdr)
  3572. (cond (setext
  3573. (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=)))
  3574. (insert text "\n" hdr))
  3575. (t
  3576. (setq hdr (make-string level ?#))
  3577. (insert hdr " " text)
  3578. (when (null markdown-asymmetric-header) (insert " " hdr)))))
  3579. (markdown-ensure-blank-line-after)
  3580. ;; Leave point at end of text
  3581. (cond (setext
  3582. (backward-char (1+ (string-width text))))
  3583. ((null markdown-asymmetric-header)
  3584. (backward-char (1+ level)))))
  3585. (defun markdown-insert-header-dwim (&optional arg setext)
  3586. "Insert or replace header markup.
  3587. The level and type of the header are determined automatically by
  3588. the type and level of the previous header, unless a prefix
  3589. argument is given via ARG.
  3590. With a numeric prefix valued 1 to 6, insert a header of the given
  3591. level, with the type being determined automatically (note that
  3592. only level 1 or 2 setext headers are possible).
  3593. With a \\[universal-argument] prefix (i.e., when ARG is (4)),
  3594. promote the heading by one level.
  3595. With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
  3596. demote the heading by one level.
  3597. When SETEXT is non-nil, prefer setext-style headers when
  3598. possible (levels one and two).
  3599. When there is an active region, use it for the header text. When
  3600. the point is at an existing header, change the type and level
  3601. according to the rules above.
  3602. Otherwise, if the line is not empty, create a header using the
  3603. text on the current line as the header text.
  3604. Finally, if the point is on a blank line, insert empty header
  3605. markup (atx) or prompt for text (setext).
  3606. See `markdown-insert-header' for more details about how the
  3607. header text is determined."
  3608. (interactive "*P")
  3609. (let (level)
  3610. (save-excursion
  3611. (when (or (thing-at-point-looking-at markdown-regex-header)
  3612. (re-search-backward markdown-regex-header nil t))
  3613. ;; level of current or previous header
  3614. (setq level (markdown-outline-level))
  3615. ;; match group 1 indicates a setext header
  3616. (setq setext (match-end 1))))
  3617. ;; check prefix argument
  3618. (cond
  3619. ((and (equal arg '(4)) level (> level 1)) ;; C-u
  3620. (cl-decf level))
  3621. ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u
  3622. (cl-incf level))
  3623. (arg ;; numeric prefix
  3624. (setq level (prefix-numeric-value arg))))
  3625. ;; setext headers must be level one or two
  3626. (and level (setq setext (and setext (<= level 2))))
  3627. ;; insert the heading
  3628. (markdown-insert-header level nil setext)))
  3629. (defun markdown-insert-header-setext-dwim (&optional arg)
  3630. "Insert or replace header markup, with preference for setext.
  3631. See `markdown-insert-header-dwim' for details, including how ARG is handled."
  3632. (interactive "*P")
  3633. (markdown-insert-header-dwim arg t))
  3634. (defun markdown-insert-header-atx-1 ()
  3635. "Insert a first level atx-style (hash mark) header.
  3636. See `markdown-insert-header'."
  3637. (interactive "*")
  3638. (markdown-insert-header 1 nil nil))
  3639. (defun markdown-insert-header-atx-2 ()
  3640. "Insert a level two atx-style (hash mark) header.
  3641. See `markdown-insert-header'."
  3642. (interactive "*")
  3643. (markdown-insert-header 2 nil nil))
  3644. (defun markdown-insert-header-atx-3 ()
  3645. "Insert a level three atx-style (hash mark) header.
  3646. See `markdown-insert-header'."
  3647. (interactive "*")
  3648. (markdown-insert-header 3 nil nil))
  3649. (defun markdown-insert-header-atx-4 ()
  3650. "Insert a level four atx-style (hash mark) header.
  3651. See `markdown-insert-header'."
  3652. (interactive "*")
  3653. (markdown-insert-header 4 nil nil))
  3654. (defun markdown-insert-header-atx-5 ()
  3655. "Insert a level five atx-style (hash mark) header.
  3656. See `markdown-insert-header'."
  3657. (interactive "*")
  3658. (markdown-insert-header 5 nil nil))
  3659. (defun markdown-insert-header-atx-6 ()
  3660. "Insert a sixth level atx-style (hash mark) header.
  3661. See `markdown-insert-header'."
  3662. (interactive "*")
  3663. (markdown-insert-header 6 nil nil))
  3664. (defun markdown-insert-header-setext-1 ()
  3665. "Insert a setext-style (underlined) first-level header.
  3666. See `markdown-insert-header'."
  3667. (interactive "*")
  3668. (markdown-insert-header 1 nil t))
  3669. (defun markdown-insert-header-setext-2 ()
  3670. "Insert a setext-style (underlined) second-level header.
  3671. See `markdown-insert-header'."
  3672. (interactive "*")
  3673. (markdown-insert-header 2 nil t))
  3674. (defun markdown-blockquote-indentation (loc)
  3675. "Return string containing necessary indentation for a blockquote at LOC.
  3676. Also see `markdown-pre-indentation'."
  3677. (save-excursion
  3678. (goto-char loc)
  3679. (let* ((list-level (length (markdown-calculate-list-levels)))
  3680. (indent ""))
  3681. (dotimes (_ list-level indent)
  3682. (setq indent (concat indent " "))))))
  3683. (defun markdown-insert-blockquote ()
  3684. "Start a blockquote section (or blockquote the region).
  3685. If Transient Mark mode is on and a region is active, it is used as
  3686. the blockquote text."
  3687. (interactive)
  3688. (if (use-region-p)
  3689. (markdown-blockquote-region (region-beginning) (region-end))
  3690. (markdown-ensure-blank-line-before)
  3691. (insert (markdown-blockquote-indentation (point)) "> ")
  3692. (markdown-ensure-blank-line-after)))
  3693. (defun markdown-block-region (beg end prefix)
  3694. "Format the region using a block prefix.
  3695. Arguments BEG and END specify the beginning and end of the
  3696. region. The characters PREFIX will appear at the beginning
  3697. of each line."
  3698. (save-excursion
  3699. (let* ((end-marker (make-marker))
  3700. (beg-marker (make-marker))
  3701. (prefix-without-trailing-whitespace
  3702. (replace-regexp-in-string (rx (+ blank) eos) "" prefix)))
  3703. ;; Ensure blank line after and remove extra whitespace
  3704. (goto-char end)
  3705. (skip-syntax-backward "-")
  3706. (set-marker end-marker (point))
  3707. (delete-horizontal-space)
  3708. (markdown-ensure-blank-line-after)
  3709. ;; Ensure blank line before and remove extra whitespace
  3710. (goto-char beg)
  3711. (skip-syntax-forward "-")
  3712. (delete-horizontal-space)
  3713. (markdown-ensure-blank-line-before)
  3714. (set-marker beg-marker (point))
  3715. ;; Insert PREFIX before each line
  3716. (goto-char beg-marker)
  3717. (while (and (< (line-beginning-position) end-marker)
  3718. (not (eobp)))
  3719. ;; Don’t insert trailing whitespace.
  3720. (insert (if (eolp) prefix-without-trailing-whitespace prefix))
  3721. (forward-line)))))
  3722. (defun markdown-blockquote-region (beg end)
  3723. "Blockquote the region.
  3724. Arguments BEG and END specify the beginning and end of the region."
  3725. (interactive "*r")
  3726. (markdown-block-region
  3727. beg end (concat (markdown-blockquote-indentation
  3728. (max (point-min) (1- beg))) "> ")))
  3729. (defun markdown-pre-indentation (loc)
  3730. "Return string containing necessary whitespace for a pre block at LOC.
  3731. Also see `markdown-blockquote-indentation'."
  3732. (save-excursion
  3733. (goto-char loc)
  3734. (let* ((list-level (length (markdown-calculate-list-levels)))
  3735. indent)
  3736. (dotimes (_ (1+ list-level) indent)
  3737. (setq indent (concat indent " "))))))
  3738. (defun markdown-insert-pre ()
  3739. "Start a preformatted section (or apply to the region).
  3740. If Transient Mark mode is on and a region is active, it is marked
  3741. as preformatted text."
  3742. (interactive)
  3743. (if (use-region-p)
  3744. (markdown-pre-region (region-beginning) (region-end))
  3745. (markdown-ensure-blank-line-before)
  3746. (insert (markdown-pre-indentation (point)))
  3747. (markdown-ensure-blank-line-after)))
  3748. (defun markdown-pre-region (beg end)
  3749. "Format the region as preformatted text.
  3750. Arguments BEG and END specify the beginning and end of the region."
  3751. (interactive "*r")
  3752. (let ((indent (markdown-pre-indentation (max (point-min) (1- beg)))))
  3753. (markdown-block-region beg end indent)))
  3754. (defun markdown-electric-backquote (arg)
  3755. "Insert a backquote.
  3756. The numeric prefix argument ARG says how many times to repeat the insertion.
  3757. Call `markdown-insert-gfm-code-block' interactively
  3758. if three backquotes inserted at the beginning of line."
  3759. (interactive "*P")
  3760. (self-insert-command (prefix-numeric-value arg))
  3761. (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil))
  3762. (replace-match "")
  3763. (call-interactively #'markdown-insert-gfm-code-block)))
  3764. (defconst markdown-gfm-recognized-languages
  3765. ;; To reproduce/update, evaluate the let-form in
  3766. ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
  3767. ;; but with appropriate use of a keyboard macro, indenting and filling it
  3768. ;; properly is pretty fast.
  3769. '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
  3770. "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada"
  3771. "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer"
  3772. "AngelScript" "Ant-Build-System" "ApacheConf" "Apex"
  3773. "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly"
  3774. "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile"
  3775. "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax"
  3776. "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump"
  3777. "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb"
  3778. "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
  3779. "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
  3780. "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript"
  3781. "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language"
  3782. "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound"
  3783. "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump"
  3784. "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch"
  3785. "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript"
  3786. "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild"
  3787. "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm"
  3788. "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor"
  3789. "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth"
  3790. "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS"
  3791. "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN"
  3792. "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass"
  3793. "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config"
  3794. "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu"
  3795. "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL"
  3796. "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML"
  3797. "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP"
  3798. "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC"
  3799. "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7"
  3800. "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON"
  3801. "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java"
  3802. "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison"
  3803. "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout"
  3804. "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE"
  3805. "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
  3806. "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
  3807. "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript"
  3808. "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB"
  3809. "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako"
  3810. "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki"
  3811. "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah"
  3812. "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode"
  3813. "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL"
  3814. "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
  3815. "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
  3816. "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C"
  3817. "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal"
  3818. "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript"
  3819. "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox"
  3820. "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus"
  3821. "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn"
  3822. "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod"
  3823. "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell"
  3824. "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer"
  3825. "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
  3826. "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc"
  3827. "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket"
  3828. "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol"
  3829. "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript"
  3830. "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage"
  3831. "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
  3832. "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass"
  3833. "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
  3834. "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity"
  3835. "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark"
  3836. "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift"
  3837. "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh"
  3838. "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle"
  3839. "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
  3840. "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL"
  3841. "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue"
  3842. "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly"
  3843. "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok"
  3844. "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap"
  3845. "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS"
  3846. "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL"
  3847. "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors"
  3848. "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc"
  3849. "reStructuredText" "sed" "wdl" "wisp" "xBase")
  3850. "Language specifiers recognized by GitHub's syntax highlighting features.")
  3851. (defvar-local markdown-gfm-used-languages nil
  3852. "Language names used in GFM code blocks.")
  3853. (defun markdown-trim-whitespace (str)
  3854. (replace-regexp-in-string
  3855. "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str))
  3856. (defun markdown-clean-language-string (str)
  3857. (replace-regexp-in-string
  3858. "{\\.?\\|}" "" (markdown-trim-whitespace str)))
  3859. (defun markdown-validate-language-string (widget)
  3860. (let ((str (widget-value widget)))
  3861. (unless (string= str (markdown-clean-language-string str))
  3862. (widget-put widget :error (format "Invalid language spec: '%s'" str))
  3863. widget)))
  3864. (defun markdown-gfm-get-corpus ()
  3865. "Create corpus of recognized GFM code block languages for the given buffer."
  3866. (let ((given-corpus (append markdown-gfm-additional-languages
  3867. markdown-gfm-recognized-languages)))
  3868. (append
  3869. markdown-gfm-used-languages
  3870. (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus)
  3871. given-corpus))))
  3872. (defun markdown-gfm-add-used-language (lang)
  3873. "Clean LANG and add to list of used languages."
  3874. (setq markdown-gfm-used-languages
  3875. (cons lang (remove lang markdown-gfm-used-languages))))
  3876. (defcustom markdown-spaces-after-code-fence 1
  3877. "Number of space characters to insert after a code fence.
  3878. \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
  3879. opening code fence and an info string."
  3880. :group 'markdown
  3881. :type 'integer
  3882. :safe #'natnump
  3883. :package-version '(markdown-mode . "2.3"))
  3884. (defcustom markdown-code-block-braces nil
  3885. "When non-nil, automatically insert braces for GFM code blocks."
  3886. :group 'markdown
  3887. :type 'boolean)
  3888. (defun markdown-insert-gfm-code-block (&optional lang edit)
  3889. "Insert GFM code block for language LANG.
  3890. If LANG is nil, the language will be queried from user. If a
  3891. region is active, wrap this region with the markup instead. If
  3892. the region boundaries are not on empty lines, these are added
  3893. automatically in order to have the correct markup. When EDIT is
  3894. non-nil (e.g., when \\[universal-argument] is given), edit the
  3895. code block in an indirect buffer after insertion."
  3896. (interactive
  3897. (list (let ((completion-ignore-case nil))
  3898. (condition-case nil
  3899. (markdown-clean-language-string
  3900. (completing-read
  3901. "Programming language: "
  3902. (markdown-gfm-get-corpus)
  3903. nil 'confirm (car markdown-gfm-used-languages)
  3904. 'markdown-gfm-language-history))
  3905. (quit "")))
  3906. current-prefix-arg))
  3907. (unless (string= lang "") (markdown-gfm-add-used-language lang))
  3908. (when (and (> (length lang) 0)
  3909. (not markdown-code-block-braces))
  3910. (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s)
  3911. lang)))
  3912. (let ((gfm-open-brace (if markdown-code-block-braces "{" ""))
  3913. (gfm-close-brace (if markdown-code-block-braces "}" "")))
  3914. (if (use-region-p)
  3915. (let* ((b (region-beginning)) (e (region-end)) end
  3916. (indent (progn (goto-char b) (current-indentation))))
  3917. (goto-char e)
  3918. ;; if we're on a blank line, don't newline, otherwise the ```
  3919. ;; should go on its own line
  3920. (unless (looking-back "\n" nil)
  3921. (newline))
  3922. (indent-to indent)
  3923. (insert "```")
  3924. (markdown-ensure-blank-line-after)
  3925. (setq end (point))
  3926. (goto-char b)
  3927. ;; if we're on a blank line, insert the quotes here, otherwise
  3928. ;; add a new line first
  3929. (unless (looking-at-p "\n")
  3930. (newline)
  3931. (forward-line -1))
  3932. (markdown-ensure-blank-line-before)
  3933. (indent-to indent)
  3934. (insert "```" gfm-open-brace lang gfm-close-brace)
  3935. (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end))
  3936. (let ((indent (current-indentation))
  3937. start-bol)
  3938. (delete-horizontal-space :backward-only)
  3939. (markdown-ensure-blank-line-before)
  3940. (indent-to indent)
  3941. (setq start-bol (point-at-bol))
  3942. (insert "```" gfm-open-brace lang gfm-close-brace "\n")
  3943. (indent-to indent)
  3944. (unless edit (insert ?\n))
  3945. (indent-to indent)
  3946. (insert "```")
  3947. (markdown-ensure-blank-line-after)
  3948. (markdown-syntax-propertize-fenced-block-constructs start-bol (point)))
  3949. (end-of-line 0)
  3950. (when edit (markdown-edit-code-block)))))
  3951. (defun markdown-code-block-lang (&optional pos-prop)
  3952. "Return the language name for a GFM or tilde fenced code block.
  3953. The beginning of the block may be described by POS-PROP,
  3954. a cons of (pos . prop) giving the position and property
  3955. at the beginning of the block."
  3956. (or pos-prop
  3957. (setq pos-prop
  3958. (markdown-max-of-seq
  3959. #'car
  3960. (cl-remove-if
  3961. #'null
  3962. (cl-mapcar
  3963. #'markdown-find-previous-prop
  3964. (markdown-get-fenced-block-begin-properties))))))
  3965. (when pos-prop
  3966. (goto-char (car pos-prop))
  3967. (set-match-data (get-text-property (point) (cdr pos-prop)))
  3968. ;; Note: Hard-coded group number assumes tilde
  3969. ;; and GFM fenced code regexp groups agree.
  3970. (let ((begin (match-beginning 3))
  3971. (end (match-end 3)))
  3972. (when (and begin end)
  3973. ;; Fix language strings beginning with periods, like ".ruby".
  3974. (when (eq (char-after begin) ?.)
  3975. (setq begin (1+ begin)))
  3976. (buffer-substring-no-properties begin end)))))
  3977. (defun markdown-gfm-parse-buffer-for-languages (&optional buffer)
  3978. (with-current-buffer (or buffer (current-buffer))
  3979. (save-excursion
  3980. (goto-char (point-min))
  3981. (cl-loop
  3982. with prop = 'markdown-gfm-block-begin
  3983. for pos-prop = (markdown-find-next-prop prop)
  3984. while pos-prop
  3985. for lang = (markdown-code-block-lang pos-prop)
  3986. do (progn (when lang (markdown-gfm-add-used-language lang))
  3987. (goto-char (next-single-property-change (point) prop)))))))
  3988. ;;; Footnotes =================================================================
  3989. (defun markdown-footnote-counter-inc ()
  3990. "Increment `markdown-footnote-counter' and return the new value."
  3991. (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet.
  3992. (save-excursion
  3993. (goto-char (point-min))
  3994. (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:")
  3995. (point-max) t)
  3996. (let ((fn (string-to-number (match-string 1))))
  3997. (when (> fn markdown-footnote-counter)
  3998. (setq markdown-footnote-counter fn))))))
  3999. (cl-incf markdown-footnote-counter))
  4000. (defun markdown-insert-footnote ()
  4001. "Insert footnote with a new number and move point to footnote definition."
  4002. (interactive)
  4003. (let ((fn (markdown-footnote-counter-inc)))
  4004. (insert (format "[^%d]" fn))
  4005. (markdown-footnote-text-find-new-location)
  4006. (markdown-ensure-blank-line-before)
  4007. (unless (markdown-cur-line-blank-p)
  4008. (insert "\n"))
  4009. (insert (format "[^%d]: " fn))
  4010. (markdown-ensure-blank-line-after)))
  4011. (defun markdown-footnote-text-find-new-location ()
  4012. "Position the point at the proper location for a new footnote text."
  4013. (cond
  4014. ((eq markdown-footnote-location 'end) (goto-char (point-max)))
  4015. ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block))
  4016. ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree))
  4017. ((eq markdown-footnote-location 'header) (markdown-end-of-defun))))
  4018. (defun markdown-footnote-kill ()
  4019. "Kill the footnote at point.
  4020. The footnote text is killed (and added to the kill ring), the
  4021. footnote marker is deleted. Point has to be either at the
  4022. footnote marker or in the footnote text."
  4023. (interactive)
  4024. (let ((marker-pos nil)
  4025. (skip-deleting-marker nil)
  4026. (starting-footnote-text-positions
  4027. (markdown-footnote-text-positions)))
  4028. (when starting-footnote-text-positions
  4029. ;; We're starting in footnote text, so mark our return position and jump
  4030. ;; to the marker if possible.
  4031. (let ((marker-pos (markdown-footnote-find-marker
  4032. (cl-first starting-footnote-text-positions))))
  4033. (if marker-pos
  4034. (goto-char (1- marker-pos))
  4035. ;; If there isn't a marker, we still want to kill the text.
  4036. (setq skip-deleting-marker t))))
  4037. ;; Either we didn't start in the text, or we started in the text and jumped
  4038. ;; to the marker. We want to assume we're at the marker now and error if
  4039. ;; we're not.
  4040. (unless skip-deleting-marker
  4041. (let ((marker (markdown-footnote-delete-marker)))
  4042. (unless marker
  4043. (error "Not at a footnote"))
  4044. ;; Even if we knew the text position before, it changed when we deleted
  4045. ;; the label.
  4046. (setq marker-pos (cl-second marker))
  4047. (let ((new-text-pos (markdown-footnote-find-text (cl-first marker))))
  4048. (unless new-text-pos
  4049. (error "No text for footnote `%s'" (cl-first marker)))
  4050. (goto-char new-text-pos))))
  4051. (let ((pos (markdown-footnote-kill-text)))
  4052. (goto-char (if starting-footnote-text-positions
  4053. pos
  4054. marker-pos)))))
  4055. (defun markdown-footnote-delete-marker ()
  4056. "Delete a footnote marker at point.
  4057. Returns a list (ID START) containing the footnote ID and the
  4058. start position of the marker before deletion. If no footnote
  4059. marker was deleted, this function returns NIL."
  4060. (let ((marker (markdown-footnote-marker-positions)))
  4061. (when marker
  4062. (delete-region (cl-second marker) (cl-third marker))
  4063. (butlast marker))))
  4064. (defun markdown-footnote-kill-text ()
  4065. "Kill footnote text at point.
  4066. Returns the start position of the footnote text before deletion,
  4067. or NIL if point was not inside a footnote text.
  4068. The killed text is placed in the kill ring (without the footnote
  4069. number)."
  4070. (let ((fn (markdown-footnote-text-positions)))
  4071. (when fn
  4072. (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn))))
  4073. (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text)
  4074. (kill-new (match-string 1 text))
  4075. (when (and (markdown-cur-line-blank-p)
  4076. (markdown-prev-line-blank-p)
  4077. (not (bobp)))
  4078. (delete-region (1- (point)) (point)))
  4079. (cl-second fn)))))
  4080. (defun markdown-footnote-goto-text ()
  4081. "Jump to the text of the footnote at point."
  4082. (interactive)
  4083. (let ((fn (car (markdown-footnote-marker-positions))))
  4084. (unless fn
  4085. (user-error "Not at a footnote marker"))
  4086. (let ((new-pos (markdown-footnote-find-text fn)))
  4087. (unless new-pos
  4088. (error "No definition found for footnote `%s'" fn))
  4089. (goto-char new-pos))))
  4090. (defun markdown-footnote-return ()
  4091. "Return from a footnote to its footnote number in the main text."
  4092. (interactive)
  4093. (let ((fn (save-excursion
  4094. (car (markdown-footnote-text-positions)))))
  4095. (unless fn
  4096. (user-error "Not in a footnote"))
  4097. (let ((new-pos (markdown-footnote-find-marker fn)))
  4098. (unless new-pos
  4099. (error "Footnote marker `%s' not found" fn))
  4100. (goto-char new-pos))))
  4101. (defun markdown-footnote-find-marker (id)
  4102. "Find the location of the footnote marker with ID.
  4103. The actual buffer position returned is the position directly
  4104. following the marker's closing bracket. If no marker is found,
  4105. NIL is returned."
  4106. (save-excursion
  4107. (goto-char (point-min))
  4108. (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t)
  4109. (skip-chars-backward "^]")
  4110. (point))))
  4111. (defun markdown-footnote-find-text (id)
  4112. "Find the location of the text of footnote ID.
  4113. The actual buffer position returned is the position of the first
  4114. character of the text, after the footnote's identifier. If no
  4115. footnote text is found, NIL is returned."
  4116. (save-excursion
  4117. (goto-char (point-min))
  4118. (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t)
  4119. (skip-chars-forward "[ \t]")
  4120. (point))))
  4121. (defun markdown-footnote-marker-positions ()
  4122. "Return the position and ID of the footnote marker point is on.
  4123. The return value is a list (ID START END). If point is not on a
  4124. footnote, NIL is returned."
  4125. ;; first make sure we're at a footnote marker
  4126. (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position))
  4127. (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]")))
  4128. (save-excursion
  4129. ;; move point between [ and ^:
  4130. (if (looking-at-p "\\[")
  4131. (forward-char 1)
  4132. (skip-chars-backward "^["))
  4133. (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]"))
  4134. (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
  4135. (defun markdown-footnote-text-positions ()
  4136. "Return the start and end positions of the footnote text point is in.
  4137. The exact return value is a list of three elements: (ID START END).
  4138. The start position is the position of the opening bracket
  4139. of the footnote id. The end position is directly after the
  4140. newline that ends the footnote. If point is not in a footnote,
  4141. NIL is returned instead."
  4142. (save-excursion
  4143. (let (result)
  4144. (move-beginning-of-line 1)
  4145. ;; Try to find the label. If we haven't found the label and we're at a blank
  4146. ;; or indented line, back up if possible.
  4147. (while (and
  4148. (not (and (looking-at markdown-regex-footnote-definition)
  4149. (setq result (list (match-string 1) (point)))))
  4150. (and (not (bobp))
  4151. (or (markdown-cur-line-blank-p)
  4152. (>= (current-indentation) 4))))
  4153. (forward-line -1))
  4154. (when result
  4155. ;; Advance if there is a next line that is either blank or indented.
  4156. ;; (Need to check if we're on the last line, because
  4157. ;; markdown-next-line-blank-p returns true for last line in buffer.)
  4158. (while (and (/= (line-end-position) (point-max))
  4159. (or (markdown-next-line-blank-p)
  4160. (>= (markdown-next-line-indent) 4)))
  4161. (forward-line))
  4162. ;; Move back while the current line is blank.
  4163. (while (markdown-cur-line-blank-p)
  4164. (forward-line -1))
  4165. ;; Advance to capture this line and a single trailing newline (if there
  4166. ;; is one).
  4167. (forward-line)
  4168. (append result (list (point)))))))
  4169. (defun markdown-get-defined-footnotes ()
  4170. "Return a list of all defined footnotes.
  4171. Result is an alist of pairs (MARKER . LINE), where MARKER is the
  4172. footnote marker, a string, and LINE is the line number containing
  4173. the footnote definition.
  4174. For example, suppose the following footnotes are defined at positions
  4175. 448 and 475:
  4176. \[^1]: First footnote here.
  4177. \[^marker]: Second footnote.
  4178. Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
  4179. (save-excursion
  4180. (goto-char (point-min))
  4181. (let (footnotes)
  4182. (while (markdown-search-until-condition
  4183. (lambda () (and (not (markdown-code-block-at-point-p))
  4184. (not (markdown-inline-code-at-point-p))
  4185. (not (markdown-in-comment-p))))
  4186. markdown-regex-footnote-definition nil t)
  4187. (let ((marker (match-string-no-properties 1))
  4188. (pos (match-beginning 0)))
  4189. (unless (zerop (length marker))
  4190. (cl-pushnew (cons marker pos) footnotes :test #'equal))))
  4191. (reverse footnotes))))
  4192. ;;; Element Removal ===========================================================
  4193. (defun markdown-kill-thing-at-point ()
  4194. "Kill thing at point and add important text, without markup, to kill ring.
  4195. Possible things to kill include (roughly in order of precedence):
  4196. inline code, headers, horizontal rules, links (add link text to
  4197. kill ring), images (add alt text to kill ring), angle uri, email
  4198. addresses, bold, italics, reference definition (add URI to kill
  4199. ring), footnote markers and text (kill both marker and text, add
  4200. text to kill ring), and list items."
  4201. (interactive "*")
  4202. (let (val)
  4203. (cond
  4204. ;; Inline code
  4205. ((markdown-inline-code-at-point)
  4206. (kill-new (match-string 2))
  4207. (delete-region (match-beginning 0) (match-end 0)))
  4208. ;; ATX header
  4209. ((thing-at-point-looking-at markdown-regex-header-atx)
  4210. (kill-new (match-string 2))
  4211. (delete-region (match-beginning 0) (match-end 0)))
  4212. ;; Setext header
  4213. ((thing-at-point-looking-at markdown-regex-header-setext)
  4214. (kill-new (match-string 1))
  4215. (delete-region (match-beginning 0) (match-end 0)))
  4216. ;; Horizontal rule
  4217. ((thing-at-point-looking-at markdown-regex-hr)
  4218. (kill-new (match-string 0))
  4219. (delete-region (match-beginning 0) (match-end 0)))
  4220. ;; Inline link or image (add link or alt text to kill ring)
  4221. ((thing-at-point-looking-at markdown-regex-link-inline)
  4222. (kill-new (match-string 3))
  4223. (delete-region (match-beginning 0) (match-end 0)))
  4224. ;; Reference link or image (add link or alt text to kill ring)
  4225. ((thing-at-point-looking-at markdown-regex-link-reference)
  4226. (kill-new (match-string 3))
  4227. (delete-region (match-beginning 0) (match-end 0)))
  4228. ;; Angle URI (add URL to kill ring)
  4229. ((thing-at-point-looking-at markdown-regex-angle-uri)
  4230. (kill-new (match-string 2))
  4231. (delete-region (match-beginning 0) (match-end 0)))
  4232. ;; Email address in angle brackets (add email address to kill ring)
  4233. ((thing-at-point-looking-at markdown-regex-email)
  4234. (kill-new (match-string 1))
  4235. (delete-region (match-beginning 0) (match-end 0)))
  4236. ;; Wiki link (add alias text to kill ring)
  4237. ((and markdown-enable-wiki-links
  4238. (thing-at-point-looking-at markdown-regex-wiki-link))
  4239. (kill-new (markdown-wiki-link-alias))
  4240. (delete-region (match-beginning 1) (match-end 1)))
  4241. ;; Bold
  4242. ((thing-at-point-looking-at markdown-regex-bold)
  4243. (kill-new (match-string 4))
  4244. (delete-region (match-beginning 2) (match-end 2)))
  4245. ;; Italics
  4246. ((thing-at-point-looking-at markdown-regex-italic)
  4247. (kill-new (match-string 3))
  4248. (delete-region (match-beginning 1) (match-end 1)))
  4249. ;; Strikethrough
  4250. ((thing-at-point-looking-at markdown-regex-strike-through)
  4251. (kill-new (match-string 4))
  4252. (delete-region (match-beginning 2) (match-end 2)))
  4253. ;; Footnote marker (add footnote text to kill ring)
  4254. ((thing-at-point-looking-at markdown-regex-footnote)
  4255. (markdown-footnote-kill))
  4256. ;; Footnote text (add footnote text to kill ring)
  4257. ((setq val (markdown-footnote-text-positions))
  4258. (markdown-footnote-kill))
  4259. ;; Reference definition (add URL to kill ring)
  4260. ((thing-at-point-looking-at markdown-regex-reference-definition)
  4261. (kill-new (match-string 5))
  4262. (delete-region (match-beginning 0) (match-end 0)))
  4263. ;; List item
  4264. ((setq val (markdown-cur-list-item-bounds))
  4265. (kill-new (delete-and-extract-region (cl-first val) (cl-second val))))
  4266. (t
  4267. (user-error "Nothing found at point to kill")))))
  4268. (defun markdown-kill-outline ()
  4269. "Kill visible heading and add it to `kill-ring'."
  4270. (interactive)
  4271. (save-excursion
  4272. (markdown-outline-previous)
  4273. (kill-region (point) (progn (markdown-outline-next) (point)))))
  4274. (defun markdown-kill-block ()
  4275. "Kill visible code block, list item, or blockquote and add it to `kill-ring'."
  4276. (interactive)
  4277. (save-excursion
  4278. (markdown-backward-block)
  4279. (kill-region (point) (progn (markdown-forward-block) (point)))))
  4280. ;;; Indentation ===============================================================
  4281. (defun markdown-indent-find-next-position (cur-pos positions)
  4282. "Return the position after the index of CUR-POS in POSITIONS.
  4283. Positions are calculated by `markdown-calc-indents'."
  4284. (while (and positions
  4285. (not (equal cur-pos (car positions))))
  4286. (setq positions (cdr positions)))
  4287. (or (cadr positions) 0))
  4288. (defun markdown-outdent-find-next-position (cur-pos positions)
  4289. "Return the maximal element that precedes CUR-POS from POSITIONS.
  4290. Positions are calculated by `markdown-calc-indents'."
  4291. (let ((result 0))
  4292. (dolist (i positions)
  4293. (when (< i cur-pos)
  4294. (setq result (max result i))))
  4295. result))
  4296. (defun markdown-indent-line ()
  4297. "Indent the current line using some heuristics.
  4298. If the _previous_ command was either `markdown-enter-key' or
  4299. `markdown-cycle', then we should cycle to the next
  4300. reasonable indentation position. Otherwise, we could have been
  4301. called directly by `markdown-enter-key', by an initial call of
  4302. `markdown-cycle', or indirectly by `auto-fill-mode'. In
  4303. these cases, indent to the default position.
  4304. Positions are calculated by `markdown-calc-indents'."
  4305. (interactive)
  4306. (let ((positions (markdown-calc-indents))
  4307. (point-pos (current-column))
  4308. (_ (back-to-indentation))
  4309. (cur-pos (current-column)))
  4310. (if (not (equal this-command 'markdown-cycle))
  4311. (indent-line-to (car positions))
  4312. (setq positions (sort (delete-dups positions) '<))
  4313. (let* ((next-pos (markdown-indent-find-next-position cur-pos positions))
  4314. (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0)))
  4315. (indent-line-to next-pos)
  4316. (move-to-column new-point-pos)))))
  4317. (defun markdown-calc-indents ()
  4318. "Return a list of indentation columns to cycle through.
  4319. The first element in the returned list should be considered the
  4320. default indentation level. This function does not worry about
  4321. duplicate positions, which are handled up by calling functions."
  4322. (let (pos prev-line-pos positions)
  4323. ;; Indentation of previous line
  4324. (setq prev-line-pos (markdown-prev-line-indent))
  4325. (setq positions (cons prev-line-pos positions))
  4326. ;; Indentation of previous non-list-marker text
  4327. (when (setq pos (save-excursion
  4328. (forward-line -1)
  4329. (when (looking-at markdown-regex-list)
  4330. (- (match-end 3) (match-beginning 0)))))
  4331. (setq positions (cons pos positions)))
  4332. ;; Indentation required for a pre block in current context
  4333. (setq pos (length (markdown-pre-indentation (point))))
  4334. (setq positions (cons pos positions))
  4335. ;; Indentation of the previous line + tab-width
  4336. (if prev-line-pos
  4337. (setq positions (cons (+ prev-line-pos tab-width) positions))
  4338. (setq positions (cons tab-width positions)))
  4339. ;; Indentation of the previous line - tab-width
  4340. (if (and prev-line-pos (> prev-line-pos tab-width))
  4341. (setq positions (cons (- prev-line-pos tab-width) positions)))
  4342. ;; Indentation of all preceding list markers (when in a list)
  4343. (when (setq pos (markdown-calculate-list-levels))
  4344. (setq positions (append pos positions)))
  4345. ;; First column
  4346. (setq positions (cons 0 positions))
  4347. ;; Return reversed list
  4348. (reverse positions)))
  4349. (defun markdown-enter-key ()
  4350. "Handle RET depending on the context.
  4351. If the point is at a table, move to the next row. Otherwise,
  4352. indent according to value of `markdown-indent-on-enter'.
  4353. When it is nil, simply call `newline'. Otherwise, indent the next line
  4354. following RET using `markdown-indent-line'. Furthermore, when it
  4355. is set to 'indent-and-new-item and the point is in a list item,
  4356. start a new item with the same indentation. If the point is in an
  4357. empty list item, remove it (so that pressing RET twice when in a
  4358. list simply adds a blank line)."
  4359. (interactive)
  4360. (cond
  4361. ;; Table
  4362. ((markdown-table-at-point-p)
  4363. (call-interactively #'markdown-table-next-row))
  4364. ;; Indent non-table text
  4365. (markdown-indent-on-enter
  4366. (let (bounds)
  4367. (if (and (memq markdown-indent-on-enter '(indent-and-new-item))
  4368. (setq bounds (markdown-cur-list-item-bounds)))
  4369. (let ((beg (cl-first bounds))
  4370. (end (cl-second bounds))
  4371. (length (cl-fourth bounds)))
  4372. ;; Point is in a list item
  4373. (if (= (- end beg) length)
  4374. ;; Delete blank list
  4375. (progn
  4376. (delete-region beg end)
  4377. (newline)
  4378. (markdown-indent-line))
  4379. (call-interactively #'markdown-insert-list-item)))
  4380. ;; Point is not in a list
  4381. (newline)
  4382. (markdown-indent-line))))
  4383. ;; Insert a raw newline
  4384. (t (newline))))
  4385. (defun markdown-outdent-or-delete (arg)
  4386. "Handle BACKSPACE by cycling through indentation points.
  4387. When BACKSPACE is pressed, if there is only whitespace
  4388. before the current point, then outdent the line one level.
  4389. Otherwise, do normal delete by repeating
  4390. `backward-delete-char-untabify' ARG times."
  4391. (interactive "*p")
  4392. (if (use-region-p)
  4393. (backward-delete-char-untabify arg)
  4394. (let ((cur-pos (current-column))
  4395. (start-of-indention (save-excursion
  4396. (back-to-indentation)
  4397. (current-column)))
  4398. (positions (markdown-calc-indents)))
  4399. (if (and (> cur-pos 0) (= cur-pos start-of-indention))
  4400. (indent-line-to (markdown-outdent-find-next-position cur-pos positions))
  4401. (backward-delete-char-untabify arg)))))
  4402. (defun markdown-find-leftmost-column (beg end)
  4403. "Find the leftmost column in the region from BEG to END."
  4404. (let ((mincol 1000))
  4405. (save-excursion
  4406. (goto-char beg)
  4407. (while (< (point) end)
  4408. (back-to-indentation)
  4409. (unless (looking-at-p "[ \t]*$")
  4410. (setq mincol (min mincol (current-column))))
  4411. (forward-line 1)
  4412. ))
  4413. mincol))
  4414. (defun markdown-indent-region (beg end arg)
  4415. "Indent the region from BEG to END using some heuristics.
  4416. When ARG is non-nil, outdent the region instead.
  4417. See `markdown-indent-line' and `markdown-indent-line'."
  4418. (interactive "*r\nP")
  4419. (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
  4420. (leftmostcol (markdown-find-leftmost-column beg end))
  4421. (next-pos (if arg
  4422. (markdown-outdent-find-next-position leftmostcol positions)
  4423. (markdown-indent-find-next-position leftmostcol positions))))
  4424. (indent-rigidly beg end (- next-pos leftmostcol))
  4425. (setq deactivate-mark nil)))
  4426. (defun markdown-outdent-region (beg end)
  4427. "Call `markdown-indent-region' on region from BEG to END with prefix."
  4428. (interactive "*r")
  4429. (markdown-indent-region beg end t))
  4430. (defun markdown--indent-region (start end)
  4431. (let ((deactivate-mark nil))
  4432. (save-excursion
  4433. (goto-char end)
  4434. (setq end (point-marker))
  4435. (goto-char start)
  4436. (when (bolp)
  4437. (forward-line 1))
  4438. (while (< (point) end)
  4439. (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp)))
  4440. (indent-according-to-mode))
  4441. (forward-line 1))
  4442. (move-marker end nil))))
  4443. ;;; Markup Completion =========================================================
  4444. (defconst markdown-complete-alist
  4445. '((markdown-regex-header-atx . markdown-complete-atx)
  4446. (markdown-regex-header-setext . markdown-complete-setext)
  4447. (markdown-regex-hr . markdown-complete-hr))
  4448. "Association list of form (regexp . function) for markup completion.")
  4449. (defun markdown-incomplete-atx-p ()
  4450. "Return t if ATX header markup is incomplete and nil otherwise.
  4451. Assumes match data is available for `markdown-regex-header-atx'.
  4452. Checks that the number of trailing hash marks equals the number of leading
  4453. hash marks, that there is only a single space before and after the text,
  4454. and that there is no extraneous whitespace in the text."
  4455. (or
  4456. ;; Number of starting and ending hash marks differs
  4457. (not (= (length (match-string 1)) (length (match-string 3))))
  4458. ;; When the header text is not empty...
  4459. (and (> (length (match-string 2)) 0)
  4460. ;; ...if there are extra leading, trailing, or interior spaces
  4461. (or (not (= (match-beginning 2) (1+ (match-end 1))))
  4462. (not (= (match-beginning 3) (1+ (match-end 2))))
  4463. (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
  4464. ;; When the header text is empty...
  4465. (and (= (length (match-string 2)) 0)
  4466. ;; ...if there are too many or too few spaces
  4467. (not (= (match-beginning 3) (+ (match-end 1) 2))))))
  4468. (defun markdown-complete-atx ()
  4469. "Complete and normalize ATX headers.
  4470. Add or remove hash marks to the end of the header to match the
  4471. beginning. Ensure that there is only a single space between hash
  4472. marks and header text. Removes extraneous whitespace from header text.
  4473. Assumes match data is available for `markdown-regex-header-atx'.
  4474. Return nil if markup was complete and non-nil if markup was completed."
  4475. (when (markdown-incomplete-atx-p)
  4476. (let* ((new-marker (make-marker))
  4477. (new-marker (set-marker new-marker (match-end 2))))
  4478. ;; Hash marks and spacing at end
  4479. (goto-char (match-end 2))
  4480. (delete-region (match-end 2) (match-end 3))
  4481. (insert " " (match-string 1))
  4482. ;; Remove extraneous whitespace from title
  4483. (replace-match (markdown-compress-whitespace-string (match-string 2))
  4484. t t nil 2)
  4485. ;; Spacing at beginning
  4486. (goto-char (match-end 1))
  4487. (delete-region (match-end 1) (match-beginning 2))
  4488. (insert " ")
  4489. ;; Leave point at end of text
  4490. (goto-char new-marker))))
  4491. (defun markdown-incomplete-setext-p ()
  4492. "Return t if setext header markup is incomplete and nil otherwise.
  4493. Assumes match data is available for `markdown-regex-header-setext'.
  4494. Checks that length of underline matches text and that there is no
  4495. extraneous whitespace in the text."
  4496. (or (not (= (length (match-string 1)) (length (match-string 2))))
  4497. (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
  4498. (defun markdown-complete-setext ()
  4499. "Complete and normalize setext headers.
  4500. Add or remove underline characters to match length of header
  4501. text. Removes extraneous whitespace from header text. Assumes
  4502. match data is available for `markdown-regex-header-setext'.
  4503. Return nil if markup was complete and non-nil if markup was completed."
  4504. (when (markdown-incomplete-setext-p)
  4505. (let* ((text (markdown-compress-whitespace-string (match-string 1)))
  4506. (char (char-after (match-beginning 2)))
  4507. (level (if (char-equal char ?-) 2 1)))
  4508. (goto-char (match-beginning 0))
  4509. (delete-region (match-beginning 0) (match-end 0))
  4510. (markdown-insert-header level text t)
  4511. t)))
  4512. (defun markdown-incomplete-hr-p ()
  4513. "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
  4514. Assumes match data is available for `markdown-regex-hr'."
  4515. (not (member (match-string 0) markdown-hr-strings)))
  4516. (defun markdown-complete-hr ()
  4517. "Complete horizontal rules.
  4518. If horizontal rule string is a member of `markdown-hr-strings',
  4519. do nothing. Otherwise, replace with the car of
  4520. `markdown-hr-strings'.
  4521. Assumes match data is available for `markdown-regex-hr'.
  4522. Return nil if markup was complete and non-nil if markup was completed."
  4523. (when (markdown-incomplete-hr-p)
  4524. (replace-match (car markdown-hr-strings))
  4525. t))
  4526. (defun markdown-complete ()
  4527. "Complete markup of object near point or in region when active.
  4528. Handle all objects in `markdown-complete-alist', in order.
  4529. See `markdown-complete-at-point' and `markdown-complete-region'."
  4530. (interactive "*")
  4531. (if (use-region-p)
  4532. (markdown-complete-region (region-beginning) (region-end))
  4533. (markdown-complete-at-point)))
  4534. (defun markdown-complete-at-point ()
  4535. "Complete markup of object near point.
  4536. Handle all elements of `markdown-complete-alist' in order."
  4537. (interactive "*")
  4538. (let ((list markdown-complete-alist) found changed)
  4539. (while list
  4540. (let ((regexp (eval (caar list)))
  4541. (function (cdar list)))
  4542. (setq list (cdr list))
  4543. (when (thing-at-point-looking-at regexp)
  4544. (setq found t)
  4545. (setq changed (funcall function))
  4546. (setq list nil))))
  4547. (if found
  4548. (or changed (user-error "Markup at point is complete"))
  4549. (user-error "Nothing to complete at point"))))
  4550. (defun markdown-complete-region (beg end)
  4551. "Complete markup of objects in region from BEG to END.
  4552. Handle all objects in `markdown-complete-alist', in order. Each
  4553. match is checked to ensure that a previous regexp does not also
  4554. match."
  4555. (interactive "*r")
  4556. (let ((end-marker (set-marker (make-marker) end))
  4557. previous)
  4558. (dolist (element markdown-complete-alist)
  4559. (let ((regexp (eval (car element)))
  4560. (function (cdr element)))
  4561. (goto-char beg)
  4562. (while (re-search-forward regexp end-marker 'limit)
  4563. (when (match-string 0)
  4564. ;; Make sure this is not a match for any of the preceding regexps.
  4565. ;; This prevents mistaking an HR for a Setext subheading.
  4566. (let (match)
  4567. (save-match-data
  4568. (dolist (prev-regexp previous)
  4569. (or match (setq match (looking-back prev-regexp nil)))))
  4570. (unless match
  4571. (save-excursion (funcall function))))))
  4572. (cl-pushnew regexp previous :test #'equal)))
  4573. previous))
  4574. (defun markdown-complete-buffer ()
  4575. "Complete markup for all objects in the current buffer."
  4576. (interactive "*")
  4577. (markdown-complete-region (point-min) (point-max)))
  4578. ;;; Markup Cycling ============================================================
  4579. (defun markdown-cycle-atx (arg &optional remove)
  4580. "Cycle ATX header markup.
  4581. Promote header (decrease level) when ARG is 1 and demote
  4582. header (increase level) if arg is -1. When REMOVE is non-nil,
  4583. remove the header when the level reaches zero and stop cycling
  4584. when it reaches six. Otherwise, perform a proper cycling through
  4585. levels one through six. Assumes match data is available for
  4586. `markdown-regex-header-atx'."
  4587. (let* ((old-level (length (match-string 1)))
  4588. (new-level (+ old-level arg))
  4589. (text (match-string 2)))
  4590. (when (not remove)
  4591. (setq new-level (% new-level 6))
  4592. (setq new-level (cond ((= new-level 0) 6)
  4593. ((< new-level 0) (+ new-level 6))
  4594. (t new-level))))
  4595. (cond
  4596. ((= new-level 0)
  4597. (markdown-unwrap-thing-at-point nil 0 2))
  4598. ((<= new-level 6)
  4599. (goto-char (match-beginning 0))
  4600. (delete-region (match-beginning 0) (match-end 0))
  4601. (markdown-insert-header new-level text nil)))))
  4602. (defun markdown-cycle-setext (arg &optional remove)
  4603. "Cycle setext header markup.
  4604. Promote header (increase level) when ARG is 1 and demote
  4605. header (decrease level or remove) if arg is -1. When demoting a
  4606. level-two setext header, replace with a level-three atx header.
  4607. When REMOVE is non-nil, remove the header when the level reaches
  4608. zero. Otherwise, cycle back to a level six atx header. Assumes
  4609. match data is available for `markdown-regex-header-setext'."
  4610. (let* ((char (char-after (match-beginning 2)))
  4611. (old-level (if (char-equal char ?=) 1 2))
  4612. (new-level (+ old-level arg)))
  4613. (when (and (not remove) (= new-level 0))
  4614. (setq new-level 6))
  4615. (cond
  4616. ((= new-level 0)
  4617. (markdown-unwrap-thing-at-point nil 0 1))
  4618. ((<= new-level 2)
  4619. (markdown-insert-header new-level nil t))
  4620. ((<= new-level 6)
  4621. (markdown-insert-header new-level nil nil)))))
  4622. (defun markdown-cycle-hr (arg &optional remove)
  4623. "Cycle string used for horizontal rule from `markdown-hr-strings'.
  4624. When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
  4625. backwards (promote). When REMOVE is non-nil, remove the hr instead
  4626. of cycling when the end of the list is reached.
  4627. Assumes match data is available for `markdown-regex-hr'."
  4628. (let* ((strings (if (= arg -1)
  4629. (reverse markdown-hr-strings)
  4630. markdown-hr-strings))
  4631. (tail (member (match-string 0) strings))
  4632. (new (or (cadr tail)
  4633. (if remove
  4634. (if (= arg 1)
  4635. ""
  4636. (car tail))
  4637. (car strings)))))
  4638. (replace-match new)))
  4639. (defun markdown-cycle-bold ()
  4640. "Cycle bold markup between underscores and asterisks.
  4641. Assumes match data is available for `markdown-regex-bold'."
  4642. (save-excursion
  4643. (let* ((old-delim (match-string 3))
  4644. (new-delim (if (string-equal old-delim "**") "__" "**")))
  4645. (replace-match new-delim t t nil 3)
  4646. (replace-match new-delim t t nil 5))))
  4647. (defun markdown-cycle-italic ()
  4648. "Cycle italic markup between underscores and asterisks.
  4649. Assumes match data is available for `markdown-regex-italic'."
  4650. (save-excursion
  4651. (let* ((old-delim (match-string 2))
  4652. (new-delim (if (string-equal old-delim "*") "_" "*")))
  4653. (replace-match new-delim t t nil 2)
  4654. (replace-match new-delim t t nil 4))))
  4655. ;;; Keymap ====================================================================
  4656. (defun markdown--style-map-prompt ()
  4657. "Return a formatted prompt for Markdown markup insertion."
  4658. (when markdown-enable-prefix-prompts
  4659. (concat
  4660. "Markdown: "
  4661. (propertize "bold" 'face 'markdown-bold-face) ", "
  4662. (propertize "italic" 'face 'markdown-italic-face) ", "
  4663. (propertize "code" 'face 'markdown-inline-code-face) ", "
  4664. (propertize "C = GFM code" 'face 'markdown-code-face) ", "
  4665. (propertize "pre" 'face 'markdown-pre-face) ", "
  4666. (propertize "footnote" 'face 'markdown-footnote-text-face) ", "
  4667. (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", "
  4668. (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", "
  4669. (propertize "- = hr" 'face 'markdown-hr-face) ", "
  4670. "C-h = more")))
  4671. (defun markdown--command-map-prompt ()
  4672. "Return prompt for Markdown buffer-wide commands."
  4673. (when markdown-enable-prefix-prompts
  4674. (concat
  4675. "Command: "
  4676. (propertize "m" 'face 'markdown-bold-face) "arkdown, "
  4677. (propertize "p" 'face 'markdown-bold-face) "review, "
  4678. (propertize "o" 'face 'markdown-bold-face) "pen, "
  4679. (propertize "e" 'face 'markdown-bold-face) "xport, "
  4680. "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, "
  4681. (propertize "c" 'face 'markdown-bold-face) "heck refs, "
  4682. (propertize "u" 'face 'markdown-bold-face) "nused refs, "
  4683. "C-h = more")))
  4684. (defvar markdown-mode-style-map
  4685. (let ((map (make-keymap (markdown--style-map-prompt))))
  4686. (define-key map (kbd "1") 'markdown-insert-header-atx-1)
  4687. (define-key map (kbd "2") 'markdown-insert-header-atx-2)
  4688. (define-key map (kbd "3") 'markdown-insert-header-atx-3)
  4689. (define-key map (kbd "4") 'markdown-insert-header-atx-4)
  4690. (define-key map (kbd "5") 'markdown-insert-header-atx-5)
  4691. (define-key map (kbd "6") 'markdown-insert-header-atx-6)
  4692. (define-key map (kbd "!") 'markdown-insert-header-setext-1)
  4693. (define-key map (kbd "@") 'markdown-insert-header-setext-2)
  4694. (define-key map (kbd "b") 'markdown-insert-bold)
  4695. (define-key map (kbd "c") 'markdown-insert-code)
  4696. (define-key map (kbd "C") 'markdown-insert-gfm-code-block)
  4697. (define-key map (kbd "f") 'markdown-insert-footnote)
  4698. (define-key map (kbd "h") 'markdown-insert-header-dwim)
  4699. (define-key map (kbd "H") 'markdown-insert-header-setext-dwim)
  4700. (define-key map (kbd "i") 'markdown-insert-italic)
  4701. (define-key map (kbd "k") 'markdown-insert-kbd)
  4702. (define-key map (kbd "l") 'markdown-insert-link)
  4703. (define-key map (kbd "p") 'markdown-insert-pre)
  4704. (define-key map (kbd "P") 'markdown-pre-region)
  4705. (define-key map (kbd "q") 'markdown-insert-blockquote)
  4706. (define-key map (kbd "s") 'markdown-insert-strike-through)
  4707. (define-key map (kbd "t") 'markdown-insert-table)
  4708. (define-key map (kbd "Q") 'markdown-blockquote-region)
  4709. (define-key map (kbd "w") 'markdown-insert-wiki-link)
  4710. (define-key map (kbd "-") 'markdown-insert-hr)
  4711. (define-key map (kbd "[") 'markdown-insert-gfm-checkbox)
  4712. ;; Deprecated keys that may be removed in a future version
  4713. (define-key map (kbd "e") 'markdown-insert-italic)
  4714. map)
  4715. "Keymap for Markdown text styling commands.")
  4716. (defvar markdown-mode-command-map
  4717. (let ((map (make-keymap (markdown--command-map-prompt))))
  4718. (define-key map (kbd "m") 'markdown-other-window)
  4719. (define-key map (kbd "p") 'markdown-preview)
  4720. (define-key map (kbd "e") 'markdown-export)
  4721. (define-key map (kbd "v") 'markdown-export-and-preview)
  4722. (define-key map (kbd "o") 'markdown-open)
  4723. (define-key map (kbd "l") 'markdown-live-preview-mode)
  4724. (define-key map (kbd "w") 'markdown-kill-ring-save)
  4725. (define-key map (kbd "c") 'markdown-check-refs)
  4726. (define-key map (kbd "u") 'markdown-unused-refs)
  4727. (define-key map (kbd "n") 'markdown-cleanup-list-numbers)
  4728. (define-key map (kbd "]") 'markdown-complete-buffer)
  4729. (define-key map (kbd "^") 'markdown-table-sort-lines)
  4730. (define-key map (kbd "|") 'markdown-table-convert-region)
  4731. (define-key map (kbd "t") 'markdown-table-transpose)
  4732. map)
  4733. "Keymap for Markdown buffer-wide commands.")
  4734. (defvar markdown-mode-map
  4735. (let ((map (make-keymap)))
  4736. ;; Markup insertion & removal
  4737. (define-key map (kbd "C-c C-s") markdown-mode-style-map)
  4738. (define-key map (kbd "C-c C-l") 'markdown-insert-link)
  4739. (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point)
  4740. ;; Promotion, demotion, and cycling
  4741. (define-key map (kbd "C-c C--") 'markdown-promote)
  4742. (define-key map (kbd "C-c C-=") 'markdown-demote)
  4743. (define-key map (kbd "C-c C-]") 'markdown-complete)
  4744. ;; Following and doing things
  4745. (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point)
  4746. (define-key map (kbd "C-c C-d") 'markdown-do)
  4747. (define-key map (kbd "C-c '") 'markdown-edit-code-block)
  4748. ;; Indentation
  4749. (define-key map (kbd "C-m") 'markdown-enter-key)
  4750. (define-key map (kbd "DEL") 'markdown-outdent-or-delete)
  4751. (define-key map (kbd "C-c >") 'markdown-indent-region)
  4752. (define-key map (kbd "C-c <") 'markdown-outdent-region)
  4753. ;; Visibility cycling
  4754. (define-key map (kbd "TAB") 'markdown-cycle)
  4755. (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
  4756. (define-key map (kbd "<S-tab>") 'markdown-shifttab)
  4757. (define-key map (kbd "<backtab>") 'markdown-shifttab)
  4758. ;; Heading and list navigation
  4759. (define-key map (kbd "C-c C-n") 'markdown-outline-next)
  4760. (define-key map (kbd "C-c C-p") 'markdown-outline-previous)
  4761. (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level)
  4762. (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level)
  4763. (define-key map (kbd "C-c C-u") 'markdown-outline-up)
  4764. ;; Buffer-wide commands
  4765. (define-key map (kbd "C-c C-c") markdown-mode-command-map)
  4766. ;; Subtree, list, and table editing
  4767. (define-key map (kbd "C-c <up>") 'markdown-move-up)
  4768. (define-key map (kbd "C-c <down>") 'markdown-move-down)
  4769. (define-key map (kbd "C-c <left>") 'markdown-promote)
  4770. (define-key map (kbd "C-c <right>") 'markdown-demote)
  4771. (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row)
  4772. (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row)
  4773. (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column)
  4774. (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column)
  4775. (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree)
  4776. (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree)
  4777. (define-key map (kbd "M-RET") 'markdown-insert-list-item)
  4778. (define-key map (kbd "C-c C-j") 'markdown-insert-list-item)
  4779. ;; Paragraphs (Markdown context aware)
  4780. (define-key map [remap backward-paragraph] 'markdown-backward-paragraph)
  4781. (define-key map [remap forward-paragraph] 'markdown-forward-paragraph)
  4782. (define-key map [remap mark-paragraph] 'markdown-mark-paragraph)
  4783. ;; Blocks (one or more paragraphs)
  4784. (define-key map (kbd "C-M-{") 'markdown-backward-block)
  4785. (define-key map (kbd "C-M-}") 'markdown-forward-block)
  4786. (define-key map (kbd "C-c M-h") 'markdown-mark-block)
  4787. (define-key map (kbd "C-x n b") 'markdown-narrow-to-block)
  4788. ;; Pages (top-level sections)
  4789. (define-key map [remap backward-page] 'markdown-backward-page)
  4790. (define-key map [remap forward-page] 'markdown-forward-page)
  4791. (define-key map [remap mark-page] 'markdown-mark-page)
  4792. (define-key map [remap narrow-to-page] 'markdown-narrow-to-page)
  4793. ;; Link Movement
  4794. (define-key map (kbd "M-n") 'markdown-next-link)
  4795. (define-key map (kbd "M-p") 'markdown-previous-link)
  4796. ;; Toggling functionality
  4797. (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math)
  4798. (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively)
  4799. (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images)
  4800. (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding)
  4801. (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding)
  4802. ;; Alternative keys (in case of problems with the arrow keys)
  4803. (define-key map (kbd "C-c C-x u") 'markdown-move-up)
  4804. (define-key map (kbd "C-c C-x d") 'markdown-move-down)
  4805. (define-key map (kbd "C-c C-x l") 'markdown-promote)
  4806. (define-key map (kbd "C-c C-x r") 'markdown-demote)
  4807. ;; Deprecated keys that may be removed in a future version
  4808. (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l
  4809. (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l
  4810. (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l
  4811. (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l
  4812. (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote)
  4813. (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link)
  4814. (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1)
  4815. (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2)
  4816. (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3)
  4817. (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4)
  4818. (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5)
  4819. (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6)
  4820. (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1)
  4821. (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2)
  4822. (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim)
  4823. (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim)
  4824. (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2)
  4825. (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1)
  4826. (define-key map (kbd "C-c C-i") 'markdown-insert-image)
  4827. (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j
  4828. (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d
  4829. (define-key map (kbd "C-c -") 'markdown-insert-hr)
  4830. map)
  4831. "Keymap for Markdown major mode.")
  4832. (defvar markdown-mode-mouse-map
  4833. (when markdown-mouse-follow-link
  4834. (let ((map (make-sparse-keymap)))
  4835. (define-key map [follow-link] 'mouse-face)
  4836. (define-key map [mouse-2] #'markdown-follow-thing-at-point)
  4837. map))
  4838. "Keymap for following links with mouse.")
  4839. (defvar gfm-mode-map
  4840. (let ((map (make-sparse-keymap)))
  4841. (set-keymap-parent map markdown-mode-map)
  4842. (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through)
  4843. (define-key map "`" 'markdown-electric-backquote)
  4844. map)
  4845. "Keymap for `gfm-mode'.
  4846. See also `markdown-mode-map'.")
  4847. ;;; Menu ======================================================================
  4848. (easy-menu-define markdown-mode-menu markdown-mode-map
  4849. "Menu for Markdown mode"
  4850. '("Markdown"
  4851. "---"
  4852. ("Movement"
  4853. ["Jump" markdown-do]
  4854. ["Follow Link" markdown-follow-thing-at-point]
  4855. ["Next Link" markdown-next-link]
  4856. ["Previous Link" markdown-previous-link]
  4857. "---"
  4858. ["Next Heading or List Item" markdown-outline-next]
  4859. ["Previous Heading or List Item" markdown-outline-previous]
  4860. ["Next at Same Level" markdown-outline-next-same-level]
  4861. ["Previous at Same Level" markdown-outline-previous-same-level]
  4862. ["Up to Parent" markdown-outline-up]
  4863. "---"
  4864. ["Forward Paragraph" markdown-forward-paragraph]
  4865. ["Backward Paragraph" markdown-backward-paragraph]
  4866. ["Forward Block" markdown-forward-block]
  4867. ["Backward Block" markdown-backward-block])
  4868. ("Show & Hide"
  4869. ["Cycle Heading Visibility" markdown-cycle
  4870. :enable (markdown-on-heading-p)]
  4871. ["Cycle Heading Visibility (Global)" markdown-shifttab]
  4872. "---"
  4873. ["Narrow to Region" narrow-to-region]
  4874. ["Narrow to Block" markdown-narrow-to-block]
  4875. ["Narrow to Section" narrow-to-defun]
  4876. ["Narrow to Subtree" markdown-narrow-to-subtree]
  4877. ["Widen" widen (buffer-narrowed-p)]
  4878. "---"
  4879. ["Toggle Markup Hiding" markdown-toggle-markup-hiding
  4880. :keys "C-c C-x C-m"
  4881. :style radio
  4882. :selected markdown-hide-markup])
  4883. "---"
  4884. ("Headings & Structure"
  4885. ["Automatic Heading" markdown-insert-header-dwim
  4886. :keys "C-c C-s h"]
  4887. ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
  4888. :keys "C-c C-s H"]
  4889. ("Specific Heading (atx)"
  4890. ["First Level atx" markdown-insert-header-atx-1
  4891. :keys "C-c C-s 1"]
  4892. ["Second Level atx" markdown-insert-header-atx-2
  4893. :keys "C-c C-s 2"]
  4894. ["Third Level atx" markdown-insert-header-atx-3
  4895. :keys "C-c C-s 3"]
  4896. ["Fourth Level atx" markdown-insert-header-atx-4
  4897. :keys "C-c C-s 4"]
  4898. ["Fifth Level atx" markdown-insert-header-atx-5
  4899. :keys "C-c C-s 5"]
  4900. ["Sixth Level atx" markdown-insert-header-atx-6
  4901. :keys "C-c C-s 6"])
  4902. ("Specific Heading (Setext)"
  4903. ["First Level Setext" markdown-insert-header-setext-1
  4904. :keys "C-c C-s !"]
  4905. ["Second Level Setext" markdown-insert-header-setext-2
  4906. :keys "C-c C-s @"])
  4907. ["Horizontal Rule" markdown-insert-hr
  4908. :keys "C-c C-s -"]
  4909. "---"
  4910. ["Move Subtree Up" markdown-move-up
  4911. :keys "C-c <up>"]
  4912. ["Move Subtree Down" markdown-move-down
  4913. :keys "C-c <down>"]
  4914. ["Promote Subtree" markdown-promote
  4915. :keys "C-c <left>"]
  4916. ["Demote Subtree" markdown-demote
  4917. :keys "C-c <right>"])
  4918. ("Region & Mark"
  4919. ["Indent Region" markdown-indent-region]
  4920. ["Outdent Region" markdown-outdent-region]
  4921. "--"
  4922. ["Mark Paragraph" mark-paragraph]
  4923. ["Mark Block" markdown-mark-block]
  4924. ["Mark Section" mark-defun]
  4925. ["Mark Subtree" markdown-mark-subtree])
  4926. ("Tables"
  4927. ["Move Row Up" markdown-move-up
  4928. :enable (markdown-table-at-point-p)
  4929. :keys "C-c <up>"]
  4930. ["Move Row Down" markdown-move-down
  4931. :enable (markdown-table-at-point-p)
  4932. :keys "C-c <down>"]
  4933. ["Move Column Left" markdown-demote
  4934. :enable (markdown-table-at-point-p)
  4935. :keys "C-c <left>"]
  4936. ["Move Column Right" markdown-promote
  4937. :enable (markdown-table-at-point-p)
  4938. :keys "C-c <right>"]
  4939. ["Delete Row" markdown-table-delete-row
  4940. :enable (markdown-table-at-point-p)]
  4941. ["Insert Row" markdown-table-insert-row
  4942. :enable (markdown-table-at-point-p)]
  4943. ["Delete Column" markdown-table-delete-column
  4944. :enable (markdown-table-at-point-p)]
  4945. ["Insert Column" markdown-table-insert-column
  4946. :enable (markdown-table-at-point-p)]
  4947. ["Insert Table" markdown-insert-table]
  4948. "--"
  4949. ["Convert Region to Table" markdown-table-convert-region]
  4950. ["Sort Table Lines" markdown-table-sort-lines
  4951. :enable (markdown-table-at-point-p)]
  4952. ["Transpose Table" markdown-table-transpose
  4953. :enable (markdown-table-at-point-p)])
  4954. ("Lists"
  4955. ["Insert List Item" markdown-insert-list-item]
  4956. ["Move Subtree Up" markdown-move-up
  4957. :keys "C-c <up>"]
  4958. ["Move Subtree Down" markdown-move-down
  4959. :keys "C-c <down>"]
  4960. ["Indent Subtree" markdown-demote
  4961. :keys "C-c <right>"]
  4962. ["Outdent Subtree" markdown-promote
  4963. :keys "C-c <left>"]
  4964. ["Renumber List" markdown-cleanup-list-numbers]
  4965. ["Insert Task List Item" markdown-insert-gfm-checkbox
  4966. :keys "C-c C-x ["]
  4967. ["Toggle Task List Item" markdown-toggle-gfm-checkbox
  4968. :enable (markdown-gfm-task-list-item-at-point)
  4969. :keys "C-c C-d"])
  4970. ("Links & Images"
  4971. ["Insert Link" markdown-insert-link]
  4972. ["Insert Image" markdown-insert-image]
  4973. ["Insert Footnote" markdown-insert-footnote
  4974. :keys "C-c C-s f"]
  4975. ["Insert Wiki Link" markdown-insert-wiki-link
  4976. :keys "C-c C-s w"]
  4977. "---"
  4978. ["Check References" markdown-check-refs]
  4979. ["Find Unused References" markdown-unused-refs]
  4980. ["Toggle URL Hiding" markdown-toggle-url-hiding
  4981. :style radio
  4982. :selected markdown-hide-urls]
  4983. ["Toggle Inline Images" markdown-toggle-inline-images
  4984. :keys "C-c C-x C-i"
  4985. :style radio
  4986. :selected markdown-inline-image-overlays]
  4987. ["Toggle Wiki Links" markdown-toggle-wiki-links
  4988. :style radio
  4989. :selected markdown-enable-wiki-links])
  4990. ("Styles"
  4991. ["Bold" markdown-insert-bold]
  4992. ["Italic" markdown-insert-italic]
  4993. ["Code" markdown-insert-code]
  4994. ["Strikethrough" markdown-insert-strike-through]
  4995. ["Keyboard" markdown-insert-kbd]
  4996. "---"
  4997. ["Blockquote" markdown-insert-blockquote]
  4998. ["Preformatted" markdown-insert-pre]
  4999. ["GFM Code Block" markdown-insert-gfm-code-block]
  5000. ["Edit Code Block" markdown-edit-code-block
  5001. :enable (markdown-code-block-at-point-p)]
  5002. "---"
  5003. ["Blockquote Region" markdown-blockquote-region]
  5004. ["Preformatted Region" markdown-pre-region]
  5005. "---"
  5006. ["Fontify Code Blocks Natively"
  5007. markdown-toggle-fontify-code-blocks-natively
  5008. :style radio
  5009. :selected markdown-fontify-code-blocks-natively]
  5010. ["LaTeX Math Support" markdown-toggle-math
  5011. :style radio
  5012. :selected markdown-enable-math])
  5013. "---"
  5014. ("Preview & Export"
  5015. ["Compile" markdown-other-window]
  5016. ["Preview" markdown-preview]
  5017. ["Export" markdown-export]
  5018. ["Export & View" markdown-export-and-preview]
  5019. ["Open" markdown-open]
  5020. ["Live Export" markdown-live-preview-mode
  5021. :style radio
  5022. :selected markdown-live-preview-mode]
  5023. ["Kill ring save" markdown-kill-ring-save])
  5024. ("Markup Completion and Cycling"
  5025. ["Complete Markup" markdown-complete]
  5026. ["Promote Element" markdown-promote
  5027. :keys "C-c C--"]
  5028. ["Demote Element" markdown-demote
  5029. :keys "C-c C-="])
  5030. "---"
  5031. ["Kill Element" markdown-kill-thing-at-point]
  5032. "---"
  5033. ("Documentation"
  5034. ["Version" markdown-show-version]
  5035. ["Homepage" markdown-mode-info]
  5036. ["Describe Mode" (describe-function 'markdown-mode)]
  5037. ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
  5038. ;;; imenu =====================================================================
  5039. (defun markdown-imenu-create-nested-index ()
  5040. "Create and return a nested imenu index alist for the current buffer.
  5041. See `imenu-create-index-function' and `imenu--index-alist' for details."
  5042. (let* ((root '(nil . nil))
  5043. (min-level 9999)
  5044. hashes headers)
  5045. (save-excursion
  5046. ;; Headings
  5047. (goto-char (point-min))
  5048. (while (re-search-forward markdown-regex-header (point-max) t)
  5049. (unless (or (markdown-code-block-at-point-p)
  5050. (and (match-beginning 3)
  5051. (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end)))
  5052. (cond
  5053. ((match-string-no-properties 2) ;; level 1 setext
  5054. (setq min-level 1)
  5055. (push (list :heading (match-string-no-properties 1)
  5056. :point (match-beginning 1)
  5057. :level 1) headers))
  5058. ((match-string-no-properties 3) ;; level 2 setext
  5059. (setq min-level (min min-level 2))
  5060. (push (list :heading (match-string-no-properties 1)
  5061. :point (match-beginning 1)
  5062. :level (- 2 (1- min-level))) headers))
  5063. ((setq hashes (markdown-trim-whitespace
  5064. (match-string-no-properties 4)))
  5065. (setq min-level (min min-level (length hashes)))
  5066. (push (list :heading (match-string-no-properties 5)
  5067. :point (match-beginning 4)
  5068. :level (- (length hashes) (1- min-level))) headers)))))
  5069. (cl-loop with cur-level = 0
  5070. with cur-alist = nil
  5071. with empty-heading = "-"
  5072. with self-heading = "."
  5073. for header in (reverse headers)
  5074. for level = (plist-get header :level)
  5075. do
  5076. (let ((alist (list (cons (plist-get header :heading) (plist-get header :point)))))
  5077. (cond
  5078. ((= cur-level level) ; new sibling
  5079. (setcdr cur-alist alist)
  5080. (setq cur-alist alist))
  5081. ((< cur-level level) ; first child
  5082. (dotimes (_ (- level cur-level 1))
  5083. (setq alist (list (cons empty-heading alist))))
  5084. (if cur-alist
  5085. (let* ((parent (car cur-alist))
  5086. (self-pos (cdr parent)))
  5087. (setcdr parent (cons (cons self-heading self-pos) alist)))
  5088. (setcdr root alist)) ; primogenitor
  5089. (setq cur-alist alist)
  5090. (setq cur-level level))
  5091. (t ; new sibling of an ancestor
  5092. (let ((sibling-alist (last (cdr root))))
  5093. (dotimes (_ (1- level))
  5094. (setq sibling-alist (last (cdar sibling-alist))))
  5095. (setcdr sibling-alist alist)
  5096. (setq cur-alist alist))
  5097. (setq cur-level level)))))
  5098. ;; Footnotes
  5099. (let ((fn (markdown-get-defined-footnotes)))
  5100. (if (or (zerop (length fn))
  5101. (null markdown-add-footnotes-to-imenu))
  5102. (cdr root)
  5103. (nconc (cdr root) (list (cons "Footnotes" fn))))))))
  5104. (defun markdown-imenu-create-flat-index ()
  5105. "Create and return a flat imenu index alist for the current buffer.
  5106. See `imenu-create-index-function' and `imenu--index-alist' for details."
  5107. (let* ((empty-heading "-") index heading pos)
  5108. (save-excursion
  5109. ;; Headings
  5110. (goto-char (point-min))
  5111. (while (re-search-forward markdown-regex-header (point-max) t)
  5112. (when (and (not (markdown-code-block-at-point-p (point-at-bol)))
  5113. (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin)))
  5114. (cond
  5115. ((setq heading (match-string-no-properties 1))
  5116. (setq pos (match-beginning 1)))
  5117. ((setq heading (match-string-no-properties 5))
  5118. (setq pos (match-beginning 4))))
  5119. (or (> (length heading) 0)
  5120. (setq heading empty-heading))
  5121. (setq index (append index (list (cons heading pos))))))
  5122. ;; Footnotes
  5123. (when markdown-add-footnotes-to-imenu
  5124. (nconc index (markdown-get-defined-footnotes)))
  5125. index)))
  5126. ;;; References ================================================================
  5127. (defun markdown-reference-goto-definition ()
  5128. "Jump to the definition of the reference at point or create it."
  5129. (interactive)
  5130. (when (thing-at-point-looking-at markdown-regex-link-reference)
  5131. (let* ((text (match-string-no-properties 3))
  5132. (reference (match-string-no-properties 6))
  5133. (target (downcase (if (string= reference "") text reference)))
  5134. (loc (cadr (save-match-data (markdown-reference-definition target)))))
  5135. (if loc
  5136. (goto-char loc)
  5137. (goto-char (match-beginning 0))
  5138. (markdown-insert-reference-definition target)))))
  5139. (defun markdown-reference-find-links (reference)
  5140. "Return a list of all links for REFERENCE.
  5141. REFERENCE should not include the surrounding square brackets.
  5142. Elements of the list have the form (text start line), where
  5143. text is the link text, start is the location at the beginning of
  5144. the link, and line is the line number on which the link appears."
  5145. (let* ((ref-quote (regexp-quote reference))
  5146. (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
  5147. ref-quote ref-quote))
  5148. links)
  5149. (save-excursion
  5150. (goto-char (point-min))
  5151. (while (re-search-forward regexp nil t)
  5152. (let* ((text (or (match-string-no-properties 1)
  5153. (match-string-no-properties 2)))
  5154. (start (match-beginning 0))
  5155. (line (markdown-line-number-at-pos)))
  5156. (cl-pushnew (list text start line) links :test #'equal))))
  5157. links))
  5158. (defmacro markdown-for-all-refs (f)
  5159. `(let ((result))
  5160. (save-excursion
  5161. (goto-char (point-min))
  5162. (while
  5163. (re-search-forward markdown-regex-link-reference nil t)
  5164. (let* ((text (match-string-no-properties 3))
  5165. (reference (match-string-no-properties 6))
  5166. (target (downcase (if (string= reference "") text reference))))
  5167. (,f text target result))))
  5168. (reverse result)))
  5169. (defmacro markdown-collect-always (_ target result)
  5170. `(cl-pushnew ,target ,result :test #'equal))
  5171. (defmacro markdown-collect-undefined (text target result)
  5172. `(unless (markdown-reference-definition target)
  5173. (let ((entry (assoc ,target ,result)))
  5174. (if (not entry)
  5175. (cl-pushnew
  5176. (cons ,target (list (cons ,text (markdown-line-number-at-pos))))
  5177. ,result :test #'equal)
  5178. (setcdr entry
  5179. (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos)))))))))
  5180. (defun markdown-get-all-refs ()
  5181. "Return a list of all Markdown references."
  5182. (markdown-for-all-refs markdown-collect-always))
  5183. (defun markdown-get-undefined-refs ()
  5184. "Return a list of undefined Markdown references.
  5185. Result is an alist of pairs (reference . occurrences), where
  5186. occurrences is itself another alist of pairs (label . line-number).
  5187. For example, an alist corresponding to [Nice editor][Emacs] at line 12,
  5188. \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
  5189. \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
  5190. (markdown-for-all-refs markdown-collect-undefined))
  5191. (defun markdown-get-unused-refs ()
  5192. (cl-sort
  5193. (cl-set-difference
  5194. (markdown-get-defined-references) (markdown-get-all-refs)
  5195. :test (lambda (e1 e2) (equal (car e1) e2)))
  5196. #'< :key #'cdr))
  5197. (defmacro defun-markdown-buffer (name docstring)
  5198. "Define a function to name and return a buffer.
  5199. By convention, NAME must be a name of a string constant with
  5200. %buffer% placeholder used to name the buffer, and will also be
  5201. used as a name of the function defined.
  5202. DOCSTRING will be used as the first part of the docstring."
  5203. `(defun ,name (&optional buffer-name)
  5204. ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.")
  5205. (or buffer-name (setq buffer-name (buffer-name)))
  5206. (let ((refbuf (get-buffer-create (replace-regexp-in-string
  5207. "%buffer%" buffer-name
  5208. ,name))))
  5209. (with-current-buffer refbuf
  5210. (when view-mode
  5211. (View-exit-and-edit))
  5212. (use-local-map button-buffer-map)
  5213. (erase-buffer))
  5214. refbuf)))
  5215. (defconst markdown-reference-check-buffer
  5216. "*Undefined references for %buffer%*"
  5217. "Pattern for name of buffer for listing undefined references.
  5218. The string %buffer% will be replaced by the corresponding
  5219. `markdown-mode' buffer name.")
  5220. (defun-markdown-buffer
  5221. markdown-reference-check-buffer
  5222. "Name and return buffer for reference checking.")
  5223. (defconst markdown-unused-references-buffer
  5224. "*Unused references for %buffer%*"
  5225. "Pattern for name of buffer for listing unused references.
  5226. The string %buffer% will be replaced by the corresponding
  5227. `markdown-mode' buffer name.")
  5228. (defun-markdown-buffer
  5229. markdown-unused-references-buffer
  5230. "Name and return buffer for unused reference checking.")
  5231. (defconst markdown-reference-links-buffer
  5232. "*Reference links for %buffer%*"
  5233. "Pattern for name of buffer for listing references.
  5234. The string %buffer% will be replaced by the corresponding buffer name.")
  5235. (defun-markdown-buffer
  5236. markdown-reference-links-buffer
  5237. "Name, setup, and return a buffer for listing links.")
  5238. ;; Add an empty Markdown reference definition to buffer
  5239. ;; specified in the 'target-buffer property. The reference name is
  5240. ;; the button's label.
  5241. (define-button-type 'markdown-undefined-reference-button
  5242. 'help-echo "mouse-1, RET: create definition for undefined reference"
  5243. 'follow-link t
  5244. 'face 'bold
  5245. 'action (lambda (b)
  5246. (let ((buffer (button-get b 'target-buffer))
  5247. (line (button-get b 'target-line))
  5248. (label (button-label b)))
  5249. (switch-to-buffer-other-window buffer)
  5250. (goto-char (point-min))
  5251. (forward-line line)
  5252. (markdown-insert-reference-definition label)
  5253. (markdown-check-refs t))))
  5254. ;; Jump to line in buffer specified by 'target-buffer property.
  5255. ;; Line number is button's 'target-line property.
  5256. (define-button-type 'markdown-goto-line-button
  5257. 'help-echo "mouse-1, RET: go to line"
  5258. 'follow-link t
  5259. 'face 'italic
  5260. 'action (lambda (b)
  5261. (switch-to-buffer-other-window (button-get b 'target-buffer))
  5262. ;; use call-interactively to silence compiler
  5263. (let ((current-prefix-arg (button-get b 'target-line)))
  5264. (call-interactively 'goto-line))))
  5265. ;; Kill a line in buffer specified by 'target-buffer property.
  5266. ;; Line number is button's 'target-line property.
  5267. (define-button-type 'markdown-kill-line-button
  5268. 'help-echo "mouse-1, RET: kill line"
  5269. 'follow-link t
  5270. 'face 'italic
  5271. 'action (lambda (b)
  5272. (switch-to-buffer-other-window (button-get b 'target-buffer))
  5273. ;; use call-interactively to silence compiler
  5274. (let ((current-prefix-arg (button-get b 'target-line)))
  5275. (call-interactively 'goto-line))
  5276. (kill-line 1)
  5277. (markdown-unused-refs t)))
  5278. ;; Jumps to a particular link at location given by 'target-char
  5279. ;; property in buffer given by 'target-buffer property.
  5280. (define-button-type 'markdown-location-button
  5281. 'help-echo "mouse-1, RET: jump to location of link"
  5282. 'follow-link t
  5283. 'face 'bold
  5284. 'action (lambda (b)
  5285. (let ((target (button-get b 'target-buffer))
  5286. (loc (button-get b 'target-char)))
  5287. (kill-buffer-and-window)
  5288. (switch-to-buffer target)
  5289. (goto-char loc))))
  5290. (defun markdown-insert-undefined-reference-button (reference oldbuf)
  5291. "Insert a button for creating REFERENCE in buffer OLDBUF.
  5292. REFERENCE should be a list of the form (reference . occurrences),
  5293. as returned by `markdown-get-undefined-refs'."
  5294. (let ((label (car reference)))
  5295. ;; Create a reference button
  5296. (insert-button label
  5297. :type 'markdown-undefined-reference-button
  5298. 'target-buffer oldbuf
  5299. 'target-line (cdr (car (cdr reference))))
  5300. (insert " (")
  5301. (dolist (occurrence (cdr reference))
  5302. (let ((line (cdr occurrence)))
  5303. ;; Create a line number button
  5304. (insert-button (number-to-string line)
  5305. :type 'markdown-goto-line-button
  5306. 'target-buffer oldbuf
  5307. 'target-line line)
  5308. (insert " ")))
  5309. (delete-char -1)
  5310. (insert ")")
  5311. (newline)))
  5312. (defun markdown-insert-unused-reference-button (reference oldbuf)
  5313. "Insert a button for creating REFERENCE in buffer OLDBUF.
  5314. REFERENCE must be a pair of (ref . line-number)."
  5315. (let ((label (car reference))
  5316. (line (cdr reference)))
  5317. ;; Create a reference button
  5318. (insert-button label
  5319. :type 'markdown-goto-line-button
  5320. 'face 'bold
  5321. 'target-buffer oldbuf
  5322. 'target-line line)
  5323. (insert (format " (%d) [" line))
  5324. (insert-button "X"
  5325. :type 'markdown-kill-line-button
  5326. 'face 'bold
  5327. 'target-buffer oldbuf
  5328. 'target-line line)
  5329. (insert "]")
  5330. (newline)))
  5331. (defun markdown-insert-link-button (link oldbuf)
  5332. "Insert a button for jumping to LINK in buffer OLDBUF.
  5333. LINK should be a list of the form (text char line) containing
  5334. the link text, location, and line number."
  5335. (let ((label (cl-first link))
  5336. (char (cl-second link))
  5337. (line (cl-third link)))
  5338. ;; Create a reference button
  5339. (insert-button label
  5340. :type 'markdown-location-button
  5341. 'target-buffer oldbuf
  5342. 'target-char char)
  5343. (insert (format " (line %d)\n" line))))
  5344. (defun markdown-reference-goto-link (&optional reference)
  5345. "Jump to the location of the first use of REFERENCE."
  5346. (interactive)
  5347. (unless reference
  5348. (if (thing-at-point-looking-at markdown-regex-reference-definition)
  5349. (setq reference (match-string-no-properties 2))
  5350. (user-error "No reference definition at point")))
  5351. (let ((links (markdown-reference-find-links reference)))
  5352. (cond ((= (length links) 1)
  5353. (goto-char (cadr (car links))))
  5354. ((> (length links) 1)
  5355. (let ((oldbuf (current-buffer))
  5356. (linkbuf (markdown-reference-links-buffer)))
  5357. (with-current-buffer linkbuf
  5358. (insert "Links using reference " reference ":\n\n")
  5359. (dolist (link (reverse links))
  5360. (markdown-insert-link-button link oldbuf)))
  5361. (view-buffer-other-window linkbuf)
  5362. (goto-char (point-min))
  5363. (forward-line 2)))
  5364. (t
  5365. (error "No links for reference %s" reference)))))
  5366. (defmacro defun-markdown-ref-checker
  5367. (name docstring checker-function buffer-function none-message buffer-header insert-reference)
  5368. "Define a function NAME acting on result of CHECKER-FUNCTION.
  5369. DOCSTRING is used as a docstring for the defined function.
  5370. BUFFER-FUNCTION should name and return an auxiliary buffer to put
  5371. results in.
  5372. NONE-MESSAGE is used when CHECKER-FUNCTION returns no results.
  5373. BUFFER-HEADER is put into the auxiliary buffer first, followed by
  5374. calling INSERT-REFERENCE for each element in the list returned by
  5375. CHECKER-FUNCTION."
  5376. `(defun ,name (&optional silent)
  5377. ,(concat
  5378. docstring
  5379. "\n\nIf SILENT is non-nil, do not message anything when no
  5380. such references found.")
  5381. (interactive "P")
  5382. (unless (derived-mode-p 'markdown-mode)
  5383. (user-error "Not available in current mode"))
  5384. (let ((oldbuf (current-buffer))
  5385. (refs (,checker-function))
  5386. (refbuf (,buffer-function)))
  5387. (if (null refs)
  5388. (progn
  5389. (when (not silent)
  5390. (message ,none-message))
  5391. (kill-buffer refbuf))
  5392. (with-current-buffer refbuf
  5393. (insert ,buffer-header)
  5394. (dolist (ref refs)
  5395. (,insert-reference ref oldbuf))
  5396. (view-buffer-other-window refbuf)
  5397. (goto-char (point-min))
  5398. (forward-line 2))))))
  5399. (defun-markdown-ref-checker
  5400. markdown-check-refs
  5401. "Show all undefined Markdown references in current `markdown-mode' buffer.
  5402. Links which have empty reference definitions are considered to be
  5403. defined."
  5404. markdown-get-undefined-refs
  5405. markdown-reference-check-buffer
  5406. "No undefined references found"
  5407. "The following references are undefined:\n\n"
  5408. markdown-insert-undefined-reference-button)
  5409. (defun-markdown-ref-checker
  5410. markdown-unused-refs
  5411. "Show all unused Markdown references in current `markdown-mode' buffer."
  5412. markdown-get-unused-refs
  5413. markdown-unused-references-buffer
  5414. "No unused references found"
  5415. "The following references are unused:\n\n"
  5416. markdown-insert-unused-reference-button)
  5417. ;;; Lists =====================================================================
  5418. (defun markdown-insert-list-item (&optional arg)
  5419. "Insert a new list item.
  5420. If the point is inside unordered list, insert a bullet mark. If
  5421. the point is inside ordered list, insert the next number followed
  5422. by a period. Use the previous list item to determine the amount
  5423. of whitespace to place before and after list markers.
  5424. With a \\[universal-argument] prefix (i.e., when ARG is (4)),
  5425. decrease the indentation by one level.
  5426. With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
  5427. increase the indentation by one level."
  5428. (interactive "p")
  5429. (let (bounds cur-indent marker indent new-indent new-loc)
  5430. (save-match-data
  5431. ;; Look for a list item on current or previous non-blank line
  5432. (save-excursion
  5433. (while (and (not (setq bounds (markdown-cur-list-item-bounds)))
  5434. (not (bobp))
  5435. (markdown-cur-line-blank-p))
  5436. (forward-line -1)))
  5437. (when bounds
  5438. (cond ((save-excursion
  5439. (skip-chars-backward " \t")
  5440. (looking-at-p markdown-regex-list))
  5441. (beginning-of-line)
  5442. (insert "\n")
  5443. (forward-line -1))
  5444. ((not (markdown-cur-line-blank-p))
  5445. (newline)))
  5446. (setq new-loc (point)))
  5447. ;; Look ahead for a list item on next non-blank line
  5448. (unless bounds
  5449. (save-excursion
  5450. (while (and (null bounds)
  5451. (not (eobp))
  5452. (markdown-cur-line-blank-p))
  5453. (forward-line)
  5454. (setq bounds (markdown-cur-list-item-bounds))))
  5455. (when bounds
  5456. (setq new-loc (point))
  5457. (unless (markdown-cur-line-blank-p)
  5458. (newline))))
  5459. (if (not bounds)
  5460. ;; When not in a list, start a new unordered one
  5461. (progn
  5462. (unless (markdown-cur-line-blank-p)
  5463. (insert "\n"))
  5464. (insert markdown-unordered-list-item-prefix))
  5465. ;; Compute indentation and marker for new list item
  5466. (setq cur-indent (nth 2 bounds))
  5467. (setq marker (nth 4 bounds))
  5468. ;; If current item is a GFM checkbox, insert new unchecked checkbox.
  5469. (when (nth 5 bounds)
  5470. (setq marker
  5471. (concat marker
  5472. (replace-regexp-in-string "[Xx]" " " (nth 5 bounds)))))
  5473. (cond
  5474. ;; Dedent: decrement indentation, find previous marker.
  5475. ((= arg 4)
  5476. (setq indent (max (- cur-indent markdown-list-indent-width) 0))
  5477. (let ((prev-bounds
  5478. (save-excursion
  5479. (goto-char (nth 0 bounds))
  5480. (when (markdown-up-list)
  5481. (markdown-cur-list-item-bounds)))))
  5482. (when prev-bounds
  5483. (setq marker (nth 4 prev-bounds)))))
  5484. ;; Indent: increment indentation by 4, use same marker.
  5485. ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width)))
  5486. ;; Same level: keep current indentation and marker.
  5487. (t (setq indent cur-indent)))
  5488. (setq new-indent (make-string indent 32))
  5489. (goto-char new-loc)
  5490. (cond
  5491. ;; Ordered list
  5492. ((string-match-p "[0-9]" marker)
  5493. (if (= arg 16) ;; starting a new column indented one more level
  5494. (insert (concat new-indent "1. "))
  5495. ;; Don't use previous match-data
  5496. (set-match-data nil)
  5497. ;; travel up to the last item and pick the correct number. If
  5498. ;; the argument was nil, "new-indent = cur-indent" is the same,
  5499. ;; so we don't need special treatment. Neat.
  5500. (save-excursion
  5501. (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)")))
  5502. (>= (forward-line -1) 0))))
  5503. (let* ((old-prefix (match-string 1))
  5504. (old-spacing (match-string 2))
  5505. (new-prefix (if (and old-prefix markdown-ordered-list-enumeration)
  5506. (int-to-string (1+ (string-to-number old-prefix)))
  5507. "1"))
  5508. (space-adjust (- (length old-prefix) (length new-prefix)))
  5509. (new-spacing (if (and (match-string 2)
  5510. (not (string-match-p "\t" old-spacing))
  5511. (< space-adjust 0)
  5512. (> space-adjust (- 1 (length (match-string 2)))))
  5513. (substring (match-string 2) 0 space-adjust)
  5514. (or old-spacing ". "))))
  5515. (insert (concat new-indent new-prefix new-spacing)))))
  5516. ;; Unordered list, GFM task list, or ordered list with hash mark
  5517. ((string-match-p "[\\*\\+-]\\|#\\." marker)
  5518. (insert new-indent marker))))
  5519. ;; Propertize the newly inserted list item now
  5520. (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol)))))
  5521. (defun markdown-move-list-item-up ()
  5522. "Move the current list item up in the list when possible.
  5523. In nested lists, move child items with the parent item."
  5524. (interactive)
  5525. (let (cur prev old)
  5526. (when (setq cur (markdown-cur-list-item-bounds))
  5527. (setq old (point))
  5528. (goto-char (nth 0 cur))
  5529. (if (markdown-prev-list-item (nth 3 cur))
  5530. (progn
  5531. (setq prev (markdown-cur-list-item-bounds))
  5532. (condition-case nil
  5533. (progn
  5534. (transpose-regions (nth 0 prev) (nth 1 prev)
  5535. (nth 0 cur) (nth 1 cur) t)
  5536. (goto-char (+ (nth 0 prev) (- old (nth 0 cur)))))
  5537. ;; Catch error in case regions overlap.
  5538. (error (goto-char old))))
  5539. (goto-char old)))))
  5540. (defun markdown-move-list-item-down ()
  5541. "Move the current list item down in the list when possible.
  5542. In nested lists, move child items with the parent item."
  5543. (interactive)
  5544. (let (cur next old)
  5545. (when (setq cur (markdown-cur-list-item-bounds))
  5546. (setq old (point))
  5547. (if (markdown-next-list-item (nth 3 cur))
  5548. (progn
  5549. (setq next (markdown-cur-list-item-bounds))
  5550. (condition-case nil
  5551. (progn
  5552. (transpose-regions (nth 0 cur) (nth 1 cur)
  5553. (nth 0 next) (nth 1 next) nil)
  5554. (goto-char (+ old (- (nth 1 next) (nth 1 cur)))))
  5555. ;; Catch error in case regions overlap.
  5556. (error (goto-char old))))
  5557. (goto-char old)))))
  5558. (defun markdown-demote-list-item (&optional bounds)
  5559. "Indent (or demote) the current list item.
  5560. Optionally, BOUNDS of the current list item may be provided if available.
  5561. In nested lists, demote child items as well."
  5562. (interactive)
  5563. (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
  5564. (save-excursion
  5565. (let* ((item-start (set-marker (make-marker) (nth 0 bounds)))
  5566. (item-end (set-marker (make-marker) (nth 1 bounds)))
  5567. (list-start (progn (markdown-beginning-of-list)
  5568. (set-marker (make-marker) (point))))
  5569. (list-end (progn (markdown-end-of-list)
  5570. (set-marker (make-marker) (point)))))
  5571. (goto-char item-start)
  5572. (while (< (point) item-end)
  5573. (unless (markdown-cur-line-blank-p)
  5574. (insert (make-string markdown-list-indent-width ? )))
  5575. (forward-line))
  5576. (markdown-syntax-propertize-list-items list-start list-end)))))
  5577. (defun markdown-promote-list-item (&optional bounds)
  5578. "Unindent (or promote) the current list item.
  5579. Optionally, BOUNDS of the current list item may be provided if available.
  5580. In nested lists, demote child items as well."
  5581. (interactive)
  5582. (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
  5583. (save-excursion
  5584. (save-match-data
  5585. (let ((item-start (set-marker (make-marker) (nth 0 bounds)))
  5586. (item-end (set-marker (make-marker) (nth 1 bounds)))
  5587. (list-start (progn (markdown-beginning-of-list)
  5588. (set-marker (make-marker) (point))))
  5589. (list-end (progn (markdown-end-of-list)
  5590. (set-marker (make-marker) (point))))
  5591. num regexp)
  5592. (goto-char item-start)
  5593. (when (looking-at (format "^[ ]\\{1,%d\\}"
  5594. markdown-list-indent-width))
  5595. (setq num (- (match-end 0) (match-beginning 0)))
  5596. (setq regexp (format "^[ ]\\{1,%d\\}" num))
  5597. (while (and (< (point) item-end)
  5598. (re-search-forward regexp item-end t))
  5599. (replace-match "" nil nil)
  5600. (forward-line))
  5601. (markdown-syntax-propertize-list-items list-start list-end)))))))
  5602. (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item)
  5603. "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM.
  5604. PREV-ITEM is width of previous-indentation and list number
  5605. Assume that the previously found match was for a numbered item in
  5606. a list."
  5607. (let ((cpfx pfx)
  5608. (cur-item nil)
  5609. (idx 0)
  5610. (continue t)
  5611. (step t)
  5612. (sep nil))
  5613. (while (and continue (not (eobp)))
  5614. (setq step t)
  5615. (cond
  5616. ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ")
  5617. (setq cpfx (match-string-no-properties 2))
  5618. (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker
  5619. (cond
  5620. ((or (= (length cpfx) (length pfx))
  5621. (= (length cur-item) (length prev-item)))
  5622. (save-excursion
  5623. (replace-match
  5624. (if (not markdown-ordered-list-enumeration)
  5625. (concat pfx "1. ")
  5626. (cl-incf idx)
  5627. (concat pfx (number-to-string idx) ". "))))
  5628. (setq sep nil))
  5629. ;; indented a level
  5630. ((< (length pfx) (length cpfx))
  5631. (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item))
  5632. (setq step nil))
  5633. ;; exit the loop
  5634. (t
  5635. (setq step nil)
  5636. (setq continue nil))))
  5637. ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
  5638. (setq cpfx (match-string-no-properties 1))
  5639. (cond
  5640. ;; reset if separated before
  5641. ((string= cpfx pfx) (when sep (setq idx 0)))
  5642. ((string< cpfx pfx)
  5643. (setq step nil)
  5644. (setq continue nil))))
  5645. (t (setq sep t)))
  5646. (when step
  5647. (beginning-of-line)
  5648. (setq continue (= (forward-line) 0))))
  5649. sep))
  5650. (defun markdown-cleanup-list-numbers ()
  5651. "Update the numbering of ordered lists."
  5652. (interactive)
  5653. (save-excursion
  5654. (goto-char (point-min))
  5655. (markdown-cleanup-list-numbers-level "")))
  5656. ;;; Movement ==================================================================
  5657. (defun markdown-beginning-of-defun (&optional arg)
  5658. "`beginning-of-defun-function' for Markdown.
  5659. This is used to find the beginning of the defun and should behave
  5660. like beginning-of-defun, returning non-nil if it found the
  5661. beginning of a defun. It moves the point backward, right before a
  5662. heading which defines a defun. When ARG is non-nil, repeat that
  5663. many times. When ARG is negative, move forward to the ARG-th
  5664. following section."
  5665. (or arg (setq arg 1))
  5666. (when (< arg 0) (end-of-line))
  5667. ;; Adjust position for setext headings.
  5668. (when (and (thing-at-point-looking-at markdown-regex-header-setext)
  5669. (not (= (point) (match-beginning 0)))
  5670. (not (markdown-code-block-at-point-p)))
  5671. (goto-char (match-end 0)))
  5672. (let (found)
  5673. ;; Move backward with positive argument.
  5674. (while (and (not (bobp)) (> arg 0))
  5675. (setq found nil)
  5676. (while (and (not found)
  5677. (not (bobp))
  5678. (re-search-backward markdown-regex-header nil 'move))
  5679. (when (not (markdown-code-block-at-pos (match-beginning 0))))
  5680. (setq found (match-beginning 0)))
  5681. (setq arg (1- arg)))
  5682. ;; Move forward with negative argument.
  5683. (while (and (not (eobp)) (< arg 0))
  5684. (setq found nil)
  5685. (while (and (not found)
  5686. (not (eobp))
  5687. (re-search-forward markdown-regex-header nil 'move))
  5688. (when (not (markdown-code-block-at-pos (match-beginning 0))))
  5689. (setq found (match-beginning 0)))
  5690. (setq arg (1+ arg)))
  5691. (when found
  5692. (beginning-of-line)
  5693. t)))
  5694. (defun markdown-end-of-defun ()
  5695. "`end-of-defun-function’ for Markdown.
  5696. This is used to find the end of the defun at point.
  5697. It is called with no argument, right after calling beginning-of-defun-raw,
  5698. so it can assume that point is at the beginning of the defun body.
  5699. It should move point to the first position after the defun."
  5700. (or (eobp) (forward-char 1))
  5701. (let (found)
  5702. (while (and (not found)
  5703. (not (eobp))
  5704. (re-search-forward markdown-regex-header nil 'move))
  5705. (when (not (markdown-code-block-at-pos (match-beginning 0)))
  5706. (setq found (match-beginning 0))))
  5707. (when found
  5708. (goto-char found)
  5709. (skip-syntax-backward "-"))))
  5710. (defun markdown-beginning-of-text-block ()
  5711. "Move backward to previous beginning of a plain text block.
  5712. This function simply looks for blank lines without considering
  5713. the surrounding context in light of Markdown syntax. For that, see
  5714. `markdown-backward-block'."
  5715. (interactive)
  5716. (let ((start (point)))
  5717. (if (re-search-backward markdown-regex-block-separator nil t)
  5718. (goto-char (match-end 0))
  5719. (goto-char (point-min)))
  5720. (when (and (= start (point)) (not (bobp)))
  5721. (forward-line -1)
  5722. (if (re-search-backward markdown-regex-block-separator nil t)
  5723. (goto-char (match-end 0))
  5724. (goto-char (point-min))))))
  5725. (defun markdown-end-of-text-block ()
  5726. "Move forward to next beginning of a plain text block.
  5727. This function simply looks for blank lines without considering
  5728. the surrounding context in light of Markdown syntax. For that, see
  5729. `markdown-forward-block'."
  5730. (interactive)
  5731. (beginning-of-line)
  5732. (skip-chars-forward " \t\n")
  5733. (when (= (point) (point-min))
  5734. (forward-char))
  5735. (if (re-search-forward markdown-regex-block-separator nil t)
  5736. (goto-char (match-end 0))
  5737. (goto-char (point-max)))
  5738. (skip-chars-backward " \t\n")
  5739. (forward-line))
  5740. (defun markdown-backward-paragraph (&optional arg)
  5741. "Move the point to the start of the current paragraph.
  5742. With argument ARG, do it ARG times; a negative argument ARG = -N
  5743. means move forward N blocks."
  5744. (interactive "^p")
  5745. (or arg (setq arg 1))
  5746. (if (< arg 0)
  5747. (markdown-forward-paragraph (- arg))
  5748. (dotimes (_ arg)
  5749. ;; Skip over whitespace in between paragraphs when moving backward.
  5750. (skip-chars-backward " \t\n")
  5751. (beginning-of-line)
  5752. ;; Skip over code block endings.
  5753. (when (markdown-range-properties-exist
  5754. (point-at-bol) (point-at-eol)
  5755. '(markdown-gfm-block-end
  5756. markdown-tilde-fence-end))
  5757. (forward-line -1))
  5758. ;; Skip over blank lines inside blockquotes.
  5759. (while (and (not (eobp))
  5760. (looking-at markdown-regex-blockquote)
  5761. (= (length (match-string 3)) 0))
  5762. (forward-line -1))
  5763. ;; Proceed forward based on the type of block of paragraph.
  5764. (let (bounds skip)
  5765. (cond
  5766. ;; Blockquotes
  5767. ((looking-at markdown-regex-blockquote)
  5768. (while (and (not (bobp))
  5769. (looking-at markdown-regex-blockquote)
  5770. (> (length (match-string 3)) 0)) ;; not blank
  5771. (forward-line -1))
  5772. (forward-line))
  5773. ;; List items
  5774. ((setq bounds (markdown-cur-list-item-bounds))
  5775. (goto-char (nth 0 bounds)))
  5776. ;; Other
  5777. (t
  5778. (while (and (not (bobp))
  5779. (not skip)
  5780. (not (markdown-cur-line-blank-p))
  5781. (not (looking-at markdown-regex-blockquote))
  5782. (not (markdown-range-properties-exist
  5783. (point-at-bol) (point-at-eol)
  5784. '(markdown-gfm-block-end
  5785. markdown-tilde-fence-end))))
  5786. (setq skip (markdown-range-properties-exist
  5787. (point-at-bol) (point-at-eol)
  5788. '(markdown-gfm-block-begin
  5789. markdown-tilde-fence-begin)))
  5790. (forward-line -1))
  5791. (unless (bobp)
  5792. (forward-line 1))))))))
  5793. (defun markdown-forward-paragraph (&optional arg)
  5794. "Move forward to the next end of a paragraph.
  5795. With argument ARG, do it ARG times; a negative argument ARG = -N
  5796. means move backward N blocks."
  5797. (interactive "^p")
  5798. (or arg (setq arg 1))
  5799. (if (< arg 0)
  5800. (markdown-backward-paragraph (- arg))
  5801. (dotimes (_ arg)
  5802. ;; Skip whitespace in between paragraphs.
  5803. (when (markdown-cur-line-blank-p)
  5804. (skip-syntax-forward "-")
  5805. (beginning-of-line))
  5806. ;; Proceed forward based on the type of block.
  5807. (let (bounds skip)
  5808. (cond
  5809. ;; Blockquotes
  5810. ((looking-at markdown-regex-blockquote)
  5811. ;; Skip over blank lines inside blockquotes.
  5812. (while (and (not (eobp))
  5813. (looking-at markdown-regex-blockquote)
  5814. (= (length (match-string 3)) 0))
  5815. (forward-line))
  5816. ;; Move to end of quoted text block
  5817. (while (and (not (eobp))
  5818. (looking-at markdown-regex-blockquote)
  5819. (> (length (match-string 3)) 0)) ;; not blank
  5820. (forward-line)))
  5821. ;; List items
  5822. ((and (markdown-cur-list-item-bounds)
  5823. (setq bounds (markdown-next-list-item-bounds)))
  5824. (goto-char (nth 0 bounds)))
  5825. ;; Other
  5826. (t
  5827. (forward-line)
  5828. (while (and (not (eobp))
  5829. (not skip)
  5830. (not (markdown-cur-line-blank-p))
  5831. (not (looking-at markdown-regex-blockquote))
  5832. (not (markdown-range-properties-exist
  5833. (point-at-bol) (point-at-eol)
  5834. '(markdown-gfm-block-begin
  5835. markdown-tilde-fence-begin))))
  5836. (setq skip (markdown-range-properties-exist
  5837. (point-at-bol) (point-at-eol)
  5838. '(markdown-gfm-block-end
  5839. markdown-tilde-fence-end)))
  5840. (forward-line))))))))
  5841. (defun markdown-backward-block (&optional arg)
  5842. "Move the point to the start of the current Markdown block.
  5843. Moves across complete code blocks, list items, and blockquotes,
  5844. but otherwise stops at blank lines, headers, and horizontal
  5845. rules. With argument ARG, do it ARG times; a negative argument
  5846. ARG = -N means move forward N blocks."
  5847. (interactive "^p")
  5848. (or arg (setq arg 1))
  5849. (if (< arg 0)
  5850. (markdown-forward-block (- arg))
  5851. (dotimes (_ arg)
  5852. ;; Skip over whitespace in between blocks when moving backward,
  5853. ;; unless at a block boundary with no whitespace.
  5854. (skip-syntax-backward "-")
  5855. (beginning-of-line)
  5856. ;; Proceed forward based on the type of block.
  5857. (cond
  5858. ;; Code blocks
  5859. ((and (markdown-code-block-at-pos (point)) ;; this line
  5860. (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line
  5861. (forward-line -1)
  5862. (while (and (markdown-code-block-at-point-p) (not (bobp)))
  5863. (forward-line -1))
  5864. (forward-line))
  5865. ;; Headings
  5866. ((markdown-heading-at-point)
  5867. (goto-char (match-beginning 0)))
  5868. ;; Horizontal rules
  5869. ((looking-at markdown-regex-hr))
  5870. ;; Blockquotes
  5871. ((looking-at markdown-regex-blockquote)
  5872. (forward-line -1)
  5873. (while (and (looking-at markdown-regex-blockquote)
  5874. (not (bobp)))
  5875. (forward-line -1))
  5876. (forward-line))
  5877. ;; List items
  5878. ((markdown-cur-list-item-bounds)
  5879. (markdown-beginning-of-list))
  5880. ;; Other
  5881. (t
  5882. ;; Move forward in case it is a one line regular paragraph.
  5883. (unless (markdown-next-line-blank-p)
  5884. (forward-line))
  5885. (unless (markdown-prev-line-blank-p)
  5886. (markdown-backward-paragraph)))))))
  5887. (defun markdown-forward-block (&optional arg)
  5888. "Move forward to the next end of a Markdown block.
  5889. Moves across complete code blocks, list items, and blockquotes,
  5890. but otherwise stops at blank lines, headers, and horizontal
  5891. rules. With argument ARG, do it ARG times; a negative argument
  5892. ARG = -N means move backward N blocks."
  5893. (interactive "^p")
  5894. (or arg (setq arg 1))
  5895. (if (< arg 0)
  5896. (markdown-backward-block (- arg))
  5897. (dotimes (_ arg)
  5898. ;; Skip over whitespace in between blocks when moving forward.
  5899. (if (markdown-cur-line-blank-p)
  5900. (skip-syntax-forward "-")
  5901. (beginning-of-line))
  5902. ;; Proceed forward based on the type of block.
  5903. (cond
  5904. ;; Code blocks
  5905. ((markdown-code-block-at-point-p)
  5906. (forward-line)
  5907. (while (and (markdown-code-block-at-point-p) (not (eobp)))
  5908. (forward-line)))
  5909. ;; Headings
  5910. ((looking-at markdown-regex-header)
  5911. (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
  5912. (forward-line))
  5913. ;; Horizontal rules
  5914. ((looking-at markdown-regex-hr)
  5915. (forward-line))
  5916. ;; Blockquotes
  5917. ((looking-at markdown-regex-blockquote)
  5918. (forward-line)
  5919. (while (and (looking-at markdown-regex-blockquote) (not (eobp)))
  5920. (forward-line)))
  5921. ;; List items
  5922. ((markdown-cur-list-item-bounds)
  5923. (markdown-end-of-list)
  5924. (forward-line))
  5925. ;; Other
  5926. (t (markdown-forward-paragraph))))
  5927. (skip-syntax-backward "-")
  5928. (unless (eobp)
  5929. (forward-char 1))))
  5930. (defun markdown-backward-page (&optional count)
  5931. "Move backward to boundary of the current toplevel section.
  5932. With COUNT, repeat, or go forward if negative."
  5933. (interactive "p")
  5934. (or count (setq count 1))
  5935. (if (< count 0)
  5936. (markdown-forward-page (- count))
  5937. (skip-syntax-backward "-")
  5938. (or (markdown-back-to-heading-over-code-block t t)
  5939. (goto-char (point-min)))
  5940. (when (looking-at markdown-regex-header)
  5941. (let ((level (markdown-outline-level)))
  5942. (when (> level 1) (markdown-up-heading level))
  5943. (when (> count 1)
  5944. (condition-case nil
  5945. (markdown-backward-same-level (1- count))
  5946. (error (goto-char (point-min)))))))))
  5947. (defun markdown-forward-page (&optional count)
  5948. "Move forward to boundary of the current toplevel section.
  5949. With COUNT, repeat, or go backward if negative."
  5950. (interactive "p")
  5951. (or count (setq count 1))
  5952. (if (< count 0)
  5953. (markdown-backward-page (- count))
  5954. (if (markdown-back-to-heading-over-code-block t t)
  5955. (let ((level (markdown-outline-level)))
  5956. (when (> level 1) (markdown-up-heading level))
  5957. (condition-case nil
  5958. (markdown-forward-same-level count)
  5959. (error (goto-char (point-max)))))
  5960. (markdown-next-visible-heading 1))))
  5961. (defun markdown-next-link ()
  5962. "Jump to next inline, reference, or wiki link.
  5963. If successful, return point. Otherwise, return nil.
  5964. See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
  5965. (interactive)
  5966. (let ((opoint (point)))
  5967. (when (or (markdown-link-p) (markdown-wiki-link-p))
  5968. ;; At a link already, move past it.
  5969. (goto-char (+ (match-end 0) 1)))
  5970. ;; Search for the next wiki link and move to the beginning.
  5971. (while (and (re-search-forward (markdown-make-regex-link-generic) nil t)
  5972. (markdown-code-block-at-point-p)
  5973. (< (point) (point-max))))
  5974. (if (and (not (eq (point) opoint))
  5975. (or (markdown-link-p) (markdown-wiki-link-p)))
  5976. ;; Group 1 will move past non-escape character in wiki link regexp.
  5977. ;; Go to beginning of group zero for all other link types.
  5978. (goto-char (or (match-beginning 1) (match-beginning 0)))
  5979. (goto-char opoint)
  5980. nil)))
  5981. (defun markdown-previous-link ()
  5982. "Jump to previous wiki link.
  5983. If successful, return point. Otherwise, return nil.
  5984. See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
  5985. (interactive)
  5986. (let ((opoint (point)))
  5987. (while (and (re-search-backward (markdown-make-regex-link-generic) nil t)
  5988. (markdown-code-block-at-point-p)
  5989. (> (point) (point-min))))
  5990. (if (and (not (eq (point) opoint))
  5991. (or (markdown-link-p) (markdown-wiki-link-p)))
  5992. (goto-char (or (match-beginning 1) (match-beginning 0)))
  5993. (goto-char opoint)
  5994. nil)))
  5995. ;;; Outline ===================================================================
  5996. (defun markdown-move-heading-common (move-fn &optional arg adjust)
  5997. "Wrapper for `outline-mode' functions to skip false positives.
  5998. MOVE-FN is a function and ARG is its argument. For example,
  5999. headings inside preformatted code blocks may match
  6000. `outline-regexp' but should not be considered as headings.
  6001. When ADJUST is non-nil, adjust the point for interactive calls
  6002. to avoid leaving the point at invisible markup. This adjustment
  6003. generally should only be done for interactive calls, since other
  6004. functions may expect the point to be at the beginning of the
  6005. regular expression."
  6006. (let ((prev -1) (start (point)))
  6007. (if arg (funcall move-fn arg) (funcall move-fn))
  6008. (while (and (/= prev (point)) (markdown-code-block-at-point-p))
  6009. (setq prev (point))
  6010. (if arg (funcall move-fn arg) (funcall move-fn)))
  6011. ;; Adjust point for setext headings and invisible text.
  6012. (save-match-data
  6013. (when (and adjust (thing-at-point-looking-at markdown-regex-header))
  6014. (if markdown-hide-markup
  6015. ;; Move to beginning of heading text if markup is hidden.
  6016. (goto-char (or (match-beginning 1) (match-beginning 5)))
  6017. ;; Move to beginning of markup otherwise.
  6018. (goto-char (or (match-beginning 1) (match-beginning 4))))))
  6019. (if (= (point) start) nil (point))))
  6020. (defun markdown-next-visible-heading (arg)
  6021. "Move to the next visible heading line of any level.
  6022. With argument, repeats or can move backward if negative. ARG is
  6023. passed to `outline-next-visible-heading'."
  6024. (interactive "p")
  6025. (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust))
  6026. (defun markdown-previous-visible-heading (arg)
  6027. "Move to the previous visible heading line of any level.
  6028. With argument, repeats or can move backward if negative. ARG is
  6029. passed to `outline-previous-visible-heading'."
  6030. (interactive "p")
  6031. (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust))
  6032. (defun markdown-next-heading ()
  6033. "Move to the next heading line of any level."
  6034. (markdown-move-heading-common #'outline-next-heading))
  6035. (defun markdown-previous-heading ()
  6036. "Move to the previous heading line of any level."
  6037. (markdown-move-heading-common #'outline-previous-heading))
  6038. (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error)
  6039. "Move back to the beginning of the previous heading.
  6040. Returns t if the point is at a heading, the location if a heading
  6041. was found, and nil otherwise.
  6042. Only visible heading lines are considered, unless INVISIBLE-OK is
  6043. non-nil. Throw an error if there is no previous heading unless
  6044. NO-ERROR is non-nil.
  6045. Leaves match data intact for `markdown-regex-header'."
  6046. (beginning-of-line)
  6047. (or (and (markdown-heading-at-point)
  6048. (not (markdown-code-block-at-point-p)))
  6049. (let (found)
  6050. (save-excursion
  6051. (while (and (not found)
  6052. (re-search-backward markdown-regex-header nil t))
  6053. (when (and (or invisible-ok (not (outline-invisible-p)))
  6054. (not (markdown-code-block-at-point-p)))
  6055. (setq found (point))))
  6056. (if (not found)
  6057. (unless no-error (user-error "Before first heading"))
  6058. (setq found (point))))
  6059. (when found (goto-char found)))))
  6060. (defun markdown-forward-same-level (arg)
  6061. "Move forward to the ARG'th heading at same level as this one.
  6062. Stop at the first and last headings of a superior heading."
  6063. (interactive "p")
  6064. (markdown-back-to-heading-over-code-block)
  6065. (markdown-move-heading-common #'outline-forward-same-level arg 'adjust))
  6066. (defun markdown-backward-same-level (arg)
  6067. "Move backward to the ARG'th heading at same level as this one.
  6068. Stop at the first and last headings of a superior heading."
  6069. (interactive "p")
  6070. (markdown-back-to-heading-over-code-block)
  6071. (while (> arg 0)
  6072. (let ((point-to-move-to
  6073. (save-excursion
  6074. (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust))))
  6075. (if point-to-move-to
  6076. (progn
  6077. (goto-char point-to-move-to)
  6078. (setq arg (1- arg)))
  6079. (user-error "No previous same-level heading")))))
  6080. (defun markdown-up-heading (arg &optional interactive)
  6081. "Move to the visible heading line of which the present line is a subheading.
  6082. With argument, move up ARG levels. When called interactively (or
  6083. INTERACTIVE is non-nil), also push the mark."
  6084. (interactive "p\np")
  6085. (and interactive (not (eq last-command 'markdown-up-heading))
  6086. (push-mark))
  6087. (markdown-move-heading-common #'outline-up-heading arg 'adjust))
  6088. (defun markdown-back-to-heading (&optional invisible-ok)
  6089. "Move to previous heading line, or beg of this line if it's a heading.
  6090. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
  6091. (interactive)
  6092. (markdown-move-heading-common #'outline-back-to-heading invisible-ok))
  6093. (defalias 'markdown-end-of-heading 'outline-end-of-heading)
  6094. (defun markdown-on-heading-p ()
  6095. "Return non-nil if point is on a heading line."
  6096. (get-text-property (point-at-bol) 'markdown-heading))
  6097. (defun markdown-end-of-subtree (&optional invisible-OK)
  6098. "Move to the end of the current subtree.
  6099. Only visible heading lines are considered, unless INVISIBLE-OK is
  6100. non-nil.
  6101. Derived from `org-end-of-subtree'."
  6102. (markdown-back-to-heading invisible-OK)
  6103. (let ((first t)
  6104. (level (markdown-outline-level)))
  6105. (while (and (not (eobp))
  6106. (or first (> (markdown-outline-level) level)))
  6107. (setq first nil)
  6108. (markdown-next-heading))
  6109. (if (memq (preceding-char) '(?\n ?\^M))
  6110. (progn
  6111. ;; Go to end of line before heading
  6112. (forward-char -1)
  6113. (if (memq (preceding-char) '(?\n ?\^M))
  6114. ;; leave blank line before heading
  6115. (forward-char -1)))))
  6116. (point))
  6117. (defun markdown-outline-fix-visibility ()
  6118. "Hide any false positive headings that should not be shown.
  6119. For example, headings inside preformatted code blocks may match
  6120. `outline-regexp' but should not be shown as headings when cycling.
  6121. Also, the ending --- line in metadata blocks appears to be a
  6122. setext header, but should not be folded."
  6123. (save-excursion
  6124. (goto-char (point-min))
  6125. ;; Unhide any false positives in metadata blocks
  6126. (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin)
  6127. (let ((body (progn (forward-line)
  6128. (markdown-text-property-at-point
  6129. 'markdown-yaml-metadata-section))))
  6130. (when body
  6131. (let ((end (progn (goto-char (cl-second body))
  6132. (markdown-text-property-at-point
  6133. 'markdown-yaml-metadata-end))))
  6134. (outline-flag-region (point-min) (1+ (cl-second end)) nil)))))
  6135. ;; Hide any false positives in code blocks
  6136. (unless (outline-on-heading-p)
  6137. (outline-next-visible-heading 1))
  6138. (while (< (point) (point-max))
  6139. (when (markdown-code-block-at-point-p)
  6140. (outline-flag-region (1- (point-at-bol)) (point-at-eol) t))
  6141. (outline-next-visible-heading 1))))
  6142. (defvar markdown-cycle-global-status 1)
  6143. (defvar markdown-cycle-subtree-status nil)
  6144. (defun markdown-next-preface ()
  6145. (let (finish)
  6146. (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
  6147. nil 'move))
  6148. (unless (markdown-code-block-at-point-p)
  6149. (goto-char (match-beginning 0))
  6150. (setq finish t))))
  6151. (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
  6152. (forward-char -1)))
  6153. (defun markdown-show-entry ()
  6154. (save-excursion
  6155. (outline-back-to-heading t)
  6156. (outline-flag-region (1- (point))
  6157. (progn
  6158. (markdown-next-preface)
  6159. (if (= 1 (- (point-max) (point)))
  6160. (point-max)
  6161. (point)))
  6162. nil)))
  6163. ;; This function was originally derived from `org-cycle' from org.el.
  6164. (defun markdown-cycle (&optional arg)
  6165. "Visibility cycling for Markdown mode.
  6166. This function is called with a `\\[universal-argument]' or if ARG is t, perform
  6167. global visibility cycling. If the point is at an atx-style header, cycle
  6168. visibility of the corresponding subtree. Otherwise, indent the current line
  6169. or insert a tab, as appropriate, by calling `indent-for-tab-command'."
  6170. (interactive "P")
  6171. (cond
  6172. ;; Global cycling
  6173. (arg
  6174. (cond
  6175. ;; Move from overview to contents
  6176. ((and (eq last-command this-command)
  6177. (eq markdown-cycle-global-status 2))
  6178. (outline-hide-sublevels 1)
  6179. (message "CONTENTS")
  6180. (setq markdown-cycle-global-status 3)
  6181. (markdown-outline-fix-visibility))
  6182. ;; Move from contents to all
  6183. ((and (eq last-command this-command)
  6184. (eq markdown-cycle-global-status 3))
  6185. (outline-show-all)
  6186. (message "SHOW ALL")
  6187. (setq markdown-cycle-global-status 1))
  6188. ;; Defaults to overview
  6189. (t
  6190. (outline-hide-body)
  6191. (message "OVERVIEW")
  6192. (setq markdown-cycle-global-status 2)
  6193. (markdown-outline-fix-visibility))))
  6194. ;; At a heading: rotate between three different views
  6195. ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
  6196. (markdown-back-to-heading)
  6197. (let ((goal-column 0) eoh eol eos)
  6198. ;; Determine boundaries
  6199. (save-excursion
  6200. (markdown-back-to-heading)
  6201. (save-excursion
  6202. (beginning-of-line 2)
  6203. (while (and (not (eobp)) ;; this is like `next-line'
  6204. (get-char-property (1- (point)) 'invisible))
  6205. (beginning-of-line 2)) (setq eol (point)))
  6206. (markdown-end-of-heading) (setq eoh (point))
  6207. (markdown-end-of-subtree t)
  6208. (skip-chars-forward " \t\n")
  6209. (beginning-of-line 1) ; in case this is an item
  6210. (setq eos (1- (point))))
  6211. ;; Find out what to do next and set `this-command'
  6212. (cond
  6213. ;; Nothing is hidden behind this heading
  6214. ((= eos eoh)
  6215. (message "EMPTY ENTRY")
  6216. (setq markdown-cycle-subtree-status nil))
  6217. ;; Entire subtree is hidden in one line: open it
  6218. ((>= eol eos)
  6219. (markdown-show-entry)
  6220. (outline-show-children)
  6221. (message "CHILDREN")
  6222. (setq markdown-cycle-subtree-status 'children))
  6223. ;; We just showed the children, now show everything.
  6224. ((and (eq last-command this-command)
  6225. (eq markdown-cycle-subtree-status 'children))
  6226. (outline-show-subtree)
  6227. (message "SUBTREE")
  6228. (setq markdown-cycle-subtree-status 'subtree))
  6229. ;; Default action: hide the subtree.
  6230. (t
  6231. (outline-hide-subtree)
  6232. (message "FOLDED")
  6233. (setq markdown-cycle-subtree-status 'folded)))))
  6234. ;; In a table, move forward by one cell
  6235. ((markdown-table-at-point-p)
  6236. (call-interactively #'markdown-table-forward-cell))
  6237. ;; Otherwise, indent as appropriate
  6238. (t
  6239. (indent-for-tab-command))))
  6240. (defun markdown-shifttab ()
  6241. "Handle S-TAB keybinding based on context.
  6242. When in a table, move backward one cell.
  6243. Otherwise, cycle global heading visibility by calling
  6244. `markdown-cycle' with argument t."
  6245. (interactive)
  6246. (cond ((markdown-table-at-point-p)
  6247. (call-interactively #'markdown-table-backward-cell))
  6248. (t (markdown-cycle t))))
  6249. (defun markdown-outline-level ()
  6250. "Return the depth to which a statement is nested in the outline."
  6251. (cond
  6252. ((and (match-beginning 0)
  6253. (markdown-code-block-at-pos (match-beginning 0)))
  6254. 7) ;; Only 6 header levels are defined.
  6255. ((match-end 2) 1)
  6256. ((match-end 3) 2)
  6257. ((match-end 4)
  6258. (length (markdown-trim-whitespace (match-string-no-properties 4))))))
  6259. (defun markdown-promote-subtree (&optional arg)
  6260. "Promote the current subtree of ATX headings.
  6261. Note that Markdown does not support heading levels higher than
  6262. six and therefore level-six headings will not be promoted
  6263. further. If ARG is non-nil promote the heading, otherwise
  6264. demote."
  6265. (interactive "*P")
  6266. (save-excursion
  6267. (when (and (or (thing-at-point-looking-at markdown-regex-header-atx)
  6268. (re-search-backward markdown-regex-header-atx nil t))
  6269. (not (markdown-code-block-at-point-p)))
  6270. (let ((level (length (match-string 1)))
  6271. (promote-or-demote (if arg 1 -1))
  6272. (remove 't))
  6273. (markdown-cycle-atx promote-or-demote remove)
  6274. (catch 'end-of-subtree
  6275. (while (and (markdown-next-heading)
  6276. (looking-at markdown-regex-header-atx))
  6277. ;; Exit if this not a higher level heading; promote otherwise.
  6278. (if (and (looking-at markdown-regex-header-atx)
  6279. (<= (length (match-string-no-properties 1)) level))
  6280. (throw 'end-of-subtree nil)
  6281. (markdown-cycle-atx promote-or-demote remove))))))))
  6282. (defun markdown-demote-subtree ()
  6283. "Demote the current subtree of ATX headings."
  6284. (interactive)
  6285. (markdown-promote-subtree t))
  6286. (defun markdown-move-subtree-up ()
  6287. "Move the current subtree of ATX headings up."
  6288. (interactive)
  6289. (outline-move-subtree-up 1))
  6290. (defun markdown-move-subtree-down ()
  6291. "Move the current subtree of ATX headings down."
  6292. (interactive)
  6293. (outline-move-subtree-down 1))
  6294. (defun markdown-outline-next ()
  6295. "Move to next list item, when in a list, or next visible heading."
  6296. (interactive)
  6297. (let ((bounds (markdown-next-list-item-bounds)))
  6298. (if bounds
  6299. (goto-char (nth 0 bounds))
  6300. (markdown-next-visible-heading 1))))
  6301. (defun markdown-outline-previous ()
  6302. "Move to previous list item, when in a list, or previous visible heading."
  6303. (interactive)
  6304. (let ((bounds (markdown-prev-list-item-bounds)))
  6305. (if bounds
  6306. (goto-char (nth 0 bounds))
  6307. (markdown-previous-visible-heading 1))))
  6308. (defun markdown-outline-next-same-level ()
  6309. "Move to next list item or heading of same level."
  6310. (interactive)
  6311. (let ((bounds (markdown-cur-list-item-bounds)))
  6312. (if bounds
  6313. (markdown-next-list-item (nth 3 bounds))
  6314. (markdown-forward-same-level 1))))
  6315. (defun markdown-outline-previous-same-level ()
  6316. "Move to previous list item or heading of same level."
  6317. (interactive)
  6318. (let ((bounds (markdown-cur-list-item-bounds)))
  6319. (if bounds
  6320. (markdown-prev-list-item (nth 3 bounds))
  6321. (markdown-backward-same-level 1))))
  6322. (defun markdown-outline-up ()
  6323. "Move to previous list item, when in a list, or next heading."
  6324. (interactive)
  6325. (unless (markdown-up-list)
  6326. (markdown-up-heading 1)))
  6327. ;;; Marking and Narrowing =====================================================
  6328. (defun markdown-mark-paragraph ()
  6329. "Put mark at end of this block, point at beginning.
  6330. The block marked is the one that contains point or follows point.
  6331. Interactively, if this command is repeated or (in Transient Mark
  6332. mode) if the mark is active, it marks the next block after the
  6333. ones already marked."
  6334. (interactive)
  6335. (if (or (and (eq last-command this-command) (mark t))
  6336. (and transient-mark-mode mark-active))
  6337. (set-mark
  6338. (save-excursion
  6339. (goto-char (mark))
  6340. (markdown-forward-paragraph)
  6341. (point)))
  6342. (let ((beginning-of-defun-function 'markdown-backward-paragraph)
  6343. (end-of-defun-function 'markdown-forward-paragraph))
  6344. (mark-defun))))
  6345. (defun markdown-mark-block ()
  6346. "Put mark at end of this block, point at beginning.
  6347. The block marked is the one that contains point or follows point.
  6348. Interactively, if this command is repeated or (in Transient Mark
  6349. mode) if the mark is active, it marks the next block after the
  6350. ones already marked."
  6351. (interactive)
  6352. (if (or (and (eq last-command this-command) (mark t))
  6353. (and transient-mark-mode mark-active))
  6354. (set-mark
  6355. (save-excursion
  6356. (goto-char (mark))
  6357. (markdown-forward-block)
  6358. (point)))
  6359. (let ((beginning-of-defun-function 'markdown-backward-block)
  6360. (end-of-defun-function 'markdown-forward-block))
  6361. (mark-defun))))
  6362. (defun markdown-narrow-to-block ()
  6363. "Make text outside current block invisible.
  6364. The current block is the one that contains point or follows point."
  6365. (interactive)
  6366. (let ((beginning-of-defun-function 'markdown-backward-block)
  6367. (end-of-defun-function 'markdown-forward-block))
  6368. (narrow-to-defun)))
  6369. (defun markdown-mark-text-block ()
  6370. "Put mark at end of this plain text block, point at beginning.
  6371. The block marked is the one that contains point or follows point.
  6372. Interactively, if this command is repeated or (in Transient Mark
  6373. mode) if the mark is active, it marks the next block after the
  6374. ones already marked."
  6375. (interactive)
  6376. (if (or (and (eq last-command this-command) (mark t))
  6377. (and transient-mark-mode mark-active))
  6378. (set-mark
  6379. (save-excursion
  6380. (goto-char (mark))
  6381. (markdown-end-of-text-block)
  6382. (point)))
  6383. (let ((beginning-of-defun-function 'markdown-beginning-of-text-block)
  6384. (end-of-defun-function 'markdown-end-of-text-block))
  6385. (mark-defun))))
  6386. (defun markdown-mark-page ()
  6387. "Put mark at end of this top level section, point at beginning.
  6388. The top level section marked is the one that contains point or
  6389. follows point.
  6390. Interactively, if this command is repeated or (in Transient Mark
  6391. mode) if the mark is active, it marks the next page after the
  6392. ones already marked."
  6393. (interactive)
  6394. (if (or (and (eq last-command this-command) (mark t))
  6395. (and transient-mark-mode mark-active))
  6396. (set-mark
  6397. (save-excursion
  6398. (goto-char (mark))
  6399. (markdown-forward-page)
  6400. (point)))
  6401. (let ((beginning-of-defun-function 'markdown-backward-page)
  6402. (end-of-defun-function 'markdown-forward-page))
  6403. (mark-defun))))
  6404. (defun markdown-narrow-to-page ()
  6405. "Make text outside current top level section invisible.
  6406. The current section is the one that contains point or follows point."
  6407. (interactive)
  6408. (let ((beginning-of-defun-function 'markdown-backward-page)
  6409. (end-of-defun-function 'markdown-forward-page))
  6410. (narrow-to-defun)))
  6411. (defun markdown-mark-subtree ()
  6412. "Mark the current subtree.
  6413. This puts point at the start of the current subtree, and mark at the end."
  6414. (interactive)
  6415. (let ((beg))
  6416. (if (markdown-heading-at-point)
  6417. (beginning-of-line)
  6418. (markdown-previous-visible-heading 1))
  6419. (setq beg (point))
  6420. (markdown-end-of-subtree)
  6421. (push-mark (point) nil t)
  6422. (goto-char beg)))
  6423. (defun markdown-narrow-to-subtree ()
  6424. "Narrow buffer to the current subtree."
  6425. (interactive)
  6426. (save-excursion
  6427. (save-match-data
  6428. (narrow-to-region
  6429. (progn (markdown-back-to-heading-over-code-block t) (point))
  6430. (progn (markdown-end-of-subtree)
  6431. (if (and (markdown-heading-at-point) (not (eobp)))
  6432. (backward-char 1))
  6433. (point))))))
  6434. ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
  6435. (defun markdown-move-up ()
  6436. "Move thing at point up.
  6437. When in a list item, call `markdown-move-list-item-up'.
  6438. When in a table, call `markdown-table-move-row-up'.
  6439. Otherwise, move the current heading subtree up with
  6440. `markdown-move-subtree-up'."
  6441. (interactive)
  6442. (cond
  6443. ((markdown-list-item-at-point-p)
  6444. (call-interactively #'markdown-move-list-item-up))
  6445. ((markdown-table-at-point-p)
  6446. (call-interactively #'markdown-table-move-row-up))
  6447. (t
  6448. (call-interactively #'markdown-move-subtree-up))))
  6449. (defun markdown-move-down ()
  6450. "Move thing at point down.
  6451. When in a list item, call `markdown-move-list-item-down'.
  6452. Otherwise, move the current heading subtree up with
  6453. `markdown-move-subtree-down'."
  6454. (interactive)
  6455. (cond
  6456. ((markdown-list-item-at-point-p)
  6457. (call-interactively #'markdown-move-list-item-down))
  6458. ((markdown-table-at-point-p)
  6459. (call-interactively #'markdown-table-move-row-down))
  6460. (t
  6461. (call-interactively #'markdown-move-subtree-down))))
  6462. (defun markdown-promote ()
  6463. "Promote or move element at point to the left.
  6464. Depending on the context, this function will promote a heading or
  6465. list item at the point, move a table column to the left, or cycle
  6466. markup."
  6467. (interactive)
  6468. (let (bounds)
  6469. (cond
  6470. ;; Promote atx heading subtree
  6471. ((thing-at-point-looking-at markdown-regex-header-atx)
  6472. (markdown-promote-subtree))
  6473. ;; Promote setext heading
  6474. ((thing-at-point-looking-at markdown-regex-header-setext)
  6475. (markdown-cycle-setext -1))
  6476. ;; Promote horizontal rule
  6477. ((thing-at-point-looking-at markdown-regex-hr)
  6478. (markdown-cycle-hr -1))
  6479. ;; Promote list item
  6480. ((setq bounds (markdown-cur-list-item-bounds))
  6481. (markdown-promote-list-item bounds))
  6482. ;; Move table column to the left
  6483. ((markdown-table-at-point-p)
  6484. (call-interactively #'markdown-table-move-column-left))
  6485. ;; Promote bold
  6486. ((thing-at-point-looking-at markdown-regex-bold)
  6487. (markdown-cycle-bold))
  6488. ;; Promote italic
  6489. ((thing-at-point-looking-at markdown-regex-italic)
  6490. (markdown-cycle-italic))
  6491. (t
  6492. (user-error "Nothing to promote at point")))))
  6493. (defun markdown-demote ()
  6494. "Demote or move element at point to the right.
  6495. Depending on the context, this function will demote a heading or
  6496. list item at the point, move a table column to the right, or cycle
  6497. or remove markup."
  6498. (interactive)
  6499. (let (bounds)
  6500. (cond
  6501. ;; Demote atx heading subtree
  6502. ((thing-at-point-looking-at markdown-regex-header-atx)
  6503. (markdown-demote-subtree))
  6504. ;; Demote setext heading
  6505. ((thing-at-point-looking-at markdown-regex-header-setext)
  6506. (markdown-cycle-setext 1))
  6507. ;; Demote horizontal rule
  6508. ((thing-at-point-looking-at markdown-regex-hr)
  6509. (markdown-cycle-hr 1))
  6510. ;; Demote list item
  6511. ((setq bounds (markdown-cur-list-item-bounds))
  6512. (markdown-demote-list-item bounds))
  6513. ;; Move table column to the right
  6514. ((markdown-table-at-point-p)
  6515. (call-interactively #'markdown-table-move-column-right))
  6516. ;; Demote bold
  6517. ((thing-at-point-looking-at markdown-regex-bold)
  6518. (markdown-cycle-bold))
  6519. ;; Demote italic
  6520. ((thing-at-point-looking-at markdown-regex-italic)
  6521. (markdown-cycle-italic))
  6522. (t
  6523. (user-error "Nothing to demote at point")))))
  6524. ;;; Commands ==================================================================
  6525. (defun markdown (&optional output-buffer-name)
  6526. "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
  6527. The output buffer name defaults to `markdown-output-buffer-name'.
  6528. Return the name of the output buffer used."
  6529. (interactive)
  6530. (save-window-excursion
  6531. (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command))
  6532. ((listp markdown-command) markdown-command)))
  6533. (command (car-safe commands))
  6534. (command-args (cdr-safe commands))
  6535. begin-region end-region)
  6536. (if (use-region-p)
  6537. (setq begin-region (region-beginning)
  6538. end-region (region-end))
  6539. (setq begin-region (point-min)
  6540. end-region (point-max)))
  6541. (unless output-buffer-name
  6542. (setq output-buffer-name markdown-output-buffer-name))
  6543. (when (and (stringp command) (not (executable-find command)))
  6544. (user-error "Markdown command %s is not found" command))
  6545. (let ((exit-code
  6546. (cond
  6547. ;; Handle case when `markdown-command' does not read from stdin
  6548. ((and (stringp command) markdown-command-needs-filename)
  6549. (if (not buffer-file-name)
  6550. (user-error "Must be visiting a file")
  6551. ;; Don’t use ‘shell-command’ because it’s not guaranteed to
  6552. ;; return the exit code of the process.
  6553. (let ((command (if (listp markdown-command)
  6554. (string-join markdown-command " ")
  6555. markdown-command)))
  6556. (shell-command-on-region
  6557. ;; Pass an empty region so that stdin is empty.
  6558. (point) (point)
  6559. (concat command " "
  6560. (shell-quote-argument buffer-file-name))
  6561. output-buffer-name))))
  6562. ;; Pass region to `markdown-command' via stdin
  6563. (t
  6564. (let ((buf (get-buffer-create output-buffer-name)))
  6565. (with-current-buffer buf
  6566. (setq buffer-read-only nil)
  6567. (erase-buffer))
  6568. (if (stringp command)
  6569. (if (not (null command-args))
  6570. (apply #'call-process-region begin-region end-region command nil buf nil command-args)
  6571. (call-process-region begin-region end-region command nil buf))
  6572. (funcall markdown-command begin-region end-region buf)
  6573. ;; If the ‘markdown-command’ function didn’t signal an
  6574. ;; error, assume it succeeded by binding ‘exit-code’ to 0.
  6575. 0))))))
  6576. ;; The exit code can be a signal description string, so don’t use ‘=’
  6577. ;; or ‘zerop’.
  6578. (unless (eq exit-code 0)
  6579. (user-error "%s failed with exit code %s"
  6580. markdown-command exit-code))))
  6581. output-buffer-name))
  6582. (defun markdown-standalone (&optional output-buffer-name)
  6583. "Special function to provide standalone HTML output.
  6584. Insert the output in the buffer named OUTPUT-BUFFER-NAME."
  6585. (interactive)
  6586. (setq output-buffer-name (markdown output-buffer-name))
  6587. (with-current-buffer output-buffer-name
  6588. (set-buffer output-buffer-name)
  6589. (unless (markdown-output-standalone-p)
  6590. (markdown-add-xhtml-header-and-footer output-buffer-name))
  6591. (goto-char (point-min))
  6592. (html-mode))
  6593. output-buffer-name)
  6594. (defun markdown-other-window (&optional output-buffer-name)
  6595. "Run `markdown-command' on current buffer and display in other window.
  6596. When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
  6597. that name."
  6598. (interactive)
  6599. (markdown-display-buffer-other-window
  6600. (markdown-standalone output-buffer-name)))
  6601. (defun markdown-output-standalone-p ()
  6602. "Determine whether `markdown-command' output is standalone XHTML.
  6603. Standalone XHTML output is identified by an occurrence of
  6604. `markdown-xhtml-standalone-regexp' in the first five lines of output."
  6605. (save-excursion
  6606. (goto-char (point-min))
  6607. (save-match-data
  6608. (re-search-forward
  6609. markdown-xhtml-standalone-regexp
  6610. (save-excursion (goto-char (point-min)) (forward-line 4) (point))
  6611. t))))
  6612. (defun markdown-stylesheet-link-string (stylesheet-path)
  6613. (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
  6614. (or (and (string-prefix-p "~" stylesheet-path)
  6615. (expand-file-name stylesheet-path))
  6616. stylesheet-path)
  6617. "\" />"))
  6618. (defun markdown-add-xhtml-header-and-footer (title)
  6619. "Wrap XHTML header and footer with given TITLE around current buffer."
  6620. (goto-char (point-min))
  6621. (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
  6622. "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
  6623. "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
  6624. "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
  6625. "<head>\n<title>")
  6626. (insert title)
  6627. (insert "</title>\n")
  6628. (unless (= (length markdown-content-type) 0)
  6629. (insert
  6630. (format
  6631. "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
  6632. markdown-content-type
  6633. (or (and markdown-coding-system
  6634. (coding-system-get markdown-coding-system
  6635. 'mime-charset))
  6636. (coding-system-get buffer-file-coding-system
  6637. 'mime-charset)
  6638. "utf-8"))))
  6639. (if (> (length markdown-css-paths) 0)
  6640. (insert (mapconcat #'markdown-stylesheet-link-string
  6641. markdown-css-paths "\n")))
  6642. (when (> (length markdown-xhtml-header-content) 0)
  6643. (insert markdown-xhtml-header-content))
  6644. (insert "\n</head>\n\n"
  6645. "<body>\n\n")
  6646. (when (> (length markdown-xhtml-body-preamble) 0)
  6647. (insert markdown-xhtml-body-preamble "\n"))
  6648. (goto-char (point-max))
  6649. (when (> (length markdown-xhtml-body-epilogue) 0)
  6650. (insert "\n" markdown-xhtml-body-epilogue))
  6651. (insert "\n"
  6652. "</body>\n"
  6653. "</html>\n"))
  6654. (defun markdown-preview (&optional output-buffer-name)
  6655. "Run `markdown-command' on the current buffer and view output in browser.
  6656. When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
  6657. that name."
  6658. (interactive)
  6659. (browse-url-of-buffer
  6660. (markdown-standalone (or output-buffer-name markdown-output-buffer-name))))
  6661. (defun markdown-export-file-name (&optional extension)
  6662. "Attempt to generate a filename for Markdown output.
  6663. The file extension will be EXTENSION if given, or .html by default.
  6664. If the current buffer is visiting a file, we construct a new
  6665. output filename based on that filename. Otherwise, return nil."
  6666. (when (buffer-file-name)
  6667. (unless extension
  6668. (setq extension ".html"))
  6669. (let ((candidate
  6670. (concat
  6671. (cond
  6672. ((buffer-file-name)
  6673. (file-name-sans-extension (buffer-file-name)))
  6674. (t (buffer-name)))
  6675. extension)))
  6676. (cond
  6677. ((equal candidate (buffer-file-name))
  6678. (concat candidate extension))
  6679. (t
  6680. candidate)))))
  6681. (defun markdown-export (&optional output-file)
  6682. "Run Markdown on the current buffer, save to file, and return the filename.
  6683. If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
  6684. generated by `markdown-export-file-name', which will be constructed using the
  6685. current filename, but with the extension removed and replaced with .html."
  6686. (interactive)
  6687. (unless output-file
  6688. (setq output-file (markdown-export-file-name ".html")))
  6689. (when output-file
  6690. (let* ((init-buf (current-buffer))
  6691. (init-point (point))
  6692. (init-buf-string (buffer-string))
  6693. (output-buffer (find-file-noselect output-file))
  6694. (output-buffer-name (buffer-name output-buffer)))
  6695. (run-hooks 'markdown-before-export-hook)
  6696. (markdown-standalone output-buffer-name)
  6697. (with-current-buffer output-buffer
  6698. (run-hooks 'markdown-after-export-hook)
  6699. (save-buffer)
  6700. (when markdown-export-kill-buffer (kill-buffer)))
  6701. ;; if modified, restore initial buffer
  6702. (when (buffer-modified-p init-buf)
  6703. (erase-buffer)
  6704. (insert init-buf-string)
  6705. (save-buffer)
  6706. (goto-char init-point))
  6707. output-file)))
  6708. (defun markdown-export-and-preview ()
  6709. "Export to XHTML using `markdown-export' and browse the resulting file."
  6710. (interactive)
  6711. (browse-url-of-file (markdown-export)))
  6712. (defvar-local markdown-live-preview-buffer nil
  6713. "Buffer used to preview markdown output in `markdown-live-preview-export'.")
  6714. (defvar-local markdown-live-preview-source-buffer nil
  6715. "Source buffer from which current buffer was generated.
  6716. This is the inverse of `markdown-live-preview-buffer'.")
  6717. (defvar markdown-live-preview-currently-exporting nil)
  6718. (defun markdown-live-preview-get-filename ()
  6719. "Standardize the filename exported by `markdown-live-preview-export'."
  6720. (markdown-export-file-name ".html"))
  6721. (defun markdown-live-preview-window-eww (file)
  6722. "Preview FILE with eww.
  6723. To be used with `markdown-live-preview-window-function'."
  6724. (eww-open-file file)
  6725. (get-buffer "*eww*"))
  6726. (defun markdown-visual-lines-between-points (beg end)
  6727. (save-excursion
  6728. (goto-char beg)
  6729. (cl-loop with count = 0
  6730. while (progn (end-of-visual-line)
  6731. (and (< (point) end) (line-move-visual 1 t)))
  6732. do (cl-incf count)
  6733. finally return count)))
  6734. (defun markdown-live-preview-window-serialize (buf)
  6735. "Get window point and scroll data for all windows displaying BUF."
  6736. (when (buffer-live-p buf)
  6737. (with-current-buffer buf
  6738. (mapcar
  6739. (lambda (win)
  6740. (with-selected-window win
  6741. (let* ((start (window-start))
  6742. (pt (window-point))
  6743. (pt-or-sym (cond ((= pt (point-min)) 'min)
  6744. ((= pt (point-max)) 'max)
  6745. (t pt)))
  6746. (diff (markdown-visual-lines-between-points
  6747. start pt)))
  6748. (list win pt-or-sym diff))))
  6749. (get-buffer-window-list buf)))))
  6750. (defun markdown-get-point-back-lines (pt num-lines)
  6751. (save-excursion
  6752. (goto-char pt)
  6753. (line-move-visual (- num-lines) t)
  6754. ;; in testing, can occasionally overshoot the number of lines to traverse
  6755. (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt)))
  6756. (when (> actual-num-lines num-lines)
  6757. (line-move-visual (- actual-num-lines num-lines) t)))
  6758. (point)))
  6759. (defun markdown-live-preview-window-deserialize (window-posns)
  6760. "Apply window point and scroll data from WINDOW-POSNS.
  6761. WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
  6762. (cl-destructuring-bind (win pt-or-sym diff) window-posns
  6763. (when (window-live-p win)
  6764. (with-current-buffer markdown-live-preview-buffer
  6765. (set-window-buffer win (current-buffer))
  6766. (cl-destructuring-bind (actual-pt actual-diff)
  6767. (cl-case pt-or-sym
  6768. (min (list (point-min) 0))
  6769. (max (list (point-max) diff))
  6770. (t (list pt-or-sym diff)))
  6771. (set-window-start
  6772. win (markdown-get-point-back-lines actual-pt actual-diff))
  6773. (set-window-point win actual-pt))))))
  6774. (defun markdown-live-preview-export ()
  6775. "Export to XHTML using `markdown-export'.
  6776. Browse the resulting file within Emacs using
  6777. `markdown-live-preview-window-function' Return the buffer
  6778. displaying the rendered output."
  6779. (interactive)
  6780. (let ((filename (markdown-live-preview-get-filename)))
  6781. (when filename
  6782. (let* ((markdown-live-preview-currently-exporting t)
  6783. (cur-buf (current-buffer))
  6784. (export-file (markdown-export filename))
  6785. ;; get positions in all windows currently displaying output buffer
  6786. (window-data
  6787. (markdown-live-preview-window-serialize
  6788. markdown-live-preview-buffer)))
  6789. (save-window-excursion
  6790. (let ((output-buffer
  6791. (funcall markdown-live-preview-window-function export-file)))
  6792. (with-current-buffer output-buffer
  6793. (setq markdown-live-preview-source-buffer cur-buf)
  6794. (add-hook 'kill-buffer-hook
  6795. #'markdown-live-preview-remove-on-kill t t))
  6796. (with-current-buffer cur-buf
  6797. (setq markdown-live-preview-buffer output-buffer))))
  6798. (with-current-buffer cur-buf
  6799. ;; reset all windows displaying output buffer to where they were,
  6800. ;; now with the new output
  6801. (mapc #'markdown-live-preview-window-deserialize window-data)
  6802. ;; delete html editing buffer
  6803. (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf)))
  6804. (when (and export-file (file-exists-p export-file)
  6805. (eq markdown-live-preview-delete-export
  6806. 'delete-on-export))
  6807. (delete-file export-file))
  6808. markdown-live-preview-buffer)))))
  6809. (defun markdown-live-preview-remove ()
  6810. (when (buffer-live-p markdown-live-preview-buffer)
  6811. (kill-buffer markdown-live-preview-buffer))
  6812. (setq markdown-live-preview-buffer nil)
  6813. ;; if set to 'delete-on-export, the output has already been deleted
  6814. (when (eq markdown-live-preview-delete-export 'delete-on-destroy)
  6815. (let ((outfile-name (markdown-live-preview-get-filename)))
  6816. (when (and outfile-name (file-exists-p outfile-name))
  6817. (delete-file outfile-name)))))
  6818. (defun markdown-get-other-window ()
  6819. "Find another window to display preview or output content."
  6820. (cond
  6821. ((memq markdown-split-window-direction '(vertical below))
  6822. (or (window-in-direction 'below) (split-window-vertically)))
  6823. ((memq markdown-split-window-direction '(horizontal right))
  6824. (or (window-in-direction 'right) (split-window-horizontally)))
  6825. (t (split-window-sensibly (get-buffer-window)))))
  6826. (defun markdown-display-buffer-other-window (buf)
  6827. "Display preview or output buffer BUF in another window."
  6828. (if (and display-buffer-alist (eq markdown-split-window-direction 'any))
  6829. (display-buffer buf)
  6830. (let ((cur-buf (current-buffer))
  6831. (window (markdown-get-other-window)))
  6832. (set-window-buffer window buf)
  6833. (set-buffer cur-buf))))
  6834. (defun markdown-live-preview-if-markdown ()
  6835. (when (and (derived-mode-p 'markdown-mode)
  6836. markdown-live-preview-mode)
  6837. (unless markdown-live-preview-currently-exporting
  6838. (if (buffer-live-p markdown-live-preview-buffer)
  6839. (markdown-live-preview-export)
  6840. (markdown-display-buffer-other-window
  6841. (markdown-live-preview-export))))))
  6842. (defun markdown-live-preview-remove-on-kill ()
  6843. (cond ((and (derived-mode-p 'markdown-mode)
  6844. markdown-live-preview-mode)
  6845. (markdown-live-preview-remove))
  6846. (markdown-live-preview-source-buffer
  6847. (with-current-buffer markdown-live-preview-source-buffer
  6848. (setq markdown-live-preview-buffer nil))
  6849. (setq markdown-live-preview-source-buffer nil))))
  6850. (defun markdown-live-preview-switch-to-output ()
  6851. "Switch to output buffer."
  6852. (interactive)
  6853. "Turn on `markdown-live-preview-mode' if not already on, and switch to its
  6854. output buffer in another window."
  6855. (if markdown-live-preview-mode
  6856. (markdown-display-buffer-other-window (markdown-live-preview-export)))
  6857. (markdown-live-preview-mode))
  6858. (defun markdown-live-preview-re-export ()
  6859. "Re export source buffer."
  6860. (interactive)
  6861. "If the current buffer is a buffer displaying the exported version of a
  6862. `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
  6863. update this buffer's contents."
  6864. (when markdown-live-preview-source-buffer
  6865. (with-current-buffer markdown-live-preview-source-buffer
  6866. (markdown-live-preview-export))))
  6867. (defun markdown-open ()
  6868. "Open file for the current buffer with `markdown-open-command'."
  6869. (interactive)
  6870. (unless markdown-open-command
  6871. (user-error "Variable `markdown-open-command' must be set"))
  6872. (if (stringp markdown-open-command)
  6873. (if (not buffer-file-name)
  6874. (user-error "Must be visiting a file")
  6875. (save-buffer)
  6876. (let ((exit-code (call-process markdown-open-command nil nil nil
  6877. buffer-file-name)))
  6878. ;; The exit code can be a signal description string, so don’t use ‘=’
  6879. ;; or ‘zerop’.
  6880. (unless (eq exit-code 0)
  6881. (user-error "%s failed with exit code %s"
  6882. markdown-open-command exit-code))))
  6883. (funcall markdown-open-command))
  6884. nil)
  6885. (defun markdown-kill-ring-save ()
  6886. "Run Markdown on file and store output in the kill ring."
  6887. (interactive)
  6888. (save-window-excursion
  6889. (markdown)
  6890. (with-current-buffer markdown-output-buffer-name
  6891. (kill-ring-save (point-min) (point-max)))))
  6892. ;;; Links =====================================================================
  6893. (defun markdown-backward-to-link-start ()
  6894. "Backward link start position if current position is in link title."
  6895. ;; Issue #305
  6896. (when (eq (get-text-property (point) 'face) 'markdown-link-face)
  6897. (skip-chars-backward "^[")
  6898. (forward-char -1)))
  6899. (defun markdown-link-p ()
  6900. "Return non-nil when `point' is at a non-wiki link.
  6901. See `markdown-wiki-link-p' for more information."
  6902. (save-excursion
  6903. (let ((case-fold-search nil))
  6904. (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p)))
  6905. (markdown-backward-to-link-start)
  6906. (or (thing-at-point-looking-at markdown-regex-link-inline)
  6907. (thing-at-point-looking-at markdown-regex-link-reference)
  6908. (thing-at-point-looking-at markdown-regex-uri)
  6909. (thing-at-point-looking-at markdown-regex-angle-uri))))))
  6910. (defun markdown-link-at-pos (pos)
  6911. "Return properties of link or image at position POS.
  6912. Value is a list of elements describing the link:
  6913. 0. beginning position
  6914. 1. end position
  6915. 2. link text
  6916. 3. URL
  6917. 4. reference label
  6918. 5. title text
  6919. 6. bang (nil or \"!\")"
  6920. (save-excursion
  6921. (goto-char pos)
  6922. (markdown-backward-to-link-start)
  6923. (let (begin end text url reference title bang)
  6924. (cond
  6925. ;; Inline image or link at point.
  6926. ((thing-at-point-looking-at markdown-regex-link-inline)
  6927. (setq bang (match-string-no-properties 1)
  6928. begin (match-beginning 0)
  6929. end (match-end 0)
  6930. text (match-string-no-properties 3)
  6931. url (match-string-no-properties 6))
  6932. (if (match-end 7)
  6933. (setq title (substring (match-string-no-properties 7) 1 -1))
  6934. ;; #408 URL contains close parenthesis case
  6935. (goto-char (match-beginning 5))
  6936. (let ((paren-end (scan-sexps (point) 1)))
  6937. (when (and paren-end (< end paren-end))
  6938. (setq url (buffer-substring (match-beginning 6) (1- paren-end)))))))
  6939. ;; Reference link at point.
  6940. ((or (thing-at-point-looking-at markdown-regex-link-inline)
  6941. (thing-at-point-looking-at markdown-regex-link-reference))
  6942. (setq bang (match-string-no-properties 1)
  6943. begin (match-beginning 0)
  6944. end (match-end 0)
  6945. text (match-string-no-properties 3))
  6946. (when (char-equal (char-after (match-beginning 5)) ?\[)
  6947. (setq reference (match-string-no-properties 6))))
  6948. ;; Angle bracket URI at point.
  6949. ((thing-at-point-looking-at markdown-regex-angle-uri)
  6950. (setq begin (match-beginning 0)
  6951. end (match-end 0)
  6952. url (match-string-no-properties 2)))
  6953. ;; Plain URI at point.
  6954. ((thing-at-point-looking-at markdown-regex-uri)
  6955. (setq begin (match-beginning 0)
  6956. end (match-end 0)
  6957. url (match-string-no-properties 1))))
  6958. (list begin end text url reference title bang))))
  6959. (defun markdown-link-url ()
  6960. "Return the URL part of the regular (non-wiki) link at point.
  6961. Works with both inline and reference style links, and with images.
  6962. If point is not at a link or the link reference is not defined
  6963. returns nil."
  6964. (let* ((values (markdown-link-at-pos (point)))
  6965. (text (nth 2 values))
  6966. (url (nth 3 values))
  6967. (ref (nth 4 values)))
  6968. (or url (and ref (car (markdown-reference-definition
  6969. (downcase (if (string= ref "") text ref))))))))
  6970. (defun markdown--browse-url (url)
  6971. (let* ((struct (url-generic-parse-url url))
  6972. (full (url-fullness struct))
  6973. (file url))
  6974. ;; Parse URL, determine fullness, strip query string
  6975. (setq file (car (url-path-and-query struct)))
  6976. ;; Open full URLs in browser, files in Emacs
  6977. (if full
  6978. (browse-url url)
  6979. (when (and file (> (length file) 0))
  6980. (let ((link-file (funcall markdown-translate-filename-function file)))
  6981. (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file))
  6982. (if (functionp markdown-open-image-command)
  6983. (funcall markdown-open-image-command link-file)
  6984. (process-file markdown-open-image-command nil nil nil link-file))
  6985. (find-file link-file)))))))
  6986. (defun markdown-follow-link-at-point ()
  6987. "Open the current non-wiki link.
  6988. If the link is a complete URL, open in browser with `browse-url'.
  6989. Otherwise, open with `find-file' after stripping anchor and/or query string.
  6990. Translate filenames using `markdown-filename-translate-function'."
  6991. (interactive)
  6992. (if (markdown-link-p)
  6993. (markdown--browse-url (markdown-link-url))
  6994. (user-error "Point is not at a Markdown link or URL")))
  6995. (defun markdown-fontify-inline-links (last)
  6996. "Add text properties to next inline link from point to LAST."
  6997. (when (markdown-match-generic-links last nil)
  6998. (let* ((link-start (match-beginning 3))
  6999. (link-end (match-end 3))
  7000. (url-start (match-beginning 6))
  7001. (url-end (match-end 6))
  7002. (url (match-string-no-properties 6))
  7003. (title-start (match-beginning 7))
  7004. (title-end (match-end 7))
  7005. (title (match-string-no-properties 7))
  7006. ;; Markup part
  7007. (mp (list 'face 'markdown-markup-face
  7008. 'invisible 'markdown-markup
  7009. 'rear-nonsticky t
  7010. 'font-lock-multiline t))
  7011. ;; Link part (without face)
  7012. (lp (list 'keymap markdown-mode-mouse-map
  7013. 'mouse-face 'markdown-highlight-face
  7014. 'font-lock-multiline t
  7015. 'help-echo (if title (concat title "\n" url) url)))
  7016. ;; URL part
  7017. (up (list 'keymap markdown-mode-mouse-map
  7018. 'face 'markdown-url-face
  7019. 'invisible 'markdown-markup
  7020. 'mouse-face 'markdown-highlight-face
  7021. 'font-lock-multiline t))
  7022. ;; URL composition character
  7023. (url-char (markdown--first-displayable markdown-url-compose-char))
  7024. ;; Title part
  7025. (tp (list 'face 'markdown-link-title-face
  7026. 'invisible 'markdown-markup
  7027. 'font-lock-multiline t)))
  7028. (dolist (g '(1 2 4 5 8))
  7029. (when (match-end g)
  7030. (add-text-properties (match-beginning g) (match-end g) mp)))
  7031. ;; Preserve existing faces applied to link part (e.g., inline code)
  7032. (when link-start
  7033. (add-text-properties link-start link-end lp)
  7034. (add-face-text-property link-start link-end
  7035. 'markdown-link-face 'append))
  7036. (when url-start (add-text-properties url-start url-end up))
  7037. (when title-start (add-text-properties url-end title-end tp))
  7038. (when (and markdown-hide-urls url-start)
  7039. (compose-region url-start (or title-end url-end) url-char))
  7040. t)))
  7041. (defun markdown-fontify-reference-links (last)
  7042. "Add text properties to next reference link from point to LAST."
  7043. (when (markdown-match-generic-links last t)
  7044. (let* ((link-start (match-beginning 3))
  7045. (link-end (match-end 3))
  7046. (ref-start (match-beginning 6))
  7047. (ref-end (match-end 6))
  7048. ;; Markup part
  7049. (mp (list 'face 'markdown-markup-face
  7050. 'invisible 'markdown-markup
  7051. 'rear-nonsticky t
  7052. 'font-lock-multiline t))
  7053. ;; Link part
  7054. (lp (list 'keymap markdown-mode-mouse-map
  7055. 'face 'markdown-link-face
  7056. 'mouse-face 'markdown-highlight-face
  7057. 'font-lock-multiline t
  7058. 'help-echo (lambda (_ __ pos)
  7059. (save-match-data
  7060. (save-excursion
  7061. (goto-char pos)
  7062. (or (markdown-link-url)
  7063. "Undefined reference"))))))
  7064. ;; URL composition character
  7065. (url-char (markdown--first-displayable markdown-url-compose-char))
  7066. ;; Reference part
  7067. (rp (list 'face 'markdown-reference-face
  7068. 'invisible 'markdown-markup
  7069. 'font-lock-multiline t)))
  7070. (dolist (g '(1 2 4 5 8))
  7071. (when (match-end g)
  7072. (add-text-properties (match-beginning g) (match-end g) mp)))
  7073. (when link-start (add-text-properties link-start link-end lp))
  7074. (when ref-start (add-text-properties ref-start ref-end rp)
  7075. (when (and markdown-hide-urls (> (- ref-end ref-start) 2))
  7076. (compose-region ref-start ref-end url-char)))
  7077. t)))
  7078. (defun markdown-fontify-angle-uris (last)
  7079. "Add text properties to angle URIs from point to LAST."
  7080. (when (markdown-match-angle-uris last)
  7081. (let* ((url-start (match-beginning 2))
  7082. (url-end (match-end 2))
  7083. ;; Markup part
  7084. (mp (list 'face 'markdown-markup-face
  7085. 'invisible 'markdown-markup
  7086. 'rear-nonsticky t
  7087. 'font-lock-multiline t))
  7088. ;; URI part
  7089. (up (list 'keymap markdown-mode-mouse-map
  7090. 'face 'markdown-plain-url-face
  7091. 'mouse-face 'markdown-highlight-face
  7092. 'font-lock-multiline t)))
  7093. (dolist (g '(1 3))
  7094. (add-text-properties (match-beginning g) (match-end g) mp))
  7095. (add-text-properties url-start url-end up)
  7096. t)))
  7097. (defun markdown-fontify-plain-uris (last)
  7098. "Add text properties to plain URLs from point to LAST."
  7099. (when (markdown-match-plain-uris last)
  7100. (let* ((start (match-beginning 0))
  7101. (end (match-end 0))
  7102. (props (list 'keymap markdown-mode-mouse-map
  7103. 'face 'markdown-plain-url-face
  7104. 'mouse-face 'markdown-highlight-face
  7105. 'rear-nonsticky t
  7106. 'font-lock-multiline t)))
  7107. (add-text-properties start end props)
  7108. t)))
  7109. (defun markdown-toggle-url-hiding (&optional arg)
  7110. "Toggle the display or hiding of URLs.
  7111. With a prefix argument ARG, enable URL hiding if ARG is positive,
  7112. and disable it otherwise."
  7113. (interactive (list (or current-prefix-arg 'toggle)))
  7114. (setq markdown-hide-urls
  7115. (if (eq arg 'toggle)
  7116. (not markdown-hide-urls)
  7117. (> (prefix-numeric-value arg) 0)))
  7118. (if markdown-hide-urls
  7119. (message "markdown-mode URL hiding enabled")
  7120. (message "markdown-mode URL hiding disabled"))
  7121. (markdown-reload-extensions))
  7122. ;;; Wiki Links ================================================================
  7123. (defun markdown-wiki-link-p ()
  7124. "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
  7125. A true wiki link name matches `markdown-regex-wiki-link' but does
  7126. not match the current file name after conversion. This modifies
  7127. the data returned by `match-data'. Note that the potential wiki
  7128. link name must be available via `match-string'."
  7129. (when markdown-enable-wiki-links
  7130. (let ((case-fold-search nil))
  7131. (and (thing-at-point-looking-at markdown-regex-wiki-link)
  7132. (not (markdown-code-block-at-point-p))
  7133. (or (not buffer-file-name)
  7134. (not (string-equal (buffer-file-name)
  7135. (markdown-convert-wiki-link-to-filename
  7136. (markdown-wiki-link-link)))))))))
  7137. (defun markdown-wiki-link-link ()
  7138. "Return the link part of the wiki link using current match data.
  7139. The location of the link component depends on the value of
  7140. `markdown-wiki-link-alias-first'."
  7141. (if markdown-wiki-link-alias-first
  7142. (or (match-string-no-properties 5) (match-string-no-properties 3))
  7143. (match-string-no-properties 3)))
  7144. (defun markdown-wiki-link-alias ()
  7145. "Return the alias or text part of the wiki link using current match data.
  7146. The location of the alias component depends on the value of
  7147. `markdown-wiki-link-alias-first'."
  7148. (if markdown-wiki-link-alias-first
  7149. (match-string-no-properties 3)
  7150. (or (match-string-no-properties 5) (match-string-no-properties 3))))
  7151. (defun markdown-convert-wiki-link-to-filename (name)
  7152. "Generate a filename from the wiki link NAME.
  7153. Spaces in NAME are replaced with `markdown-link-space-sub-char'.
  7154. When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
  7155. and [[test test]] both map to Test-test.ext. Look in the current
  7156. directory first, then in subdirectories if
  7157. `markdown-wiki-link-search-subdirectories' is non-nil, and then
  7158. in parent directories if
  7159. `markdown-wiki-link-search-parent-directories' is non-nil."
  7160. (let* ((basename (replace-regexp-in-string
  7161. "[[:space:]\n]" markdown-link-space-sub-char name))
  7162. (basename (if (derived-mode-p 'gfm-mode)
  7163. (concat (upcase (substring basename 0 1))
  7164. (downcase (substring basename 1 nil)))
  7165. basename))
  7166. directory extension default candidates dir)
  7167. (when buffer-file-name
  7168. (setq directory (file-name-directory buffer-file-name)
  7169. extension (file-name-extension buffer-file-name)))
  7170. (setq default (concat basename
  7171. (when extension (concat "." extension))))
  7172. (cond
  7173. ;; Look in current directory first.
  7174. ((or (null buffer-file-name)
  7175. (file-exists-p default))
  7176. default)
  7177. ;; Possibly search in subdirectories, next.
  7178. ((and markdown-wiki-link-search-subdirectories
  7179. (setq candidates
  7180. (directory-files-recursively
  7181. directory (concat "^" default "$"))))
  7182. (car candidates))
  7183. ;; Possibly search in parent directories as a last resort.
  7184. ((and markdown-wiki-link-search-parent-directories
  7185. (setq dir (locate-dominating-file directory default)))
  7186. (concat dir default))
  7187. ;; If nothing is found, return default in current directory.
  7188. (t default))))
  7189. (defun markdown-follow-wiki-link (name &optional other)
  7190. "Follow the wiki link NAME.
  7191. Convert the name to a file name and call `find-file'. Ensure that
  7192. the new buffer remains in `markdown-mode'. Open the link in another
  7193. window when OTHER is non-nil."
  7194. (let ((filename (markdown-convert-wiki-link-to-filename name))
  7195. (wp (when buffer-file-name
  7196. (file-name-directory buffer-file-name))))
  7197. (if (not wp)
  7198. (user-error "Must be visiting a file")
  7199. (when other (other-window 1))
  7200. (let ((default-directory wp))
  7201. (find-file filename)))
  7202. (unless (derived-mode-p 'markdown-mode)
  7203. (markdown-mode))))
  7204. (defun markdown-follow-wiki-link-at-point (&optional arg)
  7205. "Find Wiki Link at point.
  7206. With prefix argument ARG, open the file in other window.
  7207. See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
  7208. (interactive "P")
  7209. (if (markdown-wiki-link-p)
  7210. (markdown-follow-wiki-link (markdown-wiki-link-link) arg)
  7211. (user-error "Point is not at a Wiki Link")))
  7212. (defun markdown-highlight-wiki-link (from to face)
  7213. "Highlight the wiki link in the region between FROM and TO using FACE."
  7214. (put-text-property from to 'font-lock-face face))
  7215. (defun markdown-unfontify-region-wiki-links (from to)
  7216. "Remove wiki link faces from the region specified by FROM and TO."
  7217. (interactive "*r")
  7218. (let ((modified (buffer-modified-p)))
  7219. (remove-text-properties from to '(font-lock-face markdown-link-face))
  7220. (remove-text-properties from to '(font-lock-face markdown-missing-link-face))
  7221. ;; remove-text-properties marks the buffer modified in emacs 24.3,
  7222. ;; undo that if it wasn't originally marked modified
  7223. (set-buffer-modified-p modified)))
  7224. (defun markdown-fontify-region-wiki-links (from to)
  7225. "Search region given by FROM and TO for wiki links and fontify them.
  7226. If a wiki link is found check to see if the backing file exists
  7227. and highlight accordingly."
  7228. (goto-char from)
  7229. (save-match-data
  7230. (while (re-search-forward markdown-regex-wiki-link to t)
  7231. (when (not (markdown-code-block-at-point-p))
  7232. (let ((highlight-beginning (match-beginning 1))
  7233. (highlight-end (match-end 1))
  7234. (file-name
  7235. (markdown-convert-wiki-link-to-filename
  7236. (markdown-wiki-link-link))))
  7237. (if (condition-case nil (file-exists-p file-name) (error nil))
  7238. (markdown-highlight-wiki-link
  7239. highlight-beginning highlight-end 'markdown-link-face)
  7240. (markdown-highlight-wiki-link
  7241. highlight-beginning highlight-end 'markdown-missing-link-face)))))))
  7242. (defun markdown-extend-changed-region (from to)
  7243. "Extend region given by FROM and TO so that we can fontify all links.
  7244. The region is extended to the first newline before and the first
  7245. newline after."
  7246. ;; start looking for the first new line before 'from
  7247. (goto-char from)
  7248. (re-search-backward "\n" nil t)
  7249. (let ((new-from (point-min))
  7250. (new-to (point-max)))
  7251. (if (not (= (point) from))
  7252. (setq new-from (point)))
  7253. ;; do the same thing for the first new line after 'to
  7254. (goto-char to)
  7255. (re-search-forward "\n" nil t)
  7256. (if (not (= (point) to))
  7257. (setq new-to (point)))
  7258. (cl-values new-from new-to)))
  7259. (defun markdown-check-change-for-wiki-link (from to)
  7260. "Check region between FROM and TO for wiki links and re-fontify as needed."
  7261. (interactive "*r")
  7262. (let* ((modified (buffer-modified-p))
  7263. (buffer-undo-list t)
  7264. (inhibit-read-only t)
  7265. (inhibit-point-motion-hooks t)
  7266. deactivate-mark
  7267. buffer-file-truename)
  7268. (unwind-protect
  7269. (save-excursion
  7270. (save-match-data
  7271. (save-restriction
  7272. ;; Extend the region to fontify so that it starts
  7273. ;; and ends at safe places.
  7274. (cl-multiple-value-bind (new-from new-to)
  7275. (markdown-extend-changed-region from to)
  7276. (goto-char new-from)
  7277. ;; Only refontify when the range contains text with a
  7278. ;; wiki link face or if the wiki link regexp matches.
  7279. (when (or (markdown-range-property-any
  7280. new-from new-to 'font-lock-face
  7281. '(markdown-link-face markdown-missing-link-face))
  7282. (re-search-forward
  7283. markdown-regex-wiki-link new-to t))
  7284. ;; Unfontify existing fontification (start from scratch)
  7285. (markdown-unfontify-region-wiki-links new-from new-to)
  7286. ;; Now do the fontification.
  7287. (markdown-fontify-region-wiki-links new-from new-to))))))
  7288. (and (not modified)
  7289. (buffer-modified-p)
  7290. (set-buffer-modified-p nil)))))
  7291. (defun markdown-check-change-for-wiki-link-after-change (from to _)
  7292. "Check region between FROM and TO for wiki links and re-fontify as needed.
  7293. Designed to be used with the `after-change-functions' hook."
  7294. (markdown-check-change-for-wiki-link from to))
  7295. (defun markdown-fontify-buffer-wiki-links ()
  7296. "Refontify all wiki links in the buffer."
  7297. (interactive)
  7298. (markdown-check-change-for-wiki-link (point-min) (point-max)))
  7299. (defun markdown-toggle-wiki-links (&optional arg)
  7300. "Toggle support for wiki links.
  7301. With a prefix argument ARG, enable wiki link support if ARG is positive,
  7302. and disable it otherwise."
  7303. (interactive (list (or current-prefix-arg 'toggle)))
  7304. (setq markdown-enable-wiki-links
  7305. (if (eq arg 'toggle)
  7306. (not markdown-enable-wiki-links)
  7307. (> (prefix-numeric-value arg) 0)))
  7308. (if markdown-enable-wiki-links
  7309. (message "markdown-mode wiki link support enabled")
  7310. (message "markdown-mode wiki link support disabled"))
  7311. (markdown-reload-extensions))
  7312. (defun markdown-setup-wiki-link-hooks ()
  7313. "Add or remove hooks for fontifying wiki links.
  7314. These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
  7315. ;; Anytime text changes make sure it gets fontified correctly
  7316. (if (and markdown-enable-wiki-links
  7317. markdown-wiki-link-fontify-missing)
  7318. (add-hook 'after-change-functions
  7319. 'markdown-check-change-for-wiki-link-after-change t t)
  7320. (remove-hook 'after-change-functions
  7321. 'markdown-check-change-for-wiki-link-after-change t))
  7322. ;; If we left the buffer there is a really good chance we were
  7323. ;; creating one of the wiki link documents. Make sure we get
  7324. ;; refontified when we come back.
  7325. (if (and markdown-enable-wiki-links
  7326. markdown-wiki-link-fontify-missing)
  7327. (progn
  7328. (add-hook 'window-configuration-change-hook
  7329. 'markdown-fontify-buffer-wiki-links t t)
  7330. (markdown-fontify-buffer-wiki-links))
  7331. (remove-hook 'window-configuration-change-hook
  7332. 'markdown-fontify-buffer-wiki-links t)
  7333. (markdown-unfontify-region-wiki-links (point-min) (point-max))))
  7334. ;;; Following & Doing =========================================================
  7335. (defun markdown-follow-thing-at-point (arg)
  7336. "Follow thing at point if possible, such as a reference link or wiki link.
  7337. Opens inline and reference links in a browser. Opens wiki links
  7338. to other files in the current window, or the another window if
  7339. ARG is non-nil.
  7340. See `markdown-follow-link-at-point' and
  7341. `markdown-follow-wiki-link-at-point'."
  7342. (interactive "P")
  7343. (cond ((markdown-link-p)
  7344. (markdown--browse-url (markdown-link-url)))
  7345. ((markdown-wiki-link-p)
  7346. (markdown-follow-wiki-link-at-point arg))
  7347. (t
  7348. (let* ((values (markdown-link-at-pos (point)))
  7349. (url (nth 3 values)))
  7350. (unless url
  7351. (user-error "Nothing to follow at point"))
  7352. (markdown--browse-url url)))))
  7353. (defun markdown-do ()
  7354. "Do something sensible based on context at point.
  7355. Jumps between reference links and definitions; between footnote
  7356. markers and footnote text."
  7357. (interactive)
  7358. (cond
  7359. ;; Footnote definition
  7360. ((markdown-footnote-text-positions)
  7361. (markdown-footnote-return))
  7362. ;; Footnote marker
  7363. ((markdown-footnote-marker-positions)
  7364. (markdown-footnote-goto-text))
  7365. ;; Reference link
  7366. ((thing-at-point-looking-at markdown-regex-link-reference)
  7367. (markdown-reference-goto-definition))
  7368. ;; Reference definition
  7369. ((thing-at-point-looking-at markdown-regex-reference-definition)
  7370. (markdown-reference-goto-link (match-string-no-properties 2)))
  7371. ;; GFM task list item
  7372. ((markdown-gfm-task-list-item-at-point)
  7373. (markdown-toggle-gfm-checkbox))
  7374. ;; Align table
  7375. ((markdown-table-at-point-p)
  7376. (call-interactively #'markdown-table-align))
  7377. ;; Otherwise
  7378. (t
  7379. (markdown-insert-gfm-checkbox))))
  7380. ;;; Miscellaneous =============================================================
  7381. (defun markdown-compress-whitespace-string (str)
  7382. "Compress whitespace in STR and return result.
  7383. Leading and trailing whitespace is removed. Sequences of multiple
  7384. spaces, tabs, and newlines are replaced with single spaces."
  7385. (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
  7386. (replace-regexp-in-string "[ \t\n]+" " " str)))
  7387. (defun markdown--substitute-command-keys (string)
  7388. "Like `substitute-command-keys' but, but prefers control characters.
  7389. First pass STRING to `substitute-command-keys' and then
  7390. substitute `C-i` for `TAB` and `C-m` for `RET`."
  7391. (replace-regexp-in-string
  7392. "\\<TAB\\>" "C-i"
  7393. (replace-regexp-in-string
  7394. "\\<RET\\>" "C-m" (substitute-command-keys string) t) t))
  7395. (defun markdown-line-number-at-pos (&optional pos)
  7396. "Return (narrowed) buffer line number at position POS.
  7397. If POS is nil, use current buffer location.
  7398. This is an exact copy of `line-number-at-pos' for use in emacs21."
  7399. (let ((opoint (or pos (point))) start)
  7400. (save-excursion
  7401. (goto-char (point-min))
  7402. (setq start (point))
  7403. (goto-char opoint)
  7404. (forward-line 0)
  7405. (1+ (count-lines start (point))))))
  7406. (defun markdown-inside-link-p ()
  7407. "Return t if point is within a link."
  7408. (save-match-data
  7409. (thing-at-point-looking-at (markdown-make-regex-link-generic))))
  7410. (defun markdown-line-is-reference-definition-p ()
  7411. "Return whether the current line is a (non-footnote) reference definition."
  7412. (save-excursion
  7413. (move-beginning-of-line 1)
  7414. (and (looking-at-p markdown-regex-reference-definition)
  7415. (not (looking-at-p "[ \t]*\\[^")))))
  7416. (defun markdown-adaptive-fill-function ()
  7417. "Return prefix for filling paragraph or nil if not determined."
  7418. (cond
  7419. ;; List item inside blockquote
  7420. ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
  7421. (replace-regexp-in-string
  7422. "[0-9\\.*+-]" " " (match-string-no-properties 0)))
  7423. ;; Blockquote
  7424. ((looking-at markdown-regex-blockquote)
  7425. (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
  7426. ;; List items
  7427. ((looking-at markdown-regex-list)
  7428. (match-string-no-properties 0))
  7429. ;; Footnote definition
  7430. ((looking-at-p markdown-regex-footnote-definition)
  7431. " ") ; four spaces
  7432. ;; No match
  7433. (t nil)))
  7434. (defun markdown-fill-paragraph (&optional justify)
  7435. "Fill paragraph at or after point.
  7436. This function is like \\[fill-paragraph], but it skips Markdown
  7437. code blocks. If the point is in a code block, or just before one,
  7438. do not fill. Otherwise, call `fill-paragraph' as usual. If
  7439. JUSTIFY is non-nil, justify text as well. Since this function
  7440. handles filling itself, it always returns t so that
  7441. `fill-paragraph' doesn't run."
  7442. (interactive "P")
  7443. (unless (or (markdown-code-block-at-point-p)
  7444. (save-excursion
  7445. (back-to-indentation)
  7446. (skip-syntax-forward "-")
  7447. (markdown-code-block-at-point-p)))
  7448. (let ((fill-prefix (save-excursion
  7449. (goto-char (line-beginning-position))
  7450. (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)")
  7451. (match-string-no-properties 1)))))
  7452. (fill-paragraph justify)))
  7453. t)
  7454. (defun markdown-fill-forward-paragraph (&optional arg)
  7455. "Function used by `fill-paragraph' to move over ARG paragraphs.
  7456. This is a `fill-forward-paragraph-function' for `markdown-mode'.
  7457. It is called with a single argument specifying the number of
  7458. paragraphs to move. Just like `forward-paragraph', it should
  7459. return the number of paragraphs left to move."
  7460. (or arg (setq arg 1))
  7461. (if (> arg 0)
  7462. ;; With positive ARG, move across ARG non-code-block paragraphs,
  7463. ;; one at a time. When passing a code block, don't decrement ARG.
  7464. (while (and (not (eobp))
  7465. (> arg 0)
  7466. (= (forward-paragraph 1) 0)
  7467. (or (markdown-code-block-at-pos (point-at-bol 0))
  7468. (setq arg (1- arg)))))
  7469. ;; Move backward by one paragraph with negative ARG (always -1).
  7470. (let ((start (point)))
  7471. (setq arg (forward-paragraph arg))
  7472. (while (and (not (eobp))
  7473. (progn (move-to-left-margin) (not (eobp)))
  7474. (looking-at-p paragraph-separate))
  7475. (forward-line 1))
  7476. (cond
  7477. ;; Move point past whitespace following list marker.
  7478. ((looking-at markdown-regex-list)
  7479. (goto-char (match-end 0)))
  7480. ;; Move point past whitespace following pipe at beginning of line
  7481. ;; to handle Pandoc line blocks.
  7482. ((looking-at "^|\\s-*")
  7483. (goto-char (match-end 0)))
  7484. ;; Return point if the paragraph passed was a code block.
  7485. ((markdown-code-block-at-pos (point-at-bol 2))
  7486. (goto-char start)))))
  7487. arg)
  7488. (defun markdown--inhibit-electric-quote ()
  7489. "Function added to `electric-quote-inhibit-functions'.
  7490. Return non-nil if the quote has been inserted inside a code block
  7491. or span."
  7492. (let ((pos (1- (point))))
  7493. (or (markdown-inline-code-at-pos pos)
  7494. (markdown-code-block-at-pos pos))))
  7495. ;;; Extension Framework =======================================================
  7496. (defun markdown-reload-extensions ()
  7497. "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
  7498. (interactive)
  7499. (when (derived-mode-p 'markdown-mode)
  7500. ;; Refontify buffer
  7501. (font-lock-flush)
  7502. ;; Add or remove hooks related to extensions
  7503. (markdown-setup-wiki-link-hooks)))
  7504. (defun markdown-handle-local-variables ()
  7505. "Run in `hack-local-variables-hook' to update font lock rules.
  7506. Checks to see if there is actually a markdown-mode file local variable
  7507. before regenerating font-lock rules for extensions."
  7508. (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist)
  7509. (assoc 'markdown-enable-math file-local-variables-alist))
  7510. (when (assoc 'markdown-enable-math file-local-variables-alist)
  7511. (markdown-toggle-math markdown-enable-math))
  7512. (markdown-reload-extensions)))
  7513. ;;; Math Support ==============================================================
  7514. (defconst markdown-mode-font-lock-keywords-math
  7515. (list
  7516. ;; Equation reference (eq:foo)
  7517. '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face)
  7518. (2 markdown-reference-face)
  7519. (3 markdown-markup-face)))
  7520. ;; Equation reference \eqref{foo}
  7521. '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face)
  7522. (2 markdown-reference-face)
  7523. (3 markdown-markup-face))))
  7524. "Font lock keywords to add and remove when toggling math support.")
  7525. (defun markdown-toggle-math (&optional arg)
  7526. "Toggle support for inline and display LaTeX math expressions.
  7527. With a prefix argument ARG, enable math mode if ARG is positive,
  7528. and disable it otherwise. If called from Lisp, enable the mode
  7529. if ARG is omitted or nil."
  7530. (interactive (list (or current-prefix-arg 'toggle)))
  7531. (setq markdown-enable-math
  7532. (if (eq arg 'toggle)
  7533. (not markdown-enable-math)
  7534. (> (prefix-numeric-value arg) 0)))
  7535. (if markdown-enable-math
  7536. (progn
  7537. (font-lock-add-keywords
  7538. 'markdown-mode markdown-mode-font-lock-keywords-math)
  7539. (message "markdown-mode math support enabled"))
  7540. (font-lock-remove-keywords
  7541. 'markdown-mode markdown-mode-font-lock-keywords-math)
  7542. (message "markdown-mode math support disabled"))
  7543. (markdown-reload-extensions))
  7544. ;;; GFM Checkboxes ============================================================
  7545. (define-button-type 'markdown-gfm-checkbox-button
  7546. 'follow-link t
  7547. 'face 'markdown-gfm-checkbox-face
  7548. 'mouse-face 'markdown-highlight-face
  7549. 'action #'markdown-toggle-gfm-checkbox-button)
  7550. (defun markdown-gfm-task-list-item-at-point (&optional bounds)
  7551. "Return non-nil if there is a GFM task list item at the point.
  7552. Optionally, the list item BOUNDS may be given if available, as
  7553. returned by `markdown-cur-list-item-bounds'. When a task list item
  7554. is found, the return value is the same value returned by
  7555. `markdown-cur-list-item-bounds'."
  7556. (unless bounds
  7557. (setq bounds (markdown-cur-list-item-bounds)))
  7558. (> (length (nth 5 bounds)) 0))
  7559. (defun markdown-insert-gfm-checkbox ()
  7560. "Add GFM checkbox at point.
  7561. Returns t if added.
  7562. Returns nil if non-applicable."
  7563. (interactive)
  7564. (let ((bounds (markdown-cur-list-item-bounds)))
  7565. (if bounds
  7566. (unless (cl-sixth bounds)
  7567. (let ((pos (+ (cl-first bounds) (cl-fourth bounds)))
  7568. (markup "[ ] "))
  7569. (if (< pos (point))
  7570. (save-excursion
  7571. (goto-char pos)
  7572. (insert markup))
  7573. (goto-char pos)
  7574. (insert markup))
  7575. (syntax-propertize (+ (cl-second bounds) 4))
  7576. t))
  7577. (unless (save-excursion
  7578. (back-to-indentation)
  7579. (or (markdown-list-item-at-point-p)
  7580. (markdown-heading-at-point)
  7581. (markdown-in-comment-p)
  7582. (markdown-code-block-at-point-p)))
  7583. (let ((pos (save-excursion
  7584. (back-to-indentation)
  7585. (point)))
  7586. (markup (concat (or (save-excursion
  7587. (beginning-of-line 0)
  7588. (cl-fifth (markdown-cur-list-item-bounds)))
  7589. markdown-unordered-list-item-prefix)
  7590. "[ ] ")))
  7591. (if (< pos (point))
  7592. (save-excursion
  7593. (goto-char pos)
  7594. (insert markup))
  7595. (goto-char pos)
  7596. (insert markup))
  7597. (syntax-propertize (point-at-eol))
  7598. t)))))
  7599. (defun markdown-toggle-gfm-checkbox ()
  7600. "Toggle GFM checkbox at point.
  7601. Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
  7602. Returns nil if there is no task list item at the point."
  7603. (interactive)
  7604. (save-match-data
  7605. (save-excursion
  7606. (let ((bounds (markdown-cur-list-item-bounds)))
  7607. (when bounds
  7608. ;; Move to beginning of task list item
  7609. (goto-char (cl-first bounds))
  7610. ;; Advance to column of first non-whitespace after marker
  7611. (forward-char (cl-fourth bounds))
  7612. (cond ((looking-at "\\[ \\]")
  7613. (replace-match
  7614. (if markdown-gfm-uppercase-checkbox "[X]" "[x]")
  7615. nil t)
  7616. (match-string-no-properties 0))
  7617. ((looking-at "\\[[xX]\\]")
  7618. (replace-match "[ ]" nil t)
  7619. (match-string-no-properties 0))))))))
  7620. (defun markdown-toggle-gfm-checkbox-button (button)
  7621. "Toggle GFM checkbox BUTTON on click."
  7622. (save-match-data
  7623. (save-excursion
  7624. (goto-char (button-start button))
  7625. (markdown-toggle-gfm-checkbox))))
  7626. (defun markdown-make-gfm-checkboxes-buttons (start end)
  7627. "Make GFM checkboxes buttons in region between START and END."
  7628. (save-excursion
  7629. (goto-char start)
  7630. (let ((case-fold-search t))
  7631. (save-excursion
  7632. (while (re-search-forward markdown-regex-gfm-checkbox end t)
  7633. (make-button (match-beginning 1) (match-end 1)
  7634. :type 'markdown-gfm-checkbox-button))))))
  7635. ;; Called when any modification is made to buffer text.
  7636. (defun markdown-gfm-checkbox-after-change-function (beg end _)
  7637. "Add to `after-change-functions' to setup GFM checkboxes as buttons.
  7638. BEG and END are the limits of scanned region."
  7639. (save-excursion
  7640. (save-match-data
  7641. ;; Rescan between start of line from `beg' and start of line after `end'.
  7642. (markdown-make-gfm-checkboxes-buttons
  7643. (progn (goto-char beg) (beginning-of-line) (point))
  7644. (progn (goto-char end) (forward-line 1) (point))))))
  7645. (defun markdown-remove-gfm-checkbox-overlays ()
  7646. "Remove all GFM checkbox overlays in buffer."
  7647. (save-excursion
  7648. (save-restriction
  7649. (widen)
  7650. (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face))))
  7651. ;;; Display inline image ======================================================
  7652. (defvar-local markdown-inline-image-overlays nil)
  7653. (defun markdown-remove-inline-images ()
  7654. "Remove inline image overlays from image links in the buffer.
  7655. This can be toggled with `markdown-toggle-inline-images'
  7656. or \\[markdown-toggle-inline-images]."
  7657. (interactive)
  7658. (mapc #'delete-overlay markdown-inline-image-overlays)
  7659. (setq markdown-inline-image-overlays nil))
  7660. (defcustom markdown-display-remote-images nil
  7661. "If non-nil, download and display remote images.
  7662. See also `markdown-inline-image-overlays'.
  7663. Only image URLs specified with a protocol listed in
  7664. `markdown-remote-image-protocols' are displayed."
  7665. :group 'markdown
  7666. :type 'boolean)
  7667. (defcustom markdown-remote-image-protocols '("https")
  7668. "List of protocols to use to download remote images.
  7669. See also `markdown-display-remote-images'."
  7670. :group 'markdown
  7671. :type '(repeat string))
  7672. (defvar markdown--remote-image-cache
  7673. (make-hash-table :test 'equal)
  7674. "A map from URLs to image paths.")
  7675. (defun markdown--get-remote-image (url)
  7676. "Retrieve the image path for a given URL."
  7677. (or (gethash url markdown--remote-image-cache)
  7678. (let ((dl-path (make-temp-file "markdown-mode--image")))
  7679. (require 'url)
  7680. (url-copy-file url dl-path t)
  7681. (puthash url dl-path markdown--remote-image-cache))))
  7682. (defun markdown-display-inline-images ()
  7683. "Add inline image overlays to image links in the buffer.
  7684. This can be toggled with `markdown-toggle-inline-images'
  7685. or \\[markdown-toggle-inline-images]."
  7686. (interactive)
  7687. (unless (display-images-p)
  7688. (error "Cannot show images"))
  7689. (save-excursion
  7690. (save-restriction
  7691. (widen)
  7692. (goto-char (point-min))
  7693. (while (re-search-forward markdown-regex-link-inline nil t)
  7694. (let* ((start (match-beginning 0))
  7695. (imagep (match-beginning 1))
  7696. (end (match-end 0))
  7697. (file (match-string-no-properties 6))
  7698. (unhex_file (url-unhex-string file)))
  7699. (when (and imagep
  7700. (not (zerop (length file))))
  7701. (unless (file-exists-p unhex_file)
  7702. (let* ((download-file (funcall markdown-translate-filename-function file))
  7703. (valid-url (ignore-errors
  7704. (member (downcase (url-type (url-generic-parse-url download-file)))
  7705. markdown-remote-image-protocols))))
  7706. (if (and markdown-display-remote-images valid-url)
  7707. (setq file (markdown--get-remote-image download-file))
  7708. (when (not valid-url)
  7709. ;; strip query parameter
  7710. (setq file (replace-regexp-in-string "?.+\\'" "" file))))))
  7711. (when (file-exists-p unhex_file)
  7712. (let* ((abspath (if (file-name-absolute-p unhex_file)
  7713. unhex_file
  7714. (concat default-directory unhex_file)))
  7715. (image
  7716. (cond ((and markdown-max-image-size
  7717. (image-type-available-p 'imagemagick))
  7718. (create-image
  7719. abspath 'imagemagick nil
  7720. :max-width (car markdown-max-image-size)
  7721. :max-height (cdr markdown-max-image-size)))
  7722. (markdown-max-image-size
  7723. (create-image abspath nil nil
  7724. :max-width (car markdown-max-image-size)
  7725. :max-height (cdr markdown-max-image-size)))
  7726. (t (create-image abspath)))))
  7727. (when image
  7728. (let ((ov (make-overlay start end)))
  7729. (overlay-put ov 'display image)
  7730. (overlay-put ov 'face 'default)
  7731. (push ov markdown-inline-image-overlays)))))))))))
  7732. (defun markdown-toggle-inline-images ()
  7733. "Toggle inline image overlays in the buffer."
  7734. (interactive)
  7735. (if markdown-inline-image-overlays
  7736. (markdown-remove-inline-images)
  7737. (markdown-display-inline-images)))
  7738. ;;; GFM Code Block Fontification ==============================================
  7739. (defcustom markdown-fontify-code-blocks-natively nil
  7740. "When non-nil, fontify code in code blocks using the native major mode.
  7741. This only works for fenced code blocks where the language is
  7742. specified where we can automatically determine the appropriate
  7743. mode to use. The language to mode mapping may be customized by
  7744. setting the variable `markdown-code-lang-modes'."
  7745. :group 'markdown
  7746. :type 'boolean
  7747. :safe 'booleanp
  7748. :package-version '(markdown-mode . "2.3"))
  7749. (defcustom markdown-fontify-code-block-default-mode nil
  7750. "Default mode to use to fontify code blocks.
  7751. This mode is used when automatic detection fails, such as for GFM
  7752. code blocks with no language specified."
  7753. :group 'markdown
  7754. :type '(choice function (const :tag "None" nil))
  7755. :package-version '(markdown-mode . "2.4"))
  7756. (defun markdown-toggle-fontify-code-blocks-natively (&optional arg)
  7757. "Toggle the native fontification of code blocks.
  7758. With a prefix argument ARG, enable if ARG is positive,
  7759. and disable otherwise."
  7760. (interactive (list (or current-prefix-arg 'toggle)))
  7761. (setq markdown-fontify-code-blocks-natively
  7762. (if (eq arg 'toggle)
  7763. (not markdown-fontify-code-blocks-natively)
  7764. (> (prefix-numeric-value arg) 0)))
  7765. (if markdown-fontify-code-blocks-natively
  7766. (message "markdown-mode native code block fontification enabled")
  7767. (message "markdown-mode native code block fontification disabled"))
  7768. (markdown-reload-extensions))
  7769. ;; This is based on `org-src-lang-modes' from org-src.el
  7770. (defcustom markdown-code-lang-modes
  7771. '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
  7772. ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
  7773. ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
  7774. ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
  7775. ("bash" . sh-mode))
  7776. "Alist mapping languages to their major mode.
  7777. The key is the language name, the value is the major mode. For
  7778. many languages this is simple, but for language where this is not
  7779. the case, this variable provides a way to simplify things on the
  7780. user side. For example, there is no ocaml-mode in Emacs, but the
  7781. mode to use is `tuareg-mode'."
  7782. :group 'markdown
  7783. :type '(repeat
  7784. (cons
  7785. (string "Language name")
  7786. (symbol "Major mode")))
  7787. :package-version '(markdown-mode . "2.3"))
  7788. (defun markdown-get-lang-mode (lang)
  7789. "Return major mode that should be used for LANG.
  7790. LANG is a string, and the returned major mode is a symbol."
  7791. (cl-find-if
  7792. 'fboundp
  7793. (list (cdr (assoc lang markdown-code-lang-modes))
  7794. (cdr (assoc (downcase lang) markdown-code-lang-modes))
  7795. (intern (concat lang "-mode"))
  7796. (intern (concat (downcase lang) "-mode")))))
  7797. (defun markdown-fontify-code-blocks-generic (matcher last)
  7798. "Add text properties to next code block from point to LAST.
  7799. Use matching function MATCHER."
  7800. (when (funcall matcher last)
  7801. (save-excursion
  7802. (save-match-data
  7803. (let* ((start (match-beginning 0))
  7804. (end (match-end 0))
  7805. ;; Find positions outside opening and closing backquotes.
  7806. (bol-prev (progn (goto-char start)
  7807. (if (bolp) (point-at-bol 0) (point-at-bol))))
  7808. (eol-next (progn (goto-char end)
  7809. (if (bolp) (point-at-bol 2) (point-at-bol 3))))
  7810. lang)
  7811. (if (and markdown-fontify-code-blocks-natively
  7812. (or (setq lang (markdown-code-block-lang))
  7813. markdown-fontify-code-block-default-mode))
  7814. (markdown-fontify-code-block-natively lang start end)
  7815. (add-text-properties start end '(face markdown-pre-face)))
  7816. ;; Set background for block as well as opening and closing lines.
  7817. (font-lock-append-text-property
  7818. bol-prev eol-next 'face 'markdown-code-face)
  7819. ;; Set invisible property for lines before and after, including newline.
  7820. (add-text-properties bol-prev start '(invisible markdown-markup))
  7821. (add-text-properties end eol-next '(invisible markdown-markup)))))
  7822. t))
  7823. (defun markdown-fontify-gfm-code-blocks (last)
  7824. "Add text properties to next GFM code block from point to LAST."
  7825. (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last))
  7826. (defun markdown-fontify-fenced-code-blocks (last)
  7827. "Add text properties to next tilde fenced code block from point to LAST."
  7828. (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last))
  7829. ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
  7830. (defun markdown-fontify-code-block-natively (lang start end)
  7831. "Fontify given GFM or fenced code block.
  7832. This function is called by Emacs for automatic fontification when
  7833. `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
  7834. language used in the block. START and END specify the block
  7835. position."
  7836. (let ((lang-mode (if lang (markdown-get-lang-mode lang)
  7837. markdown-fontify-code-block-default-mode)))
  7838. (when (fboundp lang-mode)
  7839. (let ((string (buffer-substring-no-properties start end))
  7840. (modified (buffer-modified-p))
  7841. (markdown-buffer (current-buffer)) pos next)
  7842. (remove-text-properties start end '(face nil))
  7843. (with-current-buffer
  7844. (get-buffer-create
  7845. (concat " markdown-code-fontification:" (symbol-name lang-mode)))
  7846. ;; Make sure that modification hooks are not inhibited in
  7847. ;; the org-src-fontification buffer in case we're called
  7848. ;; from `jit-lock-function' (Bug#25132).
  7849. (let ((inhibit-modification-hooks nil))
  7850. (delete-region (point-min) (point-max))
  7851. (insert string " ")) ;; so there's a final property change
  7852. (unless (eq major-mode lang-mode) (funcall lang-mode))
  7853. (font-lock-ensure)
  7854. (setq pos (point-min))
  7855. (while (setq next (next-single-property-change pos 'face))
  7856. (let ((val (get-text-property pos 'face)))
  7857. (when val
  7858. (put-text-property
  7859. (+ start (1- pos)) (1- (+ start next)) 'face
  7860. val markdown-buffer)))
  7861. (setq pos next)))
  7862. (add-text-properties
  7863. start end
  7864. '(font-lock-fontified t fontified t font-lock-multiline t))
  7865. (set-buffer-modified-p modified)))))
  7866. (require 'edit-indirect nil t)
  7867. (defvar edit-indirect-guess-mode-function)
  7868. (defvar edit-indirect-after-commit-functions)
  7869. (defun markdown--edit-indirect-after-commit-function (beg end)
  7870. "Corrective logic run on code block content from lines BEG to END.
  7871. Restores code block indentation from BEG to END, and ensures trailing newlines
  7872. at the END of code blocks."
  7873. ;; ensure trailing newlines
  7874. (goto-char end)
  7875. (unless (eq (char-before) ?\n)
  7876. (insert "\n"))
  7877. ;; restore code block indentation
  7878. (goto-char (- beg 1))
  7879. (let ((block-indentation (current-indentation)))
  7880. (when (> block-indentation 0)
  7881. (indent-rigidly beg end block-indentation))))
  7882. (defun markdown-edit-code-block ()
  7883. "Edit Markdown code block in an indirect buffer."
  7884. (interactive)
  7885. (save-excursion
  7886. (if (fboundp 'edit-indirect-region)
  7887. (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
  7888. (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2)))
  7889. (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1))))
  7890. (if (and begin end)
  7891. (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation)))
  7892. (lang (markdown-code-block-lang))
  7893. (mode (or (and lang (markdown-get-lang-mode lang))
  7894. markdown-edit-code-block-default-mode))
  7895. (edit-indirect-guess-mode-function
  7896. (lambda (_parent-buffer _beg _end)
  7897. (funcall mode)))
  7898. (indirect-buf (edit-indirect-region begin end 'display-buffer)))
  7899. (when (> indentation 0) ;; un-indent in edit-indirect buffer
  7900. (with-current-buffer indirect-buf
  7901. (indent-rigidly (point-min) (point-max) (- indentation)))))
  7902. (user-error "Not inside a GFM or tilde fenced code block")))
  7903. (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
  7904. (progn (package-refresh-contents)
  7905. (package-install 'edit-indirect)
  7906. (markdown-edit-code-block))))))
  7907. ;;; Table Editing =============================================================
  7908. ;; These functions were originally adapted from `org-table.el'.
  7909. ;; General helper functions
  7910. (defmacro markdown--with-gensyms (symbols &rest body)
  7911. (declare (debug (sexp body)) (indent 1))
  7912. `(let ,(mapcar (lambda (s)
  7913. `(,s (make-symbol (concat "--" (symbol-name ',s)))))
  7914. symbols)
  7915. ,@body))
  7916. (defun markdown--split-string (string &optional separators)
  7917. "Splits STRING into substrings at SEPARATORS.
  7918. SEPARATORS is a regular expression. If nil it defaults to
  7919. `split-string-default-separators'. This version returns no empty
  7920. strings if there are matches at the beginning and end of string."
  7921. (let ((start 0) notfirst list)
  7922. (while (and (string-match
  7923. (or separators split-string-default-separators)
  7924. string
  7925. (if (and notfirst
  7926. (= start (match-beginning 0))
  7927. (< start (length string)))
  7928. (1+ start) start))
  7929. (< (match-beginning 0) (length string)))
  7930. (setq notfirst t)
  7931. (or (eq (match-beginning 0) 0)
  7932. (and (eq (match-beginning 0) (match-end 0))
  7933. (eq (match-beginning 0) start))
  7934. (push (substring string start (match-beginning 0)) list))
  7935. (setq start (match-end 0)))
  7936. (or (eq start (length string))
  7937. (push (substring string start) list))
  7938. (nreverse list)))
  7939. (defun markdown--string-width (s)
  7940. "Return width of string S.
  7941. This version ignores characters with invisibility property
  7942. `markdown-markup'."
  7943. (let (b)
  7944. (when (or (eq t buffer-invisibility-spec)
  7945. (member 'markdown-markup buffer-invisibility-spec))
  7946. (while (setq b (text-property-any
  7947. 0 (length s)
  7948. 'invisible 'markdown-markup s))
  7949. (setq s (concat
  7950. (substring s 0 b)
  7951. (substring s (or (next-single-property-change
  7952. b 'invisible s)
  7953. (length s))))))))
  7954. (string-width s))
  7955. (defun markdown--remove-invisible-markup (s)
  7956. "Remove Markdown markup from string S.
  7957. This version removes characters with invisibility property
  7958. `markdown-markup'."
  7959. (let (b)
  7960. (while (setq b (text-property-any
  7961. 0 (length s)
  7962. 'invisible 'markdown-markup s))
  7963. (setq s (concat
  7964. (substring s 0 b)
  7965. (substring s (or (next-single-property-change
  7966. b 'invisible s)
  7967. (length s)))))))
  7968. s)
  7969. ;; Functions for maintaining tables
  7970. (defvar markdown-table-at-point-p-function nil
  7971. "Function to decide if point is inside a table.
  7972. The indirection serves to differentiate between standard markdown
  7973. tables and gfm tables which are less strict about the markup.")
  7974. (defconst markdown-table-line-regexp "^[ \t]*|"
  7975. "Regexp matching any line inside a table.")
  7976. (defconst markdown-table-hline-regexp "^[ \t]*|[-:]"
  7977. "Regexp matching hline inside a table.")
  7978. (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]"
  7979. "Regexp matching dline inside a table.")
  7980. (defun markdown-table-at-point-p ()
  7981. "Return non-nil when point is inside a table."
  7982. (if (functionp markdown-table-at-point-p-function)
  7983. (funcall markdown-table-at-point-p-function)
  7984. (markdown--table-at-point-p)))
  7985. (defun markdown--table-at-point-p ()
  7986. "Return non-nil when point is inside a table."
  7987. (save-excursion
  7988. (beginning-of-line)
  7989. (and (looking-at-p markdown-table-line-regexp)
  7990. (not (markdown-code-block-at-point-p)))))
  7991. (defconst gfm-table-line-regexp "^.?*|"
  7992. "Regexp matching any line inside a table.")
  7993. (defconst gfm-table-hline-regexp "^-+\\(|-\\)+"
  7994. "Regexp matching hline inside a table.")
  7995. ;; GFM simplified tables syntax is as follows:
  7996. ;; - A header line for the column names, this is any text
  7997. ;; separated by `|'.
  7998. ;; - Followed by a string -|-|- ..., the number of dashes is optional
  7999. ;; but must be higher than 1. The number of separators should match
  8000. ;; the number of columns.
  8001. ;; - Followed by the rows of data, which has the same format as the
  8002. ;; header line.
  8003. ;; Example:
  8004. ;;
  8005. ;; foo | bar
  8006. ;; ------|---------
  8007. ;; bar | baz
  8008. ;; bar | baz
  8009. (defun gfm--table-at-point-p ()
  8010. "Return non-nil when point is inside a gfm-compatible table."
  8011. (or (markdown--table-at-point-p)
  8012. (save-excursion
  8013. (beginning-of-line)
  8014. (when (looking-at-p gfm-table-line-regexp)
  8015. ;; we might be at the first line of the table, check if the
  8016. ;; line below is the hline
  8017. (or (save-excursion
  8018. (forward-line 1)
  8019. (looking-at-p gfm-table-hline-regexp))
  8020. ;; go up to find the header
  8021. (catch 'done
  8022. (while (looking-at-p gfm-table-line-regexp)
  8023. (cond
  8024. ((looking-at-p gfm-table-hline-regexp)
  8025. (throw 'done t))
  8026. ((bobp)
  8027. (throw 'done nil)))
  8028. (forward-line -1))
  8029. nil))))))
  8030. (defun markdown-table-hline-at-point-p ()
  8031. "Return non-nil when point is on a hline in a table.
  8032. This function assumes point is on a table."
  8033. (save-excursion
  8034. (beginning-of-line)
  8035. (looking-at-p markdown-table-hline-regexp)))
  8036. (defun markdown-table-begin ()
  8037. "Find the beginning of the table and return its position.
  8038. This function assumes point is on a table."
  8039. (save-excursion
  8040. (while (and (not (bobp))
  8041. (markdown-table-at-point-p))
  8042. (forward-line -1))
  8043. (unless (or (eobp)
  8044. (markdown-table-at-point-p))
  8045. (forward-line 1))
  8046. (point)))
  8047. (defun markdown-table-end ()
  8048. "Find the end of the table and return its position.
  8049. This function assumes point is on a table."
  8050. (save-excursion
  8051. (while (and (not (eobp))
  8052. (markdown-table-at-point-p))
  8053. (forward-line 1))
  8054. (point)))
  8055. (defun markdown-table-get-dline ()
  8056. "Return index of the table data line at point.
  8057. This function assumes point is on a table."
  8058. (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
  8059. (save-excursion
  8060. (goto-char (markdown-table-begin))
  8061. (while (and (re-search-forward
  8062. markdown-table-dline-regexp end t)
  8063. (setq cnt (1+ cnt))
  8064. (< (point-at-eol) pos))))
  8065. cnt))
  8066. (defun markdown--thing-at-wiki-link (pos)
  8067. (when markdown-enable-wiki-links
  8068. (save-excursion
  8069. (save-match-data
  8070. (goto-char pos)
  8071. (thing-at-point-looking-at markdown-regex-wiki-link)))))
  8072. (defun markdown-table-get-column ()
  8073. "Return table column at point.
  8074. This function assumes point is on a table."
  8075. (let ((pos (point)) (cnt 0))
  8076. (save-excursion
  8077. (beginning-of-line)
  8078. (while (search-forward "|" pos t)
  8079. (unless (markdown--thing-at-wiki-link (match-beginning 0))
  8080. (setq cnt (1+ cnt)))))
  8081. cnt))
  8082. (defun markdown-table-get-cell (&optional n)
  8083. "Return the content of the cell in column N of current row.
  8084. N defaults to column at point. This function assumes point is on
  8085. a table."
  8086. (and n (markdown-table-goto-column n))
  8087. (skip-chars-backward "^|\n") (backward-char 1)
  8088. (if (looking-at "|[^|\r\n]*")
  8089. (let* ((pos (match-beginning 0))
  8090. (val (buffer-substring (1+ pos) (match-end 0))))
  8091. (goto-char (min (point-at-eol) (+ 2 pos)))
  8092. ;; Trim whitespaces
  8093. (setq val (replace-regexp-in-string "\\`[ \t]+" "" val)
  8094. val (replace-regexp-in-string "[ \t]+\\'" "" val)))
  8095. (forward-char 1) ""))
  8096. (defun markdown-table-goto-dline (n)
  8097. "Go to the Nth data line in the table at point.
  8098. Return t when the line exists, nil otherwise. This function
  8099. assumes point is on a table."
  8100. (goto-char (markdown-table-begin))
  8101. (let ((end (markdown-table-end)) (cnt 0))
  8102. (while (and (re-search-forward
  8103. markdown-table-dline-regexp end t)
  8104. (< (setq cnt (1+ cnt)) n)))
  8105. (= cnt n)))
  8106. (defun markdown-table-goto-column (n &optional on-delim)
  8107. "Go to the Nth column in the table line at point.
  8108. With optional argument ON-DELIM, stop with point before the left
  8109. delimiter of the cell. If there are less than N cells, just go
  8110. beyond the last delimiter. This function assumes point is on a
  8111. table."
  8112. (beginning-of-line 1)
  8113. (when (> n 0)
  8114. (while (and (> n 0) (search-forward "|" (point-at-eol) t))
  8115. (unless (markdown--thing-at-wiki-link (match-beginning 0))
  8116. (cl-decf n)))
  8117. (if on-delim
  8118. (backward-char 1)
  8119. (when (looking-at " ") (forward-char 1)))))
  8120. (defmacro markdown-table-save-cell (&rest body)
  8121. "Save cell at point, execute BODY and restore cell.
  8122. This function assumes point is on a table."
  8123. (declare (debug (body)))
  8124. (markdown--with-gensyms (line column)
  8125. `(let ((,line (copy-marker (line-beginning-position)))
  8126. (,column (markdown-table-get-column)))
  8127. (unwind-protect
  8128. (progn ,@body)
  8129. (goto-char ,line)
  8130. (markdown-table-goto-column ,column)
  8131. (set-marker ,line nil)))))
  8132. (defun markdown-table-blank-line (s)
  8133. "Convert a table line S into a line with blank cells."
  8134. (if (string-match "^[ \t]*|-" s)
  8135. (setq s (mapconcat
  8136. (lambda (x) (if (member x '(?| ?+)) "|" " "))
  8137. s ""))
  8138. (with-temp-buffer
  8139. (insert s)
  8140. (goto-char (point-min))
  8141. (when (re-search-forward "|" nil t)
  8142. (let ((cur (point))
  8143. ret)
  8144. (while (re-search-forward "|" nil t)
  8145. (when (and (not (eql (char-before (match-beginning 0)) ?\\))
  8146. (not (markdown--thing-at-wiki-link (match-beginning 0))))
  8147. (push (make-string (- (match-beginning 0) cur) ? ) ret)
  8148. (setq cur (match-end 0))))
  8149. (format "|%s|" (string-join (nreverse ret) "|")))))))
  8150. (defun markdown-table-colfmt (fmtspec)
  8151. "Process column alignment specifier FMTSPEC for tables."
  8152. (when (stringp fmtspec)
  8153. (mapcar (lambda (x)
  8154. (cond ((string-match-p "^:.*:$" x) 'c)
  8155. ((string-match-p "^:" x) 'l)
  8156. ((string-match-p ":$" x) 'r)
  8157. (t 'd)))
  8158. (markdown--split-string fmtspec "\\s-*|\\s-*"))))
  8159. (defun markdown--first-column-p (bar-pos)
  8160. (save-excursion
  8161. (save-match-data
  8162. (goto-char bar-pos)
  8163. (looking-back "^\\s-*" (line-beginning-position)))))
  8164. (defun markdown--table-line-to-columns (line)
  8165. (with-temp-buffer
  8166. (insert line)
  8167. (goto-char (point-min))
  8168. (let ((cur (point))
  8169. ret)
  8170. (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)
  8171. (if (markdown--first-column-p (match-beginning 1))
  8172. (setq cur (match-end 0))
  8173. (cond ((eql (char-before (match-beginning 1)) ?\\)
  8174. ;; keep spaces
  8175. (goto-char (match-end 1)))
  8176. ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing
  8177. (t
  8178. (push (buffer-substring-no-properties cur (match-beginning 0)) ret)
  8179. (setq cur (match-end 0))))))
  8180. (when (< cur (length line))
  8181. (push (buffer-substring-no-properties cur (point-max)) ret))
  8182. (nreverse ret))))
  8183. (defun markdown-table-align ()
  8184. "Align table at point.
  8185. This function assumes point is on a table."
  8186. (interactive)
  8187. (let ((begin (markdown-table-begin))
  8188. (end (copy-marker (markdown-table-end))))
  8189. (markdown-table-save-cell
  8190. (goto-char begin)
  8191. (let* (fmtspec
  8192. ;; Store table indent
  8193. (indent (progn (looking-at "[ \t]*") (match-string 0)))
  8194. ;; Split table in lines and save column format specifier
  8195. (lines (mapcar (lambda (l)
  8196. (if (string-match-p "\\`[ \t]*|[-:]" l)
  8197. (progn (setq fmtspec (or fmtspec l)) nil) l))
  8198. (markdown--split-string (buffer-substring begin end) "\n")))
  8199. ;; Split lines in cells
  8200. (cells (mapcar (lambda (l) (markdown--table-line-to-columns l))
  8201. (remq nil lines)))
  8202. ;; Calculate maximum number of cells in a line
  8203. (maxcells (if cells
  8204. (apply #'max (mapcar #'length cells))
  8205. (user-error "Empty table")))
  8206. ;; Empty cells to fill short lines
  8207. (emptycells (make-list maxcells ""))
  8208. maxwidths)
  8209. ;; Calculate maximum width for each column
  8210. (dotimes (i maxcells)
  8211. (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells)))
  8212. (push (apply #'max 1 (mapcar #'markdown--string-width column))
  8213. maxwidths)))
  8214. (setq maxwidths (nreverse maxwidths))
  8215. ;; Process column format specifier
  8216. (setq fmtspec (markdown-table-colfmt fmtspec))
  8217. ;; Compute formats needed for output of table lines
  8218. (let ((hfmt (concat indent "|"))
  8219. (rfmt (concat indent "|"))
  8220. hfmt1 rfmt1 fmt)
  8221. (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|")))
  8222. (setq fmt (pop fmtspec))
  8223. (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |"))
  8224. ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |"))
  8225. ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |"))
  8226. (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |")))
  8227. (setq rfmt (concat rfmt (format rfmt1 width)))
  8228. (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-)))))
  8229. ;; Replace modified lines only
  8230. (dolist (line lines)
  8231. (let ((line (if line
  8232. (apply #'format rfmt (append (pop cells) emptycells))
  8233. hfmt))
  8234. (previous (buffer-substring (point) (line-end-position))))
  8235. (if (equal previous line)
  8236. (forward-line)
  8237. (insert line "\n")
  8238. (delete-region (point) (line-beginning-position 2))))))
  8239. (set-marker end nil)))))
  8240. (defun markdown-table-insert-row (&optional arg)
  8241. "Insert a new row above the row at point into the table.
  8242. With optional argument ARG, insert below the current row."
  8243. (interactive "P")
  8244. (unless (markdown-table-at-point-p)
  8245. (user-error "Not at a table"))
  8246. (let* ((line (buffer-substring
  8247. (line-beginning-position) (line-end-position)))
  8248. (new (markdown-table-blank-line line)))
  8249. (beginning-of-line (if arg 2 1))
  8250. (unless (bolp) (insert "\n"))
  8251. (insert-before-markers new "\n")
  8252. (beginning-of-line 0)
  8253. (re-search-forward "| ?" (line-end-position) t)))
  8254. (defun markdown-table-delete-row ()
  8255. "Delete row or horizontal line at point from the table."
  8256. (interactive)
  8257. (unless (markdown-table-at-point-p)
  8258. (user-error "Not at a table"))
  8259. (let ((col (current-column)))
  8260. (kill-region (point-at-bol)
  8261. (min (1+ (point-at-eol)) (point-max)))
  8262. (unless (markdown-table-at-point-p) (beginning-of-line 0))
  8263. (move-to-column col)))
  8264. (defun markdown-table-move-row (&optional up)
  8265. "Move table line at point down.
  8266. With optional argument UP, move it up."
  8267. (interactive "P")
  8268. (unless (markdown-table-at-point-p)
  8269. (user-error "Not at a table"))
  8270. (let* ((col (current-column)) (pos (point))
  8271. (tonew (if up 0 2)) txt)
  8272. (beginning-of-line tonew)
  8273. (unless (markdown-table-at-point-p)
  8274. (goto-char pos) (user-error "Cannot move row further"))
  8275. (goto-char pos) (beginning-of-line 1) (setq pos (point))
  8276. (setq txt (buffer-substring (point) (1+ (point-at-eol))))
  8277. (delete-region (point) (1+ (point-at-eol)))
  8278. (beginning-of-line tonew)
  8279. (insert txt) (beginning-of-line 0)
  8280. (move-to-column col)))
  8281. (defun markdown-table-move-row-up ()
  8282. "Move table row at point up."
  8283. (interactive)
  8284. (markdown-table-move-row 'up))
  8285. (defun markdown-table-move-row-down ()
  8286. "Move table row at point down."
  8287. (interactive)
  8288. (markdown-table-move-row nil))
  8289. (defun markdown-table-insert-column ()
  8290. "Insert a new table column."
  8291. (interactive)
  8292. (unless (markdown-table-at-point-p)
  8293. (user-error "Not at a table"))
  8294. (let* ((col (max 1 (markdown-table-get-column)))
  8295. (begin (markdown-table-begin))
  8296. (end (copy-marker (markdown-table-end))))
  8297. (markdown-table-save-cell
  8298. (goto-char begin)
  8299. (while (< (point) end)
  8300. (markdown-table-goto-column col t)
  8301. (if (markdown-table-hline-at-point-p)
  8302. (insert "|---")
  8303. (insert "| "))
  8304. (forward-line)))
  8305. (set-marker end nil)
  8306. (markdown-table-align)))
  8307. (defun markdown-table-delete-column ()
  8308. "Delete column at point from table."
  8309. (interactive)
  8310. (unless (markdown-table-at-point-p)
  8311. (user-error "Not at a table"))
  8312. (let ((col (markdown-table-get-column))
  8313. (begin (markdown-table-begin))
  8314. (end (copy-marker (markdown-table-end))))
  8315. (markdown-table-save-cell
  8316. (goto-char begin)
  8317. (while (< (point) end)
  8318. (markdown-table-goto-column col t)
  8319. (and (looking-at "|[^|\n]+|")
  8320. (replace-match "|"))
  8321. (forward-line)))
  8322. (set-marker end nil)
  8323. (markdown-table-goto-column (max 1 (1- col)))
  8324. (markdown-table-align)))
  8325. (defun markdown-table-move-column (&optional left)
  8326. "Move table column at point to the right.
  8327. With optional argument LEFT, move it to the left."
  8328. (interactive "P")
  8329. (unless (markdown-table-at-point-p)
  8330. (user-error "Not at a table"))
  8331. (let* ((col (markdown-table-get-column))
  8332. (col1 (if left (1- col) col))
  8333. (colpos (if left (1- col) (1+ col)))
  8334. (begin (markdown-table-begin))
  8335. (end (copy-marker (markdown-table-end))))
  8336. (when (and left (= col 1))
  8337. (user-error "Cannot move column further left"))
  8338. (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
  8339. (user-error "Cannot move column further right"))
  8340. (markdown-table-save-cell
  8341. (goto-char begin)
  8342. (while (< (point) end)
  8343. (markdown-table-goto-column col1 t)
  8344. (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
  8345. (replace-match "|\\2|\\1|"))
  8346. (forward-line)))
  8347. (set-marker end nil)
  8348. (markdown-table-goto-column colpos)
  8349. (markdown-table-align)))
  8350. (defun markdown-table-move-column-left ()
  8351. "Move table column at point to the left."
  8352. (interactive)
  8353. (markdown-table-move-column 'left))
  8354. (defun markdown-table-move-column-right ()
  8355. "Move table column at point to the right."
  8356. (interactive)
  8357. (markdown-table-move-column nil))
  8358. (defun markdown-table-next-row ()
  8359. "Go to the next row (same column) in the table.
  8360. Create new table lines if required."
  8361. (interactive)
  8362. (unless (markdown-table-at-point-p)
  8363. (user-error "Not at a table"))
  8364. (if (or (looking-at "[ \t]*$")
  8365. (save-excursion (skip-chars-backward " \t") (bolp)))
  8366. (newline)
  8367. (markdown-table-align)
  8368. (let ((col (markdown-table-get-column)))
  8369. (beginning-of-line 2)
  8370. (if (or (not (markdown-table-at-point-p))
  8371. (markdown-table-hline-at-point-p))
  8372. (progn
  8373. (beginning-of-line 0)
  8374. (markdown-table-insert-row 'below)))
  8375. (markdown-table-goto-column col)
  8376. (skip-chars-backward "^|\n\r")
  8377. (when (looking-at " ") (forward-char 1)))))
  8378. (defun markdown-table-forward-cell ()
  8379. "Go to the next cell in the table.
  8380. Create new table lines if required."
  8381. (interactive)
  8382. (unless (markdown-table-at-point-p)
  8383. (user-error "Not at a table"))
  8384. (markdown-table-align)
  8385. (let ((end (markdown-table-end)))
  8386. (when (markdown-table-hline-at-point-p) (end-of-line 1))
  8387. (condition-case nil
  8388. (progn
  8389. (re-search-forward "\\(?:^\\|[^\\]\\)|" end)
  8390. (when (looking-at "[ \t]*$")
  8391. (re-search-forward "\\(?:^\\|[^\\]:\\)|" end))
  8392. (when (and (looking-at "[-:]")
  8393. (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t))
  8394. (goto-char (match-beginning 1)))
  8395. (if (looking-at "[-:]")
  8396. (progn
  8397. (beginning-of-line 0)
  8398. (markdown-table-insert-row 'below))
  8399. (when (looking-at " ") (forward-char 1))))
  8400. (error (markdown-table-insert-row 'below)))))
  8401. (defun markdown-table-backward-cell ()
  8402. "Go to the previous cell in the table."
  8403. (interactive)
  8404. (unless (markdown-table-at-point-p)
  8405. (user-error "Not at a table"))
  8406. (markdown-table-align)
  8407. (when (markdown-table-hline-at-point-p) (end-of-line 1))
  8408. (condition-case nil
  8409. (progn
  8410. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))
  8411. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
  8412. (error (user-error "Cannot move to previous table cell")))
  8413. (while (looking-at "|\\([-:]\\|[ \t]*$\\)")
  8414. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
  8415. (when (looking-at "| ?") (goto-char (match-end 0))))
  8416. (defun markdown-table-transpose ()
  8417. "Transpose table at point.
  8418. Horizontal separator lines will be eliminated."
  8419. (interactive)
  8420. (unless (markdown-table-at-point-p)
  8421. (user-error "Not at a table"))
  8422. (let* ((table (buffer-substring-no-properties
  8423. (markdown-table-begin) (markdown-table-end)))
  8424. ;; Convert table to Lisp structure
  8425. (table (delq nil
  8426. (mapcar
  8427. (lambda (x)
  8428. (unless (string-match-p
  8429. markdown-table-hline-regexp x)
  8430. (markdown--table-line-to-columns x)))
  8431. (markdown--split-string table "[ \t]*\n[ \t]*"))))
  8432. (dline_old (markdown-table-get-dline))
  8433. (col_old (markdown-table-get-column))
  8434. (contents (mapcar (lambda (_)
  8435. (let ((tp table))
  8436. (mapcar
  8437. (lambda (_)
  8438. (prog1
  8439. (pop (car tp))
  8440. (setq tp (cdr tp))))
  8441. table)))
  8442. (car table))))
  8443. (goto-char (markdown-table-begin))
  8444. (save-excursion
  8445. (re-search-forward "|") (backward-char)
  8446. (delete-region (point) (markdown-table-end))
  8447. (insert (mapconcat
  8448. (lambda(x)
  8449. (concat "| " (mapconcat 'identity x " | " ) " |\n"))
  8450. contents "")))
  8451. (markdown-table-goto-dline col_old)
  8452. (markdown-table-goto-column dline_old))
  8453. (markdown-table-align))
  8454. (defun markdown-table-sort-lines (&optional sorting-type)
  8455. "Sort table lines according to the column at point.
  8456. The position of point indicates the column to be used for
  8457. sorting, and the range of lines is the range between the nearest
  8458. horizontal separator lines, or the entire table of no such lines
  8459. exist. If point is before the first column, user will be prompted
  8460. for the sorting column. If there is an active region, the mark
  8461. specifies the first line and the sorting column, while point
  8462. should be in the last line to be included into the sorting.
  8463. The command then prompts for the sorting type which can be
  8464. alphabetically or numerically. Sorting in reverse order is also
  8465. possible.
  8466. If SORTING-TYPE is specified when this function is called from a
  8467. Lisp program, no prompting will take place. SORTING-TYPE must be
  8468. a character, any of (?a ?A ?n ?N) where the capital letters
  8469. indicate that sorting should be done in reverse order."
  8470. (interactive)
  8471. (unless (markdown-table-at-point-p)
  8472. (user-error "Not at a table"))
  8473. ;; Set sorting type and column used for sorting
  8474. (let ((column (let ((c (markdown-table-get-column)))
  8475. (cond ((> c 0) c)
  8476. ((called-interactively-p 'any)
  8477. (read-number "Use column N for sorting: "))
  8478. (t 1))))
  8479. (sorting-type
  8480. (or sorting-type
  8481. (read-char-exclusive
  8482. "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))
  8483. (save-restriction
  8484. ;; Narrow buffer to appropriate sorting area
  8485. (if (region-active-p)
  8486. (narrow-to-region
  8487. (save-excursion
  8488. (progn
  8489. (goto-char (region-beginning)) (line-beginning-position)))
  8490. (save-excursion
  8491. (progn
  8492. (goto-char (region-end)) (line-end-position))))
  8493. (let ((start (markdown-table-begin))
  8494. (end (markdown-table-end)))
  8495. (narrow-to-region
  8496. (save-excursion
  8497. (if (re-search-backward
  8498. markdown-table-hline-regexp start t)
  8499. (line-beginning-position 2)
  8500. start))
  8501. (if (save-excursion (re-search-forward
  8502. markdown-table-hline-regexp end t))
  8503. (match-beginning 0)
  8504. end))))
  8505. ;; Determine arguments for `sort-subr'
  8506. (let* ((extract-key-from-cell
  8507. (cl-case sorting-type
  8508. ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity)
  8509. ((?n ?N) #'string-to-number)
  8510. (t (user-error "Invalid sorting type: %c" sorting-type))))
  8511. (predicate
  8512. (cl-case sorting-type
  8513. ((?n ?N) #'<)
  8514. ((?a ?A) #'string<))))
  8515. ;; Sort selected area
  8516. (goto-char (point-min))
  8517. (sort-subr (memq sorting-type '(?A ?N))
  8518. (lambda ()
  8519. (forward-line)
  8520. (while (and (not (eobp))
  8521. (not (looking-at
  8522. markdown-table-dline-regexp)))
  8523. (forward-line)))
  8524. #'end-of-line
  8525. (lambda ()
  8526. (funcall extract-key-from-cell
  8527. (markdown-table-get-cell column)))
  8528. nil
  8529. predicate)
  8530. (goto-char (point-min))))))
  8531. (defun markdown-table-convert-region (begin end &optional separator)
  8532. "Convert region from BEGIN to END to table with SEPARATOR.
  8533. If every line contains at least one TAB character, the function
  8534. assumes that the material is tab separated (TSV). If every line
  8535. contains a comma, comma-separated values (CSV) are assumed. If
  8536. not, lines are split at whitespace into cells.
  8537. You can use a prefix argument to force a specific separator:
  8538. \\[universal-argument] once forces CSV, \\[universal-argument]
  8539. twice forces TAB, and \\[universal-argument] three times will
  8540. prompt for a regular expression to match the separator, and a
  8541. numeric argument N indicates that at least N consecutive
  8542. spaces, or alternatively a TAB should be used as the separator."
  8543. (interactive "r\nP")
  8544. (let* ((begin (min begin end)) (end (max begin end)) re)
  8545. (goto-char begin) (beginning-of-line 1)
  8546. (setq begin (point-marker))
  8547. (goto-char end)
  8548. (if (bolp) (backward-char 1) (end-of-line 1))
  8549. (setq end (point-marker))
  8550. (when (equal separator '(64))
  8551. (setq separator (read-regexp "Regexp for cell separator: ")))
  8552. (unless separator
  8553. ;; Get the right cell separator
  8554. (goto-char begin)
  8555. (setq separator
  8556. (cond
  8557. ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
  8558. ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
  8559. (t 1))))
  8560. (goto-char begin)
  8561. (if (equal separator '(4))
  8562. ;; Parse CSV
  8563. (while (< (point) end)
  8564. (cond
  8565. ((looking-at "^") (insert "| "))
  8566. ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
  8567. ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
  8568. (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
  8569. ((looking-at "[^,\n]+") (goto-char (match-end 0)))
  8570. ((looking-at "[ \t]*,") (replace-match " | "))
  8571. (t (beginning-of-line 2))))
  8572. (setq re
  8573. (cond
  8574. ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
  8575. ((equal separator '(16)) "^\\|\t")
  8576. ((integerp separator)
  8577. (if (< separator 1)
  8578. (user-error "Cell separator must contain one or more spaces")
  8579. (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
  8580. ((stringp separator) (format "^ *\\|%s" separator))
  8581. (t (error "Invalid cell separator"))))
  8582. (while (re-search-forward re end t) (replace-match "| " t t)))
  8583. (goto-char begin)
  8584. (markdown-table-align)))
  8585. (defun markdown-insert-table (&optional rows columns align)
  8586. "Insert an empty pipe table.
  8587. Optional arguments ROWS, COLUMNS, and ALIGN specify number of
  8588. rows and columns and the column alignment."
  8589. (interactive)
  8590. (let* ((rows (or rows (string-to-number (read-string "Row size: "))))
  8591. (columns (or columns (string-to-number (read-string "Column size: "))))
  8592. (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): ")))
  8593. (align (cond ((equal align "l") ":--")
  8594. ((equal align "r") "--:")
  8595. ((equal align "c") ":-:")
  8596. (t "---")))
  8597. (pos (point))
  8598. (indent (make-string (current-column) ?\ ))
  8599. (line (concat
  8600. (apply 'concat indent "|"
  8601. (make-list columns " |")) "\n"))
  8602. (hline (apply 'concat indent "|"
  8603. (make-list columns (concat align "|")))))
  8604. (if (string-match
  8605. "^[ \t]*$" (buffer-substring-no-properties
  8606. (point-at-bol) (point)))
  8607. (beginning-of-line 1)
  8608. (newline))
  8609. (dotimes (_ rows) (insert line))
  8610. (goto-char pos)
  8611. (if (> rows 1)
  8612. (progn
  8613. (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos)))
  8614. (markdown-table-forward-cell)))
  8615. ;;; ElDoc Support =============================================================
  8616. (defun markdown-eldoc-function ()
  8617. "Return a helpful string when appropriate based on context.
  8618. * Report URL when point is at a hidden URL.
  8619. * Report language name when point is a code block with hidden markup."
  8620. (cond
  8621. ;; Hidden URL or reference for inline link
  8622. ((and (or (thing-at-point-looking-at markdown-regex-link-inline)
  8623. (thing-at-point-looking-at markdown-regex-link-reference))
  8624. (or markdown-hide-urls markdown-hide-markup))
  8625. (let* ((imagep (string-equal (match-string 1) "!"))
  8626. (edit-keys (markdown--substitute-command-keys
  8627. (if imagep
  8628. "\\[markdown-insert-image]"
  8629. "\\[markdown-insert-link]")))
  8630. (edit-str (propertize edit-keys 'face 'font-lock-constant-face))
  8631. (referencep (string-equal (match-string 5) "["))
  8632. (object (if referencep "reference" "URL")))
  8633. (format "Hidden %s (%s to edit): %s" object edit-str
  8634. (if referencep
  8635. (concat
  8636. (propertize "[" 'face 'markdown-markup-face)
  8637. (propertize (match-string-no-properties 6)
  8638. 'face 'markdown-reference-face)
  8639. (propertize "]" 'face 'markdown-markup-face))
  8640. (propertize (match-string-no-properties 6)
  8641. 'face 'markdown-url-face)))))
  8642. ;; Hidden language name for fenced code blocks
  8643. ((and (markdown-code-block-at-point-p)
  8644. (not (get-text-property (point) 'markdown-pre))
  8645. markdown-hide-markup)
  8646. (let ((lang (save-excursion (markdown-code-block-lang))))
  8647. (unless lang (setq lang "[unspecified]"))
  8648. (format "Hidden code block language: %s (%s to toggle markup)"
  8649. (propertize lang 'face 'markdown-language-keyword-face)
  8650. (markdown--substitute-command-keys
  8651. "\\[markdown-toggle-markup-hiding]"))))))
  8652. ;;; Mode Definition ==========================================================
  8653. (defun markdown-show-version ()
  8654. "Show the version number in the minibuffer."
  8655. (interactive)
  8656. (message "markdown-mode, version %s" markdown-mode-version))
  8657. (defun markdown-mode-info ()
  8658. "Open the `markdown-mode' homepage."
  8659. (interactive)
  8660. (browse-url "https://jblevins.org/projects/markdown-mode/"))
  8661. ;;;###autoload
  8662. (define-derived-mode markdown-mode text-mode "Markdown"
  8663. "Major mode for editing Markdown files."
  8664. ;; Natural Markdown tab width
  8665. (setq tab-width 4)
  8666. ;; Comments
  8667. (setq-local comment-start "<!-- ")
  8668. (setq-local comment-end " -->")
  8669. (setq-local comment-start-skip "<!--[ \t]*")
  8670. (setq-local comment-column 0)
  8671. (setq-local comment-auto-fill-only-comments nil)
  8672. (setq-local comment-use-syntax t)
  8673. ;; Sentence
  8674. (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*")
  8675. ;; Syntax
  8676. (add-hook 'syntax-propertize-extend-region-functions
  8677. #'markdown-syntax-propertize-extend-region)
  8678. (add-hook 'jit-lock-after-change-extend-region-functions
  8679. #'markdown-font-lock-extend-region-function t t)
  8680. (setq-local syntax-propertize-function #'markdown-syntax-propertize)
  8681. (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
  8682. ;; Font lock.
  8683. (setq font-lock-defaults
  8684. '(markdown-mode-font-lock-keywords
  8685. nil nil nil nil
  8686. (font-lock-multiline . t)
  8687. (font-lock-syntactic-face-function . markdown-syntactic-face)
  8688. (font-lock-extra-managed-props
  8689. . (composition display invisible rear-nonsticky
  8690. keymap help-echo mouse-face))))
  8691. (if markdown-hide-markup
  8692. (add-to-invisibility-spec 'markdown-markup)
  8693. (remove-from-invisibility-spec 'markdown-markup))
  8694. ;; Wiki links
  8695. (markdown-setup-wiki-link-hooks)
  8696. ;; Math mode
  8697. (when markdown-enable-math (markdown-toggle-math t))
  8698. ;; Add a buffer-local hook to reload after file-local variables are read
  8699. (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t)
  8700. ;; For imenu support
  8701. (setq imenu-create-index-function
  8702. (if markdown-nested-imenu-heading-index
  8703. #'markdown-imenu-create-nested-index
  8704. #'markdown-imenu-create-flat-index))
  8705. ;; Defun movement
  8706. (setq-local beginning-of-defun-function #'markdown-beginning-of-defun)
  8707. (setq-local end-of-defun-function #'markdown-end-of-defun)
  8708. ;; Paragraph filling
  8709. (setq-local fill-paragraph-function #'markdown-fill-paragraph)
  8710. (setq-local paragraph-start
  8711. ;; Should match start of lines that start or separate paragraphs
  8712. (mapconcat #'identity
  8713. '(
  8714. "\f" ; starts with a literal line-feed
  8715. "[ \t\f]*$" ; space-only line
  8716. "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
  8717. "[ \t]*[*+-][ \t]+" ; unordered list item
  8718. "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
  8719. "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
  8720. "[ \t]*:[ \t]+" ; definition
  8721. "^|" ; table or Pandoc line block
  8722. )
  8723. "\\|"))
  8724. (setq-local paragraph-separate
  8725. ;; Should match lines that separate paragraphs without being
  8726. ;; part of any paragraph:
  8727. (mapconcat #'identity
  8728. '("[ \t\f]*$" ; space-only line
  8729. "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
  8730. ;; The following is not ideal, but the Fill customization
  8731. ;; options really only handle paragraph-starting prefixes,
  8732. ;; not paragraph-ending suffixes:
  8733. ".* $" ; line ending in two spaces
  8734. "^#+"
  8735. "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
  8736. "\\|"))
  8737. (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'")
  8738. (setq-local adaptive-fill-regexp "\\s-*")
  8739. (setq-local adaptive-fill-function #'markdown-adaptive-fill-function)
  8740. (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph)
  8741. ;; Outline mode
  8742. (setq-local outline-regexp markdown-regex-header)
  8743. (setq-local outline-level #'markdown-outline-level)
  8744. ;; Cause use of ellipses for invisible text.
  8745. (add-to-invisibility-spec '(outline . t))
  8746. ;; ElDoc support
  8747. (add-function :before-until (local 'eldoc-documentation-function)
  8748. #'markdown-eldoc-function)
  8749. ;; Inhibiting line-breaking:
  8750. ;; Separating out each condition into a separate function so that users can
  8751. ;; override if desired (with remove-hook)
  8752. (add-hook 'fill-nobreak-predicate
  8753. #'markdown-line-is-reference-definition-p nil t)
  8754. (add-hook 'fill-nobreak-predicate
  8755. #'markdown-pipe-at-bol-p nil t)
  8756. ;; Indentation
  8757. (setq-local indent-line-function markdown-indent-function)
  8758. (setq-local indent-region-function #'markdown--indent-region)
  8759. ;; Flyspell
  8760. (setq-local flyspell-generic-check-word-predicate
  8761. #'markdown-flyspell-check-word-p)
  8762. ;; Electric quoting
  8763. (add-hook 'electric-quote-inhibit-functions
  8764. #'markdown--inhibit-electric-quote nil :local)
  8765. ;; Make checkboxes buttons
  8766. (when markdown-make-gfm-checkboxes-buttons
  8767. (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
  8768. (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t)
  8769. (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t))
  8770. ;; edit-indirect
  8771. (add-hook 'edit-indirect-after-commit-functions
  8772. #'markdown--edit-indirect-after-commit-function
  8773. nil 'local)
  8774. ;; Marginalized headings
  8775. (when markdown-marginalize-headers
  8776. (add-hook 'window-configuration-change-hook
  8777. #'markdown-marginalize-update-current nil t))
  8778. ;; add live preview export hook
  8779. (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t)
  8780. (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t))
  8781. ;;;###autoload
  8782. (add-to-list 'auto-mode-alist
  8783. '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode))
  8784. ;;; GitHub Flavored Markdown Mode ============================================
  8785. (defun gfm--electric-pair-fence-code-block ()
  8786. (when (and electric-pair-mode
  8787. (not markdown-gfm-use-electric-backquote)
  8788. (eql last-command-event ?`)
  8789. (let ((count 0))
  8790. (while (eql (char-before (- (point) count)) ?`)
  8791. (cl-incf count))
  8792. (= count 3))
  8793. (eql (char-after) ?`))
  8794. (save-excursion (insert (make-string 2 ?`)))))
  8795. (defvar gfm-mode-hook nil
  8796. "Hook run when entering GFM mode.")
  8797. ;;;###autoload
  8798. (define-derived-mode gfm-mode markdown-mode "GFM"
  8799. "Major mode for editing GitHub Flavored Markdown files."
  8800. (setq markdown-link-space-sub-char "-")
  8801. (setq markdown-wiki-link-search-subdirectories t)
  8802. (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p)
  8803. (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t)
  8804. (markdown-gfm-parse-buffer-for-languages))
  8805. ;;; Viewing modes =============================================================
  8806. (defcustom markdown-hide-markup-in-view-modes t
  8807. "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
  8808. :group 'markdown
  8809. :type 'boolean
  8810. :safe 'booleanp)
  8811. (defvar markdown-view-mode-map
  8812. (let ((map (make-sparse-keymap)))
  8813. (define-key map (kbd "p") #'markdown-outline-previous)
  8814. (define-key map (kbd "n") #'markdown-outline-next)
  8815. (define-key map (kbd "f") #'markdown-outline-next-same-level)
  8816. (define-key map (kbd "b") #'markdown-outline-previous-same-level)
  8817. (define-key map (kbd "u") #'markdown-outline-up)
  8818. (define-key map (kbd "DEL") #'scroll-down-command)
  8819. (define-key map (kbd "SPC") #'scroll-up-command)
  8820. (define-key map (kbd ">") #'end-of-buffer)
  8821. (define-key map (kbd "<") #'beginning-of-buffer)
  8822. (define-key map (kbd "q") #'kill-this-buffer)
  8823. (define-key map (kbd "?") #'describe-mode)
  8824. map)
  8825. "Keymap for `markdown-view-mode'.")
  8826. (defun markdown--filter-visible (beg end &optional delete)
  8827. (let ((result "")
  8828. (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face)))
  8829. (while (< beg end)
  8830. (when (markdown--face-p beg invisible-faces)
  8831. (cl-incf beg)
  8832. (while (and (markdown--face-p beg invisible-faces) (< beg end))
  8833. (cl-incf beg)))
  8834. (let ((next (next-single-char-property-change beg 'invisible)))
  8835. (unless (get-char-property beg 'invisible)
  8836. (setq result (concat result (buffer-substring beg (min end next)))))
  8837. (setq beg next)))
  8838. (prog1 result
  8839. (when delete
  8840. (let ((inhibit-read-only t))
  8841. (delete-region beg end))))))
  8842. ;;;###autoload
  8843. (define-derived-mode markdown-view-mode markdown-mode "Markdown-View"
  8844. "Major mode for viewing Markdown content."
  8845. (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
  8846. (add-to-invisibility-spec 'markdown-markup)
  8847. (setq-local filter-buffer-substring-function #'markdown--filter-visible)
  8848. (read-only-mode 1))
  8849. (defvar gfm-view-mode-map
  8850. markdown-view-mode-map
  8851. "Keymap for `gfm-view-mode'.")
  8852. ;;;###autoload
  8853. (define-derived-mode gfm-view-mode gfm-mode "GFM-View"
  8854. "Major mode for viewing GitHub Flavored Markdown content."
  8855. (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
  8856. (setq-local markdown-fontify-code-blocks-natively t)
  8857. (setq-local filter-buffer-substring-function #'markdown--filter-visible)
  8858. (add-to-invisibility-spec 'markdown-markup)
  8859. (read-only-mode 1))
  8860. ;;; Live Preview Mode ========================================================
  8861. ;;;###autoload
  8862. (define-minor-mode markdown-live-preview-mode
  8863. "Toggle native previewing on save for a specific markdown file."
  8864. :lighter " MD-Preview"
  8865. (if markdown-live-preview-mode
  8866. (if (markdown-live-preview-get-filename)
  8867. (markdown-display-buffer-other-window (markdown-live-preview-export))
  8868. (markdown-live-preview-mode -1)
  8869. (user-error "Buffer %s does not visit a file" (current-buffer)))
  8870. (markdown-live-preview-remove)))
  8871. (provide 'markdown-mode)
  8872. ;; Local Variables:
  8873. ;; indent-tabs-mode: nil
  8874. ;; coding: utf-8
  8875. ;; End:
  8876. ;;; markdown-mode.el ends here