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.

9838 lines
406 KiB

5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
5 years ago
  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: 20210530.1825
  9. ;; Package-Commit: 58f2d22526ac1e4abd4ee1afff8624d2dd3123d3
  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. (declare-function project-roots "project")
  41. ;;; Constants =================================================================
  42. (defconst markdown-mode-version "2.5-dev"
  43. "Markdown mode version number.")
  44. (defconst markdown-output-buffer-name "*markdown-output*"
  45. "Name of temporary buffer for markdown command output.")
  46. ;;; Global Variables ==========================================================
  47. (defvar markdown-reference-label-history nil
  48. "History of used reference labels.")
  49. (defvar markdown-live-preview-mode nil
  50. "Sentinel variable for command `markdown-live-preview-mode'.")
  51. (defvar markdown-gfm-language-history nil
  52. "History list of languages used in the current buffer in GFM code blocks.")
  53. ;;; Customizable Variables ====================================================
  54. (defvar markdown-mode-hook nil
  55. "Hook run when entering Markdown mode.")
  56. (defvar markdown-before-export-hook nil
  57. "Hook run before running Markdown to export XHTML output.
  58. The hook may modify the buffer, which will be restored to it's
  59. original state after exporting is complete.")
  60. (defvar markdown-after-export-hook nil
  61. "Hook run after XHTML output has been saved.
  62. Any changes to the output buffer made by this hook will be saved.")
  63. (defgroup markdown nil
  64. "Major mode for editing text files in Markdown format."
  65. :prefix "markdown-"
  66. :group 'text
  67. :link '(url-link "https://jblevins.org/projects/markdown-mode/"))
  68. (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py")
  69. when (executable-find cmd)
  70. return (file-name-nondirectory it))))
  71. (or command "markdown"))
  72. "Command to run markdown."
  73. :group 'markdown
  74. :type '(choice (string :tag "Shell command") (repeat (string)) function))
  75. (defcustom markdown-command-needs-filename nil
  76. "Set to non-nil if `markdown-command' does not accept input from stdin.
  77. Instead, it will be passed a filename as the final command line
  78. option. As a result, you will only be able to run Markdown from
  79. buffers which are visiting a file."
  80. :group 'markdown
  81. :type 'boolean)
  82. (defcustom markdown-open-command nil
  83. "Command used for opening Markdown files directly.
  84. For example, a standalone Markdown previewer. This command will
  85. be called with a single argument: the filename of the current
  86. buffer. It can also be a function, which will be called without
  87. arguments."
  88. :group 'markdown
  89. :type '(choice file function (const :tag "None" nil)))
  90. (defcustom markdown-open-image-command nil
  91. "Command used for opening image files directly.
  92. This is used at `markdown-follow-link-at-point'."
  93. :group 'markdown
  94. :type '(choice file function (const :tag "None" nil)))
  95. (defcustom markdown-hr-strings
  96. '("-------------------------------------------------------------------------------"
  97. "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
  98. "---------------------------------------"
  99. "* * * * * * * * * * * * * * * * * * * *"
  100. "---------"
  101. "* * * * *")
  102. "Strings to use when inserting horizontal rules.
  103. The first string in the list will be the default when inserting a
  104. horizontal rule. Strings should be listed in decreasing order of
  105. prominence (as in headings from level one to six) for use with
  106. promotion and demotion functions."
  107. :group 'markdown
  108. :type '(repeat string))
  109. (defcustom markdown-bold-underscore nil
  110. "Use two underscores when inserting bold text instead of two asterisks."
  111. :group 'markdown
  112. :type 'boolean)
  113. (defcustom markdown-italic-underscore nil
  114. "Use underscores when inserting italic text instead of asterisks."
  115. :group 'markdown
  116. :type 'boolean)
  117. (defcustom markdown-marginalize-headers nil
  118. "When non-nil, put opening atx header markup in a left margin.
  119. This setting goes well with `markdown-asymmetric-header'. But
  120. sadly it conflicts with `linum-mode' since they both use the
  121. same margin."
  122. :group 'markdown
  123. :type 'boolean
  124. :safe 'booleanp
  125. :package-version '(markdown-mode . "2.4"))
  126. (defcustom markdown-marginalize-headers-margin-width 6
  127. "Character width of margin used for marginalized headers.
  128. The default value is based on there being six heading levels
  129. defined by Markdown and HTML. Increasing this produces extra
  130. whitespace on the left. Decreasing it may be preferred when
  131. fewer than six nested heading levels are used."
  132. :group 'markdown
  133. :type 'natnump
  134. :safe 'natnump
  135. :package-version '(markdown-mode . "2.4"))
  136. (defcustom markdown-asymmetric-header nil
  137. "Determines if atx header style will be asymmetric.
  138. Set to a non-nil value to use asymmetric header styling, placing
  139. header markup only at the beginning of the line. By default,
  140. balanced markup will be inserted at the beginning and end of the
  141. line around the header title."
  142. :group 'markdown
  143. :type 'boolean)
  144. (defcustom markdown-indent-function 'markdown-indent-line
  145. "Function to use to indent."
  146. :group 'markdown
  147. :type 'function)
  148. (defcustom markdown-indent-on-enter t
  149. "Determines indentation behavior when pressing \\[newline].
  150. Possible settings are nil, t, and 'indent-and-new-item.
  151. When non-nil, pressing \\[newline] will call `newline-and-indent'
  152. to indent the following line according to the context using
  153. `markdown-indent-function'. In this case, note that
  154. \\[electric-newline-and-maybe-indent] can still be used to insert
  155. a newline without indentation.
  156. When set to 'indent-and-new-item and the point is in a list item
  157. when \\[newline] is pressed, the list will be continued on the next
  158. line, where a new item will be inserted.
  159. When set to nil, simply call `newline' as usual. In this case,
  160. you can still indent lines using \\[markdown-cycle] and continue
  161. lists with \\[markdown-insert-list-item].
  162. Note that this assumes the variable `electric-indent-mode' is
  163. non-nil (enabled). When it is *disabled*, the behavior of
  164. \\[newline] and `\\[electric-newline-and-maybe-indent]' are
  165. reversed."
  166. :group 'markdown
  167. :type '(choice (const :tag "Don't automatically indent" nil)
  168. (const :tag "Automatically indent" t)
  169. (const :tag "Automatically indent and insert new list items" indent-and-new-item)))
  170. (defcustom markdown-enable-wiki-links nil
  171. "Syntax highlighting for wiki links.
  172. Set this to a non-nil value to turn on wiki link support by default.
  173. Support can be toggled later using the `markdown-toggle-wiki-links'
  174. function or \\[markdown-toggle-wiki-links]."
  175. :group 'markdown
  176. :type 'boolean
  177. :safe 'booleanp
  178. :package-version '(markdown-mode . "2.2"))
  179. (defcustom markdown-wiki-link-alias-first t
  180. "When non-nil, treat aliased wiki links like [[alias text|PageName]].
  181. Otherwise, they will be treated as [[PageName|alias text]]."
  182. :group 'markdown
  183. :type 'boolean
  184. :safe 'booleanp)
  185. (defcustom markdown-wiki-link-search-subdirectories nil
  186. "When non-nil, search for wiki link targets in subdirectories.
  187. This is the default search behavior for GitHub and is
  188. automatically set to t in `gfm-mode'."
  189. :group 'markdown
  190. :type 'boolean
  191. :safe 'booleanp
  192. :package-version '(markdown-mode . "2.2"))
  193. (defcustom markdown-wiki-link-search-parent-directories nil
  194. "When non-nil, search for wiki link targets in parent directories.
  195. This is the default search behavior of Ikiwiki."
  196. :group 'markdown
  197. :type 'boolean
  198. :safe 'booleanp
  199. :package-version '(markdown-mode . "2.2"))
  200. (defcustom markdown-wiki-link-search-type nil
  201. "Searching type for markdown wiki link.
  202. sub-directories: search for wiki link targets in sub directories
  203. parent-directories: search for wiki link targets in parent directories
  204. project: search for wiki link targets under project root"
  205. :group 'markdown
  206. :type '(set
  207. (const :tag "search wiki link from subdirectories" sub-directories)
  208. (const :tag "search wiki link from parent directories" parent-directories)
  209. (const :tag "search wiki link under project root" project))
  210. :package-version '(markdown-mode . "2.5"))
  211. (make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5")
  212. (make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5")
  213. (defcustom markdown-wiki-link-fontify-missing nil
  214. "When non-nil, change wiki link face according to existence of target files.
  215. This is expensive because it requires checking for the file each time the buffer
  216. changes or the user switches windows. It is disabled by default because it may
  217. cause lag when typing on slower machines."
  218. :group 'markdown
  219. :type 'boolean
  220. :safe 'booleanp
  221. :package-version '(markdown-mode . "2.2"))
  222. (defcustom markdown-uri-types
  223. '("acap" "cid" "data" "dav" "fax" "file" "ftp"
  224. "gopher" "http" "https" "imap" "ldap" "mailto"
  225. "mid" "message" "modem" "news" "nfs" "nntp"
  226. "pop" "prospero" "rtsp" "service" "sip" "tel"
  227. "telnet" "tip" "urn" "vemmi" "wais")
  228. "Link types for syntax highlighting of URIs."
  229. :group 'markdown
  230. :type '(repeat (string :tag "URI scheme")))
  231. (defcustom markdown-url-compose-char
  232. '(?∞ ?… ?⋯ ?# ?★ ?⚓)
  233. "Placeholder character for hidden URLs.
  234. This may be a single character or a list of characters. In case
  235. of a list, the first one that satisfies `char-displayable-p' will
  236. be used."
  237. :type '(choice
  238. (character :tag "Single URL replacement character")
  239. (repeat :tag "List of possible URL replacement characters"
  240. character))
  241. :package-version '(markdown-mode . "2.3"))
  242. (defcustom markdown-blockquote-display-char
  243. '("" "" ">")
  244. "String to display when hiding blockquote markup.
  245. This may be a single string or a list of string. In case of a
  246. list, the first one that satisfies `char-displayable-p' will be
  247. used."
  248. :type 'string
  249. :type '(choice
  250. (string :tag "Single blockquote display string")
  251. (repeat :tag "List of possible blockquote display strings" string))
  252. :package-version '(markdown-mode . "2.3"))
  253. (defcustom markdown-hr-display-char
  254. '(?─ ?━ ?-)
  255. "Character for hiding horizontal rule markup.
  256. This may be a single character or a list of characters. In case
  257. of a list, the first one that satisfies `char-displayable-p' will
  258. be used."
  259. :group 'markdown
  260. :type '(choice
  261. (character :tag "Single HR display character")
  262. (repeat :tag "List of possible HR display characters" character))
  263. :package-version '(markdown-mode . "2.3"))
  264. (defcustom markdown-definition-display-char
  265. '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:)
  266. "Character for replacing definition list markup.
  267. This may be a single character or a list of characters. In case
  268. of a list, the first one that satisfies `char-displayable-p' will
  269. be used."
  270. :type '(choice
  271. (character :tag "Single definition list character")
  272. (repeat :tag "List of possible definition list characters" character))
  273. :package-version '(markdown-mode . "2.3"))
  274. (defcustom markdown-enable-math nil
  275. "Syntax highlighting for inline LaTeX and itex expressions.
  276. Set this to a non-nil value to turn on math support by default.
  277. Math support can be enabled, disabled, or toggled later using
  278. `markdown-toggle-math' or \\[markdown-toggle-math]."
  279. :group 'markdown
  280. :type 'boolean
  281. :safe 'booleanp)
  282. (make-variable-buffer-local 'markdown-enable-math)
  283. (defcustom markdown-enable-html t
  284. "Enable font-lock support for HTML tags and attributes."
  285. :group 'markdown
  286. :type 'boolean
  287. :safe 'booleanp
  288. :package-version '(markdown-mode . "2.4"))
  289. (defcustom markdown-css-paths nil
  290. "List of URLs of CSS files to link to in the output XHTML."
  291. :group 'markdown
  292. :type '(repeat (string :tag "CSS File Path")))
  293. (defcustom markdown-content-type "text/html"
  294. "Content type string for the http-equiv header in XHTML output.
  295. When set to an empty string, this attribute is omitted. Defaults to
  296. `text/html'."
  297. :group 'markdown
  298. :type 'string)
  299. (defcustom markdown-coding-system nil
  300. "Character set string for the http-equiv header in XHTML output.
  301. Defaults to `buffer-file-coding-system' (and falling back to
  302. `utf-8' when not available). Common settings are `iso-8859-1'
  303. and `iso-latin-1'. Use `list-coding-systems' for more choices."
  304. :group 'markdown
  305. :type 'coding-system)
  306. (defcustom markdown-export-kill-buffer t
  307. "Kill output buffer after HTML export.
  308. When non-nil, kill the HTML output buffer after
  309. exporting with `markdown-export'."
  310. :group 'markdown
  311. :type 'boolean
  312. :safe 'booleanp
  313. :package-version '(markdown-mode . "2.4"))
  314. (defcustom markdown-xhtml-header-content ""
  315. "Additional content to include in the XHTML <head> block."
  316. :group 'markdown
  317. :type 'string)
  318. (defcustom markdown-xhtml-body-preamble ""
  319. "Content to include in the XHTML <body> block, before the output."
  320. :group 'markdown
  321. :type 'string
  322. :safe 'stringp
  323. :package-version '(markdown-mode . "2.4"))
  324. (defcustom markdown-xhtml-body-epilogue ""
  325. "Content to include in the XHTML <body> block, after the output."
  326. :group 'markdown
  327. :type 'string
  328. :safe 'stringp
  329. :package-version '(markdown-mode . "2.4"))
  330. (defcustom markdown-xhtml-standalone-regexp
  331. "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
  332. "Regexp indicating whether `markdown-command' output is standalone XHTML."
  333. :group 'markdown
  334. :type 'regexp)
  335. (defcustom markdown-link-space-sub-char "_"
  336. "Character to use instead of spaces when mapping wiki links to filenames."
  337. :group 'markdown
  338. :type 'string)
  339. (defcustom markdown-reference-location 'header
  340. "Position where new reference definitions are inserted in the document."
  341. :group 'markdown
  342. :type '(choice (const :tag "At the end of the document" end)
  343. (const :tag "Immediately after the current block" immediately)
  344. (const :tag "At the end of the subtree" subtree)
  345. (const :tag "Before next header" header)))
  346. (defcustom markdown-footnote-location 'end
  347. "Position where new footnotes are inserted in the document."
  348. :group 'markdown
  349. :type '(choice (const :tag "At the end of the document" end)
  350. (const :tag "Immediately after the current block" immediately)
  351. (const :tag "At the end of the subtree" subtree)
  352. (const :tag "Before next header" header)))
  353. (defcustom markdown-footnote-display '((raise 0.2) (height 0.8))
  354. "Display specification for footnote markers and inline footnotes.
  355. By default, footnote text is reduced in size and raised. Set to
  356. nil to disable this."
  357. :group 'markdown
  358. :type '(choice (sexp :tag "Display specification")
  359. (const :tag "Don't set display property" nil))
  360. :package-version '(markdown-mode . "2.4"))
  361. (defcustom markdown-sub-superscript-display
  362. '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7)))
  363. "Display specification for subscript and superscripts.
  364. The car is used for subscript, the cdr is used for superscripts."
  365. :group 'markdown
  366. :type '(cons (choice (sexp :tag "Subscript form")
  367. (const :tag "No lowering" nil))
  368. (choice (sexp :tag "Superscript form")
  369. (const :tag "No raising" nil)))
  370. :package-version '(markdown-mode . "2.4"))
  371. (defcustom markdown-unordered-list-item-prefix " * "
  372. "String inserted before unordered list items."
  373. :group 'markdown
  374. :type 'string)
  375. (defcustom markdown-ordered-list-enumeration t
  376. "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker.
  377. While nil, always uses '1.' for the marker"
  378. :group 'markdown
  379. :type 'boolean
  380. :package-version '(markdown-mode . "2.5"))
  381. (defcustom markdown-nested-imenu-heading-index t
  382. "Use nested or flat imenu heading index.
  383. A nested index may provide more natural browsing from the menu,
  384. but a flat list may allow for faster keyboard navigation via tab
  385. completion."
  386. :group 'markdown
  387. :type 'boolean
  388. :safe 'booleanp
  389. :package-version '(markdown-mode . "2.2"))
  390. (defcustom markdown-add-footnotes-to-imenu t
  391. "Add footnotes to end of imenu heading index."
  392. :group 'markdown
  393. :type 'boolean
  394. :safe 'booleanp
  395. :package-version '(markdown-mode . "2.4"))
  396. (defcustom markdown-make-gfm-checkboxes-buttons t
  397. "When non-nil, make GFM checkboxes into buttons."
  398. :group 'markdown
  399. :type 'boolean)
  400. (defcustom markdown-use-pandoc-style-yaml-metadata nil
  401. "When non-nil, allow YAML metadata anywhere in the document."
  402. :group 'markdown
  403. :type 'boolean)
  404. (defcustom markdown-split-window-direction 'any
  405. "Preference for splitting windows for static and live preview.
  406. The default value is 'any, which instructs Emacs to use
  407. `split-window-sensibly' to automatically choose how to split
  408. windows based on the values of `split-width-threshold' and
  409. `split-height-threshold' and the available windows. To force
  410. vertically split (left and right) windows, set this to 'vertical
  411. or 'right. To force horizontally split (top and bottom) windows,
  412. set this to 'horizontal or 'below.
  413. If this value is 'any and `display-buffer-alist' is set then
  414. `display-buffer' is used for open buffer function"
  415. :group 'markdown
  416. :type '(choice (const :tag "Automatic" any)
  417. (const :tag "Right (vertical)" right)
  418. (const :tag "Below (horizontal)" below))
  419. :package-version '(markdown-mode . "2.2"))
  420. (defcustom markdown-live-preview-window-function
  421. 'markdown-live-preview-window-eww
  422. "Function to display preview of Markdown output within Emacs.
  423. Function must update the buffer containing the preview and return
  424. the buffer."
  425. :group 'markdown
  426. :type 'function)
  427. (defcustom markdown-live-preview-delete-export 'delete-on-destroy
  428. "Delete exported HTML file when using `markdown-live-preview-export'.
  429. If set to 'delete-on-export, delete on every export. When set to
  430. 'delete-on-destroy delete when quitting from command
  431. `markdown-live-preview-mode'. Never delete if set to nil."
  432. :group 'markdown
  433. :type '(choice
  434. (const :tag "Delete on every export" delete-on-export)
  435. (const :tag "Delete when quitting live preview" delete-on-destroy)
  436. (const :tag "Never delete" nil)))
  437. (defcustom markdown-list-indent-width 4
  438. "Depth of indentation for markdown lists.
  439. Used in `markdown-demote-list-item' and
  440. `markdown-promote-list-item'."
  441. :group 'markdown
  442. :type 'integer)
  443. (defcustom markdown-enable-prefix-prompts t
  444. "Display prompts for certain prefix commands.
  445. Set to nil to disable these prompts."
  446. :group 'markdown
  447. :type 'boolean
  448. :safe 'booleanp
  449. :package-version '(markdown-mode . "2.3"))
  450. (defcustom markdown-gfm-additional-languages nil
  451. "Extra languages made available when inserting GFM code blocks.
  452. Language strings must have be trimmed of whitespace and not
  453. contain any curly braces. They may be of arbitrary
  454. capitalization, though."
  455. :group 'markdown
  456. :type '(repeat (string :validate markdown-validate-language-string)))
  457. (defcustom markdown-gfm-use-electric-backquote t
  458. "Use `markdown-electric-backquote' when backquote is hit three times."
  459. :group 'markdown
  460. :type 'boolean)
  461. (defcustom markdown-gfm-downcase-languages t
  462. "If non-nil, downcase suggested languages.
  463. This applies to insertions done with
  464. `markdown-electric-backquote'."
  465. :group 'markdown
  466. :type 'boolean)
  467. (defcustom markdown-edit-code-block-default-mode 'normal-mode
  468. "Default mode to use for editing code blocks.
  469. This mode is used when automatic detection fails, such as for GFM
  470. code blocks with no language specified."
  471. :group 'markdown
  472. :type '(choice function (const :tag "None" nil))
  473. :package-version '(markdown-mode . "2.4"))
  474. (defcustom markdown-gfm-uppercase-checkbox nil
  475. "If non-nil, use [X] for completed checkboxes, [x] otherwise."
  476. :group 'markdown
  477. :type 'boolean
  478. :safe 'booleanp)
  479. (defcustom markdown-hide-urls nil
  480. "Hide URLs of inline links and reference tags of reference links.
  481. Such URLs will be replaced by a single customizable
  482. character, defined by `markdown-url-compose-char', but are still part
  483. of the buffer. Links can be edited interactively with
  484. \\[markdown-insert-link] or, for example, by deleting the final
  485. parenthesis to remove the invisibility property. You can also
  486. hover your mouse pointer over the link text to see the URL.
  487. Set this to a non-nil value to turn this feature on by default.
  488. You can interactively set the value of this variable by calling
  489. `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
  490. or from the menu Markdown > Links & Images menu."
  491. :group 'markdown
  492. :type 'boolean
  493. :safe 'booleanp
  494. :package-version '(markdown-mode . "2.3"))
  495. (make-variable-buffer-local 'markdown-hide-urls)
  496. (defcustom markdown-translate-filename-function #'identity
  497. "Function to use to translate filenames when following links.
  498. \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
  499. call this function with the filename as only argument whenever
  500. they encounter a filename (instead of a URL) to be visited and
  501. use its return value instead of the filename in the link. For
  502. example, if absolute filenames are actually relative to a server
  503. root directory, you can set
  504. `markdown-translate-filename-function' to a function that
  505. prepends the root directory to the given filename."
  506. :group 'markdown
  507. :type 'function
  508. :risky t
  509. :package-version '(markdown-mode . "2.4"))
  510. (defcustom markdown-max-image-size nil
  511. "Maximum width and height for displayed inline images.
  512. This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
  513. When nil, use the actual size. Otherwise, use ImageMagick to
  514. resize larger images to be of the given maximum dimensions. This
  515. requires Emacs to be built with ImageMagick support."
  516. :group 'markdown
  517. :package-version '(markdown-mode . "2.4")
  518. :type '(choice
  519. (const :tag "Use actual image width" nil)
  520. (cons (choice (sexp :tag "Maximum width in pixels")
  521. (const :tag "No maximum width" nil))
  522. (choice (sexp :tag "Maximum height in pixels")
  523. (const :tag "No maximum height" nil)))))
  524. (defcustom markdown-mouse-follow-link t
  525. "Non-nil means mouse on a link will follow the link.
  526. This variable must be set before loading markdown-mode."
  527. :group 'markdown
  528. :type 'bool
  529. :safe 'booleanp
  530. :package-version '(markdown-mode . "2.5"))
  531. ;;; Markdown-Specific `rx' Macro ==============================================
  532. ;; Based on python-rx from python.el.
  533. (eval-and-compile
  534. (defconst markdown-rx-constituents
  535. `((newline . ,(rx "\n"))
  536. ;; Note: #405 not consider markdown-list-indent-width however this is never used
  537. (indent . ,(rx (or (repeat 4 " ") "\t")))
  538. (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end))))
  539. (numeral . ,(rx (and (one-or-more (any "0-9#")) ".")))
  540. (bullet . ,(rx (any "*+:-")))
  541. (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".")
  542. (any "*+:-"))))
  543. (checkbox . ,(rx "[" (any " xX") "]")))
  544. "Markdown-specific sexps for `markdown-rx'")
  545. (defun markdown-rx-to-string (form &optional no-group)
  546. "Markdown mode specialized `rx-to-string' function.
  547. This variant supports named Markdown expressions in FORM.
  548. NO-GROUP non-nil means don't put shy groups around the result."
  549. (let ((rx-constituents (append markdown-rx-constituents rx-constituents)))
  550. (rx-to-string form no-group)))
  551. (defmacro markdown-rx (&rest regexps)
  552. "Markdown mode specialized rx macro.
  553. This variant of `rx' supports common Markdown named REGEXPS."
  554. (cond ((null regexps)
  555. (error "No regexp"))
  556. ((cdr regexps)
  557. (markdown-rx-to-string `(and ,@regexps) t))
  558. (t
  559. (markdown-rx-to-string (car regexps) t)))))
  560. ;;; Regular Expressions =======================================================
  561. (defconst markdown-regex-comment-start
  562. "<!--"
  563. "Regular expression matches HTML comment opening.")
  564. (defconst markdown-regex-comment-end
  565. "--[ \t]*>"
  566. "Regular expression matches HTML comment closing.")
  567. (defconst markdown-regex-link-inline
  568. "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)"
  569. "Regular expression for a [text](file) or an image link ![text](file).
  570. Group 1 matches the leading exclamation point (optional).
  571. Group 2 matches the opening square bracket.
  572. Group 3 matches the text inside the square brackets.
  573. Group 4 matches the closing square bracket.
  574. Group 5 matches the opening parenthesis.
  575. Group 6 matches the URL.
  576. Group 7 matches the title (optional).
  577. Group 8 matches the closing parenthesis.")
  578. (defconst markdown-regex-link-reference
  579. "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)"
  580. "Regular expression for a reference link [text][id].
  581. Group 1 matches the leading exclamation point (optional).
  582. Group 2 matches the opening square bracket for the link text.
  583. Group 3 matches the text inside the square brackets.
  584. Group 4 matches the closing square bracket for the link text.
  585. Group 5 matches the opening square bracket for the reference label.
  586. Group 6 matches the reference label.
  587. Group 7 matches the closing square bracket for the reference label.")
  588. (defconst markdown-regex-reference-definition
  589. "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)"
  590. "Regular expression for a reference definition.
  591. Group 1 matches the opening square bracket.
  592. Group 2 matches the reference label.
  593. Group 3 matches the closing square bracket.
  594. Group 4 matches the colon.
  595. Group 5 matches the URL.
  596. Group 6 matches the title attribute (optional).")
  597. (defconst markdown-regex-footnote
  598. "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)"
  599. "Regular expression for a footnote marker [^fn].
  600. Group 1 matches the opening square bracket and carat.
  601. Group 2 matches only the label, without the surrounding markup.
  602. Group 3 matches the closing square bracket.")
  603. (defconst markdown-regex-header
  604. "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$"
  605. "Regexp identifying Markdown headings.
  606. Group 1 matches the text of a setext heading.
  607. Group 2 matches the underline of a level-1 setext heading.
  608. Group 3 matches the underline of a level-2 setext heading.
  609. Group 4 matches the opening hash marks of an atx heading and whitespace.
  610. Group 5 matches the text, without surrounding whitespace, of an atx heading.
  611. Group 6 matches the closing whitespace and hash marks of an atx heading.")
  612. (defconst markdown-regex-header-setext
  613. "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
  614. "Regular expression for generic setext-style (underline) headers.")
  615. (defconst markdown-regex-header-atx
  616. "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
  617. "Regular expression for generic atx-style (hash mark) headers.")
  618. (defconst markdown-regex-hr
  619. (rx line-start
  620. (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* ")))
  621. (and (repeat 3 (and "-" (? " "))) (* (any "- ")))
  622. (and (repeat 3 (and "_" (? " "))) (* (any "_ ")))))
  623. line-end)
  624. "Regular expression for matching Markdown horizontal rules.")
  625. (defconst markdown-regex-code
  626. "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)"
  627. "Regular expression for matching inline code fragments.
  628. Group 1 matches the entire code fragment including the backquotes.
  629. Group 2 matches the opening backquotes.
  630. Group 3 matches the code fragment itself, without backquotes.
  631. Group 4 matches the closing backquotes.
  632. The leading, unnumbered group ensures that the leading backquote
  633. character is not escaped.
  634. The last group, also unnumbered, requires that the character
  635. following the code fragment is not a backquote.
  636. Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
  637. but not two newlines in a row.")
  638. (defconst markdown-regex-kbd
  639. "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)"
  640. "Regular expression for matching <kbd> tags.
  641. Groups 1 and 3 match the opening and closing tags.
  642. Group 2 matches the key sequence.")
  643. (defconst markdown-regex-gfm-code-block-open
  644. "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$"
  645. "Regular expression matching opening of GFM code blocks.
  646. Group 1 matches the opening three backquotes and any following whitespace.
  647. Group 2 matches the opening brace (optional) and surrounding whitespace.
  648. Group 3 matches the language identifier (optional).
  649. Group 4 matches the info string (optional).
  650. Group 5 matches the closing brace (optional), whitespace, and newline.
  651. Groups need to agree with `markdown-regex-tilde-fence-begin'.")
  652. (defconst markdown-regex-gfm-code-block-close
  653. "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$"
  654. "Regular expression matching closing of GFM code blocks.
  655. Group 1 matches the closing three backquotes.
  656. Group 2 matches any whitespace and the final newline.")
  657. (defconst markdown-regex-pre
  658. "^\\( \\|\t\\).*$"
  659. "Regular expression for matching preformatted text sections.")
  660. (defconst markdown-regex-list
  661. (markdown-rx line-start
  662. ;; 1. Leading whitespace
  663. (group (* blank))
  664. ;; 2. List marker: a numeral, bullet, or colon
  665. (group list-marker)
  666. ;; 3. Trailing whitespace
  667. (group (+ blank))
  668. ;; 4. Optional checkbox for GFM task list items
  669. (opt (group (and checkbox (* blank)))))
  670. "Regular expression for matching list items.")
  671. (defconst markdown-regex-bold
  672. "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)"
  673. "Regular expression for matching bold text.
  674. Group 1 matches the character before the opening asterisk or
  675. underscore, if any, ensuring that it is not a backslash escape.
  676. Group 2 matches the entire expression, including delimiters.
  677. Groups 3 and 5 matches the opening and closing delimiters.
  678. Group 4 matches the text inside the delimiters.")
  679. (defconst markdown-regex-italic
  680. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)"
  681. "Regular expression for matching italic text.
  682. The leading unnumbered matches the character before the opening
  683. asterisk or underscore, if any, ensuring that it is not a
  684. backslash escape.
  685. Group 1 matches the entire expression, including delimiters.
  686. Groups 2 and 4 matches the opening and closing delimiters.
  687. Group 3 matches the text inside the delimiters.")
  688. (defconst markdown-regex-strike-through
  689. "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)"
  690. "Regular expression for matching strike-through text.
  691. Group 1 matches the character before the opening tilde, if any,
  692. ensuring that it is not a backslash escape.
  693. Group 2 matches the entire expression, including delimiters.
  694. Groups 3 and 5 matches the opening and closing delimiters.
  695. Group 4 matches the text inside the delimiters.")
  696. (defconst markdown-regex-gfm-italic
  697. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)"
  698. "Regular expression for matching italic text in GitHub Flavored Markdown.
  699. Underscores in words are not treated as special.
  700. Group 1 matches the entire expression, including delimiters.
  701. Groups 2 and 4 matches the opening and closing delimiters.
  702. Group 3 matches the text inside the delimiters.")
  703. (defconst markdown-regex-blockquote
  704. "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$"
  705. "Regular expression for matching blockquote lines.
  706. Also accounts for a potential capital letter preceding the angle
  707. bracket, for use with Leanpub blocks (asides, warnings, info
  708. blocks, etc.).
  709. Group 1 matches the leading angle bracket.
  710. Group 2 matches the separating whitespace.
  711. Group 3 matches the text.")
  712. (defconst markdown-regex-line-break
  713. "[^ \n\t][ \t]*\\( \\)$"
  714. "Regular expression for matching line breaks.")
  715. (defconst markdown-regex-wiki-link
  716. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)"
  717. "Regular expression for matching wiki links.
  718. This matches typical bracketed [[WikiLinks]] as well as 'aliased'
  719. wiki links of the form [[PageName|link text]].
  720. The meanings of the first and second components depend
  721. on the value of `markdown-wiki-link-alias-first'.
  722. Group 1 matches the entire link.
  723. Group 2 matches the opening square brackets.
  724. Group 3 matches the first component of the wiki link.
  725. Group 4 matches the pipe separator, when present.
  726. Group 5 matches the second component of the wiki link, when present.
  727. Group 6 matches the closing square brackets.")
  728. (defconst markdown-regex-uri
  729. (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)")
  730. "Regular expression for matching inline URIs.")
  731. (defconst markdown-regex-angle-uri
  732. (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)")
  733. "Regular expression for matching inline URIs in angle brackets.")
  734. (defconst markdown-regex-email
  735. "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
  736. "Regular expression for matching inline email addresses.")
  737. (defsubst markdown-make-regex-link-generic ()
  738. "Make regular expression for matching any recognized link."
  739. (concat "\\(?:" markdown-regex-link-inline
  740. (when markdown-enable-wiki-links
  741. (concat "\\|" markdown-regex-wiki-link))
  742. "\\|" markdown-regex-link-reference
  743. "\\|" markdown-regex-angle-uri "\\)"))
  744. (defconst markdown-regex-gfm-checkbox
  745. " \\(\\[[ xX]\\]\\) "
  746. "Regular expression for matching GFM checkboxes.
  747. Group 1 matches the text to become a button.")
  748. (defconst markdown-regex-blank-line
  749. "^[[:blank:]]*$"
  750. "Regular expression that matches a blank line.")
  751. (defconst markdown-regex-block-separator
  752. "\n[\n\t\f ]*\n"
  753. "Regular expression for matching block boundaries.")
  754. (defconst markdown-regex-block-separator-noindent
  755. (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)")
  756. "Regexp for block separators before lines with no indentation.")
  757. (defconst markdown-regex-math-inline-single
  758. "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)"
  759. "Regular expression for itex $..$ math mode expressions.
  760. Groups 1 and 3 match the opening and closing dollar signs.
  761. Group 2 matches the mathematical expression contained within.")
  762. (defconst markdown-regex-math-inline-double
  763. "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)"
  764. "Regular expression for itex $$..$$ math mode expressions.
  765. Groups 1 and 3 match opening and closing dollar signs.
  766. Group 2 matches the mathematical expression contained within.")
  767. (defconst markdown-regex-math-display
  768. (rx line-start (* blank)
  769. (group (group (repeat 1 2 "\\")) "[")
  770. (group (*? anything))
  771. (group (backref 2) "]")
  772. line-end)
  773. "Regular expression for \[..\] or \\[..\\] display math.
  774. Groups 1 and 4 match the opening and closing markup.
  775. Group 3 matches the mathematical expression contained within.
  776. Group 2 matches the opening slashes, and is used internally to
  777. match the closing slashes.")
  778. (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line)
  779. "Return regexp matching a tilde code fence at least NUM-TILDES long.
  780. END-OF-LINE is the regexp construct to indicate end of line; $ if
  781. missing."
  782. (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)"
  783. (or end-of-line "$")))
  784. (defconst markdown-regex-tilde-fence-begin
  785. (markdown-make-tilde-fence-regex
  786. 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
  787. "Regular expression for matching tilde-fenced code blocks.
  788. Group 1 matches the opening tildes.
  789. Group 2 matches (optional) opening brace and surrounding whitespace.
  790. Group 3 matches the language identifier (optional).
  791. Group 4 matches the info string (optional).
  792. Group 5 matches the closing brace (optional) and any surrounding whitespace.
  793. Groups need to agree with `markdown-regex-gfm-code-block-open'.")
  794. (defconst markdown-regex-declarative-metadata
  795. "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
  796. "Regular expression for matching declarative metadata statements.
  797. This matches MultiMarkdown metadata as well as YAML and TOML
  798. assignments such as the following:
  799. variable: value
  800. or
  801. variable = value")
  802. (defconst markdown-regex-pandoc-metadata
  803. "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
  804. "Regular expression for matching Pandoc metadata.")
  805. (defconst markdown-regex-yaml-metadata-border
  806. "\\(-\\{3\\}\\)$"
  807. "Regular expression for matching YAML metadata.")
  808. (defconst markdown-regex-yaml-pandoc-metadata-end-border
  809. "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
  810. "Regular expression for matching YAML metadata end borders.")
  811. (defsubst markdown-get-yaml-metadata-start-border ()
  812. "Return YAML metadata start border depending upon whether Pandoc is used."
  813. (concat
  814. (if markdown-use-pandoc-style-yaml-metadata "^" "\\`")
  815. markdown-regex-yaml-metadata-border))
  816. (defsubst markdown-get-yaml-metadata-end-border (_)
  817. "Return YAML metadata end border depending upon whether Pandoc is used."
  818. (if markdown-use-pandoc-style-yaml-metadata
  819. markdown-regex-yaml-pandoc-metadata-end-border
  820. markdown-regex-yaml-metadata-border))
  821. (defconst markdown-regex-inline-attributes
  822. "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$"
  823. "Regular expression for matching inline identifiers or attribute lists.
  824. Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
  825. (defconst markdown-regex-leanpub-sections
  826. (concat
  827. "^\\({\\)\\("
  828. (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
  829. "\\)\\(}\\)[ \t]*\n")
  830. "Regular expression for Leanpub section markers and related syntax.")
  831. (defconst markdown-regex-sub-superscript
  832. "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[[:alnum:]]+\\)\\(?4:\\2\\)\\)"
  833. "The regular expression matching a sub- or superscript.
  834. The leading un-numbered group matches the character before the
  835. opening tilde or carat, if any, ensuring that it is not a
  836. backslash escape, carat, or tilde.
  837. Group 1 matches the entire expression, including markup.
  838. Group 2 matches the opening markup--a tilde or carat.
  839. Group 3 matches the text inside the delimiters.
  840. Group 4 matches the closing markup--a tilde or carat.")
  841. (defconst markdown-regex-include
  842. "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$"
  843. "Regular expression matching common forms of include syntax.
  844. Marked 2, Leanpub, and other processors support some of these forms:
  845. <<[sections/section1.md]
  846. <<(folder/filename)
  847. <<[Code title](folder/filename)
  848. <<{folder/raw_file.html}
  849. Group 1 matches the opening two angle brackets.
  850. Groups 2-4 match the opening square bracket, the text inside,
  851. and the closing square bracket, respectively.
  852. Groups 5-7 match the opening parenthesis, the text inside, and
  853. the closing parenthesis.
  854. Groups 8-10 match the opening brace, the text inside, and the brace.")
  855. (defconst markdown-regex-pandoc-inline-footnote
  856. "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)"
  857. "Regular expression for Pandoc inline footnote^[footnote text].
  858. Group 1 matches the opening caret.
  859. Group 2 matches the opening square bracket.
  860. Group 3 matches the footnote text, without the surrounding markup.
  861. Group 4 matches the closing square bracket.")
  862. (defconst markdown-regex-html-attr
  863. "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
  864. "Regular expression for matching HTML attributes and values.
  865. Group 1 matches the attribute name.
  866. Group 2 matches the following whitespace, equals sign, and value, if any.
  867. Group 3 matches the equals sign, if any.
  868. Group 4 matches single-, double-, or un-quoted attribute values.")
  869. (defconst markdown-regex-html-tag
  870. (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
  871. "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
  872. "Regular expression for matching HTML tags.
  873. Groups 1 and 9 match the beginning and ending angle brackets and slashes.
  874. Group 2 matches the tag name.
  875. Group 3 matches all attributes and whitespace following the tag name.")
  876. (defconst markdown-regex-html-entity
  877. "\\(&#?[[:alnum:]]+;\\)"
  878. "Regular expression for matching HTML entities.")
  879. ;;; Syntax ====================================================================
  880. (defvar markdown--syntax-properties
  881. (list 'markdown-tilde-fence-begin nil
  882. 'markdown-tilde-fence-end nil
  883. 'markdown-fenced-code nil
  884. 'markdown-yaml-metadata-begin nil
  885. 'markdown-yaml-metadata-end nil
  886. 'markdown-yaml-metadata-section nil
  887. 'markdown-gfm-block-begin nil
  888. 'markdown-gfm-block-end nil
  889. 'markdown-gfm-code nil
  890. 'markdown-list-item nil
  891. 'markdown-pre nil
  892. 'markdown-blockquote nil
  893. 'markdown-hr nil
  894. 'markdown-comment nil
  895. 'markdown-heading nil
  896. 'markdown-heading-1-setext nil
  897. 'markdown-heading-2-setext nil
  898. 'markdown-heading-1-atx nil
  899. 'markdown-heading-2-atx nil
  900. 'markdown-heading-3-atx nil
  901. 'markdown-heading-4-atx nil
  902. 'markdown-heading-5-atx nil
  903. 'markdown-heading-6-atx nil
  904. 'markdown-metadata-key nil
  905. 'markdown-metadata-value nil
  906. 'markdown-metadata-markup nil)
  907. "Property list of all Markdown syntactic properties.")
  908. (defsubst markdown-in-comment-p (&optional pos)
  909. "Return non-nil if POS is in a comment.
  910. If POS is not given, use point instead."
  911. (get-text-property (or pos (point)) 'markdown-comment))
  912. (defun markdown--face-p (pos faces)
  913. "Return non-nil if face of POS contain FACES."
  914. (let ((face-prop (get-text-property pos 'face)))
  915. (if (listp face-prop)
  916. (cl-loop for face in face-prop
  917. thereis (memq face faces))
  918. (memq face-prop faces))))
  919. (defun markdown-syntax-propertize-extend-region (start end)
  920. "Extend START to END region to include an entire block of text.
  921. This helps improve syntax analysis for block constructs.
  922. Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
  923. Function is called repeatedly until it returns nil. For details, see
  924. `syntax-propertize-extend-region-functions'."
  925. (save-match-data
  926. (save-excursion
  927. (let* ((new-start (progn (goto-char start)
  928. (skip-chars-forward "\n")
  929. (if (re-search-backward "\n\n" nil t)
  930. (min start (match-end 0))
  931. (point-min))))
  932. (new-end (progn (goto-char end)
  933. (skip-chars-backward "\n")
  934. (if (re-search-forward "\n\n" nil t)
  935. (max end (match-beginning 0))
  936. (point-max))))
  937. (code-match (markdown-code-block-at-pos new-start))
  938. (new-start (or (and code-match (cl-first code-match)) new-start))
  939. (code-match (and (< end (point-max)) (markdown-code-block-at-pos end)))
  940. (new-end (or (and code-match (cl-second code-match)) new-end)))
  941. (unless (and (eq new-start start) (eq new-end end))
  942. (cons new-start (min new-end (point-max))))))))
  943. (defun markdown-font-lock-extend-region-function (start end _)
  944. "Used in `jit-lock-after-change-extend-region-functions'.
  945. Delegates to `markdown-syntax-propertize-extend-region'. START
  946. and END are the previous region to refontify."
  947. (let ((res (markdown-syntax-propertize-extend-region start end)))
  948. (when res
  949. ;; syntax-propertize-function is not called when character at
  950. ;; (point-max) is deleted, but font-lock-extend-region-functions
  951. ;; are called. Force a syntax property update in that case.
  952. (when (= end (point-max))
  953. ;; This function is called in a buffer modification hook.
  954. ;; `markdown-syntax-propertize' doesn't save the match data,
  955. ;; so we have to do it here.
  956. (save-match-data
  957. (markdown-syntax-propertize (car res) (cdr res))))
  958. (setq jit-lock-start (car res)
  959. jit-lock-end (cdr res)))))
  960. (defun markdown--cur-list-item-bounds ()
  961. "Return a list describing the list item at point.
  962. Assumes that match data is set for `markdown-regex-list'. See the
  963. documentation for `markdown-cur-list-item-bounds' for the format of
  964. the returned list."
  965. (save-excursion
  966. (let* ((begin (match-beginning 0))
  967. (indent (length (match-string-no-properties 1)))
  968. (nonlist-indent (- (match-end 3) (match-beginning 0)))
  969. (marker (buffer-substring-no-properties
  970. (match-beginning 2) (match-end 3)))
  971. (checkbox (match-string-no-properties 4))
  972. (match (butlast (match-data t)))
  973. (end (markdown-cur-list-item-end nonlist-indent)))
  974. (list begin end indent nonlist-indent marker checkbox match))))
  975. (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds)
  976. "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
  977. Here, MARKER is a string representing the type of list and INDENT
  978. is an integer giving the indentation, in spaces, of the current
  979. block. CUR-BOUNDS is a list of the form returned by
  980. `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
  981. values for parent list items. When BOUNDS is nil, it means we are
  982. at baseline (not inside of a nested list)."
  983. (let ((prev-indent (or (cl-third (car bounds)) 0)))
  984. (cond
  985. ;; New list item at baseline.
  986. ((and marker (null bounds))
  987. (list cur-bounds))
  988. ;; List item with greater indentation (four or more spaces).
  989. ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
  990. ((and marker (>= indent (+ prev-indent markdown-list-indent-width)))
  991. (cons cur-bounds bounds))
  992. ;; List item with greater or equal indentation (less than four spaces).
  993. ;; Keep list level the same by replacing the car of BOUNDS.
  994. ((and marker (>= indent prev-indent))
  995. (cons cur-bounds (cdr bounds)))
  996. ;; Lesser indentation level.
  997. ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
  998. ;; indentation could move back more than one list level). Note
  999. ;; that this block need not be the beginning of list item.
  1000. ((< indent prev-indent)
  1001. (while (and (> (length bounds) 1)
  1002. (setq prev-indent (cl-third (cadr bounds)))
  1003. (< indent (+ prev-indent markdown-list-indent-width)))
  1004. (setq bounds (cdr bounds)))
  1005. (cons cur-bounds bounds))
  1006. ;; Otherwise, do nothing.
  1007. (t bounds))))
  1008. (defun markdown-syntax-propertize-list-items (start end)
  1009. "Propertize list items from START to END.
  1010. Stores nested list item information in the `markdown-list-item'
  1011. text property to make later syntax analysis easier. The value of
  1012. this property is a list with elements of the form (begin . end)
  1013. giving the bounds of the current and parent list items."
  1014. (save-excursion
  1015. (goto-char start)
  1016. (let ((prev-list-line -100)
  1017. bounds level pre-regexp)
  1018. ;; Find a baseline point with zero list indentation
  1019. (markdown-search-backward-baseline)
  1020. ;; Search for all list items between baseline and END
  1021. (while (and (< (point) end)
  1022. (re-search-forward markdown-regex-list end 'limit))
  1023. ;; Level of list nesting
  1024. (setq level (length bounds))
  1025. ;; Pre blocks need to be indented one level past the list level
  1026. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level)))
  1027. (beginning-of-line)
  1028. (cond
  1029. ;; Reset at headings, horizontal rules, and top-level blank lines.
  1030. ;; Propertize baseline when in range.
  1031. ((markdown-new-baseline)
  1032. (setq bounds nil))
  1033. ;; Make sure this is not a line from a pre block
  1034. ((and (looking-at-p pre-regexp)
  1035. ;; too indented line is also treated as list if previous line is list
  1036. (>= (- (line-number-at-pos) prev-list-line) 2)))
  1037. ;; If not, then update levels and propertize list item when in range.
  1038. (t
  1039. (let* ((indent (current-indentation))
  1040. (cur-bounds (markdown--cur-list-item-bounds))
  1041. (first (cl-first cur-bounds))
  1042. (last (cl-second cur-bounds))
  1043. (marker (cl-fifth cur-bounds)))
  1044. (setq bounds (markdown--append-list-item-bounds
  1045. marker indent cur-bounds bounds))
  1046. (when (and (<= start (point)) (<= (point) end))
  1047. (setq prev-list-line (line-number-at-pos first))
  1048. (put-text-property first last 'markdown-list-item bounds)))))
  1049. (end-of-line)))))
  1050. (defun markdown-syntax-propertize-pre-blocks (start end)
  1051. "Match preformatted text blocks from START to END."
  1052. (save-excursion
  1053. (goto-char start)
  1054. (let (finish)
  1055. ;; Use loop for avoiding too many recursive calls
  1056. ;; https://github.com/jrblevin/markdown-mode/issues/512
  1057. (while (not finish)
  1058. (let ((levels (markdown-calculate-list-levels))
  1059. indent pre-regexp close-regexp open close)
  1060. (while (and (< (point) end) (not close))
  1061. ;; Search for a region with sufficient indentation
  1062. (if (null levels)
  1063. (setq indent 1)
  1064. (setq indent (1+ (length levels))))
  1065. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent))
  1066. (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent)))
  1067. (cond
  1068. ;; If not at the beginning of a line, move forward
  1069. ((not (bolp)) (forward-line))
  1070. ;; Move past blank lines
  1071. ((markdown-cur-line-blank-p) (forward-line))
  1072. ;; At headers and horizontal rules, reset levels
  1073. ((markdown-new-baseline) (forward-line) (setq levels nil))
  1074. ;; If the current line has sufficient indentation, mark out pre block
  1075. ;; The opening should be preceded by a blank line.
  1076. ((and (markdown-prev-line-blank) (looking-at pre-regexp))
  1077. (setq open (match-beginning 0))
  1078. (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p))
  1079. (not (eobp)))
  1080. (forward-line))
  1081. (skip-syntax-backward "-")
  1082. (setq close (point)))
  1083. ;; If current line has a list marker, update levels, move to end of block
  1084. ((looking-at markdown-regex-list)
  1085. (setq levels (markdown-update-list-levels
  1086. (match-string 2) (current-indentation) levels))
  1087. (markdown-end-of-text-block))
  1088. ;; If this is the end of the indentation level, adjust levels accordingly.
  1089. ;; Only match end of indentation level if levels is not the empty list.
  1090. ((and (car levels) (looking-at-p close-regexp))
  1091. (setq levels (markdown-update-list-levels
  1092. nil (current-indentation) levels))
  1093. (markdown-end-of-text-block))
  1094. (t (markdown-end-of-text-block))))
  1095. (if (and open close)
  1096. ;; Set text property data and continue to search
  1097. (put-text-property open close 'markdown-pre (list open close))
  1098. (setq finish t))))
  1099. nil)))
  1100. (defconst markdown-fenced-block-pairs
  1101. `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin)
  1102. (markdown-make-tilde-fence-regex markdown-tilde-fence-end)
  1103. markdown-fenced-code)
  1104. ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin)
  1105. (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end)
  1106. markdown-yaml-metadata-section)
  1107. ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin)
  1108. (,markdown-regex-gfm-code-block-close markdown-gfm-block-end)
  1109. markdown-gfm-code))
  1110. "Mapping of regular expressions to \"fenced-block\" constructs.
  1111. These constructs are distinguished by having a distinctive start
  1112. and end pattern, both of which take up an entire line of text,
  1113. but no special pattern to identify text within the fenced
  1114. blocks (unlike blockquotes and indented-code sections).
  1115. Each element within this list takes the form:
  1116. ((START-REGEX-OR-FUN START-PROPERTY)
  1117. (END-REGEX-OR-FUN END-PROPERTY)
  1118. MIDDLE-PROPERTY)
  1119. Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
  1120. function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
  1121. arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
  1122. which is the length of the first group of the START-REGEX-OR-FUN match, which
  1123. can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
  1124. evaluate these into \"real\" regexps.
  1125. The *-PROPERTY elements are the text properties applied to each part of the
  1126. block construct when it is matched using
  1127. `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
  1128. to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
  1129. MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
  1130. `match-data' when the regexp was matched to the text. In the case of
  1131. MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with
  1132. begin and end set to the edges of the \"middle\" text. This makes fontification
  1133. easier.")
  1134. (defun markdown-text-property-at-point (prop)
  1135. (get-text-property (point) prop))
  1136. (defsubst markdown-maybe-funcall-regexp (object &optional arg)
  1137. (cond ((functionp object)
  1138. (if arg (funcall object arg) (funcall object)))
  1139. ((stringp object) object)
  1140. (t (error "Object cannot be turned into regex"))))
  1141. (defsubst markdown-get-start-fence-regexp ()
  1142. "Return regexp to find all \"start\" sections of fenced block constructs.
  1143. Which construct is actually contained in the match must be found separately."
  1144. (mapconcat
  1145. #'identity
  1146. (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry)))
  1147. markdown-fenced-block-pairs)
  1148. "\\|"))
  1149. (defun markdown-get-fenced-block-begin-properties ()
  1150. (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs))
  1151. (defun markdown-get-fenced-block-end-properties ()
  1152. (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs))
  1153. (defun markdown-get-fenced-block-middle-properties ()
  1154. (cl-mapcar #'cl-third markdown-fenced-block-pairs))
  1155. (defun markdown-find-previous-prop (prop &optional lim)
  1156. "Find previous place where property PROP is non-nil, up to LIM.
  1157. Return a cons of (pos . property). pos is point if point contains
  1158. non-nil PROP."
  1159. (let ((res
  1160. (if (get-text-property (point) prop) (point)
  1161. (previous-single-property-change
  1162. (point) prop nil (or lim (point-min))))))
  1163. (when (and (not (get-text-property res prop))
  1164. (> res (point-min))
  1165. (get-text-property (1- res) prop))
  1166. (cl-decf res))
  1167. (when (and res (get-text-property res prop)) (cons res prop))))
  1168. (defun markdown-find-next-prop (prop &optional lim)
  1169. "Find next place where property PROP is non-nil, up to LIM.
  1170. Return a cons of (POS . PROPERTY) where POS is point if point
  1171. contains non-nil PROP."
  1172. (let ((res
  1173. (if (get-text-property (point) prop) (point)
  1174. (next-single-property-change
  1175. (point) prop nil (or lim (point-max))))))
  1176. (when (and res (get-text-property res prop)) (cons res prop))))
  1177. (defun markdown-min-of-seq (map-fn seq)
  1178. "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
  1179. (cl-loop for el in seq
  1180. with min = 1.0e+INF ; infinity
  1181. with min-el = nil
  1182. do (let ((res (funcall map-fn el)))
  1183. (when (< res min)
  1184. (setq min res)
  1185. (setq min-el el)))
  1186. finally return min-el))
  1187. (defun markdown-max-of-seq (map-fn seq)
  1188. "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
  1189. (cl-loop for el in seq
  1190. with max = -1.0e+INF ; negative infinity
  1191. with max-el = nil
  1192. do (let ((res (funcall map-fn el)))
  1193. (when (and res (> res max))
  1194. (setq max res)
  1195. (setq max-el el)))
  1196. finally return max-el))
  1197. (defun markdown-find-previous-block ()
  1198. "Find previous block.
  1199. Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
  1200. unable to propertize the entire block, but was able to propertize the beginning
  1201. of the block. If so, return a cons of (pos . property) where the beginning of
  1202. the block was propertized."
  1203. (let ((start-pt (point))
  1204. (closest-open
  1205. (markdown-max-of-seq
  1206. #'car
  1207. (cl-remove-if
  1208. #'null
  1209. (cl-mapcar
  1210. #'markdown-find-previous-prop
  1211. (markdown-get-fenced-block-begin-properties))))))
  1212. (when closest-open
  1213. (let* ((length-of-open-match
  1214. (let ((match-d
  1215. (get-text-property (car closest-open) (cdr closest-open))))
  1216. (- (cl-fourth match-d) (cl-third match-d))))
  1217. (end-regexp
  1218. (markdown-maybe-funcall-regexp
  1219. (cl-caadr
  1220. (cl-find-if
  1221. (lambda (entry) (eq (cl-cadar entry) (cdr closest-open)))
  1222. markdown-fenced-block-pairs))
  1223. length-of-open-match))
  1224. (end-prop-loc
  1225. (save-excursion
  1226. (save-match-data
  1227. (goto-char (car closest-open))
  1228. (and (re-search-forward end-regexp start-pt t)
  1229. (match-beginning 0))))))
  1230. (and (not end-prop-loc) closest-open)))))
  1231. (defun markdown-get-fenced-block-from-start (prop)
  1232. "Return limits of an enclosing fenced block from its start, using PROP.
  1233. Return value is a list usable as `match-data'."
  1234. (catch 'no-rest-of-block
  1235. (let* ((correct-entry
  1236. (cl-find-if
  1237. (lambda (entry) (eq (cl-cadar entry) prop))
  1238. markdown-fenced-block-pairs))
  1239. (begin-of-begin (cl-first (markdown-text-property-at-point prop)))
  1240. (middle-prop (cl-third correct-entry))
  1241. (end-prop (cl-cadadr correct-entry))
  1242. (end-of-end
  1243. (save-excursion
  1244. (goto-char (match-end 0)) ; end of begin
  1245. (unless (eobp) (forward-char))
  1246. (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
  1247. (if (not mid-prop-v) ; no middle
  1248. (progn
  1249. ;; try to find end by advancing one
  1250. (let ((end-prop-v
  1251. (markdown-text-property-at-point end-prop)))
  1252. (if end-prop-v (cl-second end-prop-v)
  1253. (throw 'no-rest-of-block nil))))
  1254. (set-match-data mid-prop-v)
  1255. (goto-char (match-end 0)) ; end of middle
  1256. (beginning-of-line) ; into end
  1257. (cl-second (markdown-text-property-at-point end-prop)))))))
  1258. (list begin-of-begin end-of-end))))
  1259. (defun markdown-get-fenced-block-from-middle (prop)
  1260. "Return limits of an enclosing fenced block from its middle, using PROP.
  1261. Return value is a list usable as `match-data'."
  1262. (let* ((correct-entry
  1263. (cl-find-if
  1264. (lambda (entry) (eq (cl-third entry) prop))
  1265. markdown-fenced-block-pairs))
  1266. (begin-prop (cl-cadar correct-entry))
  1267. (begin-of-begin
  1268. (save-excursion
  1269. (goto-char (match-beginning 0))
  1270. (unless (bobp) (forward-line -1))
  1271. (beginning-of-line)
  1272. (cl-first (markdown-text-property-at-point begin-prop))))
  1273. (end-prop (cl-cadadr correct-entry))
  1274. (end-of-end
  1275. (save-excursion
  1276. (goto-char (match-end 0))
  1277. (beginning-of-line)
  1278. (cl-second (markdown-text-property-at-point end-prop)))))
  1279. (list begin-of-begin end-of-end)))
  1280. (defun markdown-get-fenced-block-from-end (prop)
  1281. "Return limits of an enclosing fenced block from its end, using PROP.
  1282. Return value is a list usable as `match-data'."
  1283. (let* ((correct-entry
  1284. (cl-find-if
  1285. (lambda (entry) (eq (cl-cadadr entry) prop))
  1286. markdown-fenced-block-pairs))
  1287. (end-of-end (cl-second (markdown-text-property-at-point prop)))
  1288. (middle-prop (cl-third correct-entry))
  1289. (begin-prop (cl-cadar correct-entry))
  1290. (begin-of-begin
  1291. (save-excursion
  1292. (goto-char (match-beginning 0)) ; beginning of end
  1293. (unless (bobp) (backward-char)) ; into middle
  1294. (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
  1295. (if (not mid-prop-v)
  1296. (progn
  1297. (beginning-of-line)
  1298. (cl-first (markdown-text-property-at-point begin-prop)))
  1299. (set-match-data mid-prop-v)
  1300. (goto-char (match-beginning 0)) ; beginning of middle
  1301. (unless (bobp) (forward-line -1)) ; into beginning
  1302. (beginning-of-line)
  1303. (cl-first (markdown-text-property-at-point begin-prop)))))))
  1304. (list begin-of-begin end-of-end)))
  1305. (defun markdown-get-enclosing-fenced-block-construct (&optional pos)
  1306. "Get \"fake\" match data for block enclosing POS.
  1307. Returns fake match data which encloses the start, middle, and end
  1308. of the block construct enclosing POS, if it exists. Used in
  1309. `markdown-code-block-at-pos'."
  1310. (save-excursion
  1311. (when pos (goto-char pos))
  1312. (beginning-of-line)
  1313. (car
  1314. (cl-remove-if
  1315. #'null
  1316. (cl-mapcar
  1317. (lambda (fun-and-prop)
  1318. (cl-destructuring-bind (fun prop) fun-and-prop
  1319. (when prop
  1320. (save-match-data
  1321. (set-match-data (markdown-text-property-at-point prop))
  1322. (funcall fun prop)))))
  1323. `((markdown-get-fenced-block-from-start
  1324. ,(cl-find-if
  1325. #'markdown-text-property-at-point
  1326. (markdown-get-fenced-block-begin-properties)))
  1327. (markdown-get-fenced-block-from-middle
  1328. ,(cl-find-if
  1329. #'markdown-text-property-at-point
  1330. (markdown-get-fenced-block-middle-properties)))
  1331. (markdown-get-fenced-block-from-end
  1332. ,(cl-find-if
  1333. #'markdown-text-property-at-point
  1334. (markdown-get-fenced-block-end-properties)))))))))
  1335. (defun markdown-propertize-end-match (reg end fence-spec middle-begin)
  1336. "Get match for REG up to END, if exists, and propertize appropriately.
  1337. FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
  1338. MIDDLE-BEGIN is the start of the \"middle\" section of the block."
  1339. (when (re-search-forward reg end t)
  1340. (let ((close-begin (match-beginning 0)) ; Start of closing line.
  1341. (close-end (match-end 0)) ; End of closing line.
  1342. (close-data (match-data t))) ; Match data for closing line.
  1343. ;; Propertize middle section of fenced block.
  1344. (put-text-property middle-begin close-begin
  1345. (cl-third fence-spec)
  1346. (list middle-begin close-begin))
  1347. ;; If the block is a YAML block, propertize the declarations inside
  1348. (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)
  1349. ;; Propertize closing line of fenced block.
  1350. (put-text-property close-begin close-end
  1351. (cl-cadadr fence-spec) close-data))))
  1352. (defun markdown-syntax-propertize-fenced-block-constructs (start end)
  1353. "Propertize according to `markdown-fenced-block-pairs' from START to END.
  1354. If unable to propertize an entire block (if the start of a block is within START
  1355. and END, but the end of the block is not), propertize the start section of a
  1356. block, then in a subsequent call propertize both middle and end by finding the
  1357. start which was previously propertized."
  1358. (let ((start-reg (markdown-get-start-fence-regexp)))
  1359. (save-excursion
  1360. (goto-char start)
  1361. ;; start from previous unclosed block, if exists
  1362. (let ((prev-begin-block (markdown-find-previous-block)))
  1363. (when prev-begin-block
  1364. (let* ((correct-entry
  1365. (cl-find-if (lambda (entry)
  1366. (eq (cdr prev-begin-block) (cl-cadar entry)))
  1367. markdown-fenced-block-pairs))
  1368. (enclosed-text-start (1+ (car prev-begin-block)))
  1369. (start-length
  1370. (save-excursion
  1371. (goto-char (car prev-begin-block))
  1372. (string-match
  1373. (markdown-maybe-funcall-regexp
  1374. (caar correct-entry))
  1375. (buffer-substring
  1376. (point-at-bol) (point-at-eol)))
  1377. (- (match-end 1) (match-beginning 1))))
  1378. (end-reg (markdown-maybe-funcall-regexp
  1379. (cl-caadr correct-entry) start-length)))
  1380. (markdown-propertize-end-match
  1381. end-reg end correct-entry enclosed-text-start))))
  1382. ;; find all new blocks within region
  1383. (while (re-search-forward start-reg end t)
  1384. ;; we assume the opening constructs take up (only) an entire line,
  1385. ;; so we re-check the current line
  1386. (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol)))
  1387. ;; find entry in `markdown-fenced-block-pairs' corresponding
  1388. ;; to regex which was matched
  1389. (correct-entry
  1390. (cl-find-if
  1391. (lambda (fenced-pair)
  1392. (string-match-p
  1393. (markdown-maybe-funcall-regexp (caar fenced-pair))
  1394. cur-line))
  1395. markdown-fenced-block-pairs))
  1396. (enclosed-text-start
  1397. (save-excursion (1+ (point-at-eol))))
  1398. (end-reg
  1399. (markdown-maybe-funcall-regexp
  1400. (cl-caadr correct-entry)
  1401. (if (and (match-beginning 1) (match-end 1))
  1402. (- (match-end 1) (match-beginning 1))
  1403. 0))))
  1404. ;; get correct match data
  1405. (save-excursion
  1406. (beginning-of-line)
  1407. (re-search-forward
  1408. (markdown-maybe-funcall-regexp (caar correct-entry))
  1409. (point-at-eol)))
  1410. ;; mark starting, even if ending is outside of region
  1411. (put-text-property (match-beginning 0) (match-end 0)
  1412. (cl-cadar correct-entry) (match-data t))
  1413. (markdown-propertize-end-match
  1414. end-reg end correct-entry enclosed-text-start))))))
  1415. (defun markdown-syntax-propertize-blockquotes (start end)
  1416. "Match blockquotes from START to END."
  1417. (save-excursion
  1418. (goto-char start)
  1419. (while (and (re-search-forward markdown-regex-blockquote end t)
  1420. (not (markdown-code-block-at-pos (match-beginning 0))))
  1421. (put-text-property (match-beginning 0) (match-end 0)
  1422. 'markdown-blockquote
  1423. (match-data t)))))
  1424. (defun markdown-syntax-propertize-hrs (start end)
  1425. "Match horizontal rules from START to END."
  1426. (save-excursion
  1427. (goto-char start)
  1428. (while (re-search-forward markdown-regex-hr end t)
  1429. (let ((beg (match-beginning 0))
  1430. (end (match-end 0)))
  1431. (goto-char beg)
  1432. (unless (or (markdown-on-heading-p)
  1433. (markdown-code-block-at-point-p))
  1434. (put-text-property beg end 'markdown-hr (match-data t)))
  1435. (goto-char end)))))
  1436. (defun markdown-syntax-propertize-yaml-metadata (start end)
  1437. "Propertize elements inside YAML metadata blocks from START to END.
  1438. Assumes region from START and END is already known to be the interior
  1439. region of a YAML metadata block as propertized by
  1440. `markdown-syntax-propertize-fenced-block-constructs'."
  1441. (save-excursion
  1442. (goto-char start)
  1443. (cl-loop
  1444. while (re-search-forward markdown-regex-declarative-metadata end t)
  1445. do (progn
  1446. (put-text-property (match-beginning 1) (match-end 1)
  1447. 'markdown-metadata-key (match-data t))
  1448. (put-text-property (match-beginning 2) (match-end 2)
  1449. 'markdown-metadata-markup (match-data t))
  1450. (put-text-property (match-beginning 3) (match-end 3)
  1451. 'markdown-metadata-value (match-data t))))))
  1452. (defun markdown-syntax-propertize-headings (start end)
  1453. "Match headings of type SYMBOL with REGEX from START to END."
  1454. (goto-char start)
  1455. (while (re-search-forward markdown-regex-header end t)
  1456. (unless (markdown-code-block-at-pos (match-beginning 0))
  1457. (put-text-property
  1458. (match-beginning 0) (match-end 0) 'markdown-heading
  1459. (match-data t))
  1460. (put-text-property
  1461. (match-beginning 0) (match-end 0)
  1462. (cond ((match-string-no-properties 2) 'markdown-heading-1-setext)
  1463. ((match-string-no-properties 3) 'markdown-heading-2-setext)
  1464. (t (let ((atx-level (length (markdown-trim-whitespace
  1465. (match-string-no-properties 4)))))
  1466. (intern (format "markdown-heading-%d-atx" atx-level)))))
  1467. (match-data t)))))
  1468. (defun markdown-syntax-propertize-comments (start end)
  1469. "Match HTML comments from the START to END."
  1470. ;; Implement by loop instead of recursive call for avoiding
  1471. ;; exceed max-lisp-eval-depth issue
  1472. ;; https://github.com/jrblevin/markdown-mode/issues/536
  1473. (let (finish)
  1474. (goto-char start)
  1475. (while (not finish)
  1476. (let* ((in-comment (nth 4 (syntax-ppss)))
  1477. (comment-begin (nth 8 (syntax-ppss))))
  1478. (cond
  1479. ;; Comment start
  1480. ((and (not in-comment)
  1481. (re-search-forward markdown-regex-comment-start end t)
  1482. (not (markdown-inline-code-at-point-p))
  1483. (not (markdown-code-block-at-point-p)))
  1484. (let ((open-beg (match-beginning 0)))
  1485. (put-text-property open-beg (1+ open-beg)
  1486. 'syntax-table (string-to-syntax "<"))
  1487. (goto-char (min (1+ (match-end 0)) end (point-max)))))
  1488. ;; Comment end
  1489. ((and in-comment comment-begin
  1490. (re-search-forward markdown-regex-comment-end end t))
  1491. (let ((comment-end (match-end 0)))
  1492. (put-text-property (1- comment-end) comment-end
  1493. 'syntax-table (string-to-syntax ">"))
  1494. ;; Remove any other text properties inside the comment
  1495. (remove-text-properties comment-begin comment-end
  1496. markdown--syntax-properties)
  1497. (put-text-property comment-begin comment-end
  1498. 'markdown-comment (list comment-begin comment-end))
  1499. (goto-char (min comment-end end (point-max)))))
  1500. ;; Nothing found
  1501. (t (setq finish t)))))
  1502. nil))
  1503. (defun markdown-syntax-propertize (start end)
  1504. "Function used as `syntax-propertize-function'.
  1505. START and END delimit region to propertize."
  1506. (with-silent-modifications
  1507. (save-excursion
  1508. (remove-text-properties start end markdown--syntax-properties)
  1509. (markdown-syntax-propertize-fenced-block-constructs start end)
  1510. (markdown-syntax-propertize-list-items start end)
  1511. (markdown-syntax-propertize-pre-blocks start end)
  1512. (markdown-syntax-propertize-blockquotes start end)
  1513. (markdown-syntax-propertize-headings start end)
  1514. (markdown-syntax-propertize-hrs start end)
  1515. (markdown-syntax-propertize-comments start end))))
  1516. ;;; Markup Hiding =============================================================
  1517. (defconst markdown-markup-properties
  1518. '(face markdown-markup-face invisible markdown-markup)
  1519. "List of properties and values to apply to markup.")
  1520. (defconst markdown-language-keyword-properties
  1521. '(face markdown-language-keyword-face invisible markdown-markup)
  1522. "List of properties and values to apply to code block language names.")
  1523. (defconst markdown-language-info-properties
  1524. '(face markdown-language-info-face invisible markdown-markup)
  1525. "List of properties and values to apply to code block language info strings.")
  1526. (defconst markdown-include-title-properties
  1527. '(face markdown-link-title-face invisible markdown-markup)
  1528. "List of properties and values to apply to included code titles.")
  1529. (defcustom markdown-hide-markup nil
  1530. "Determines whether markup in the buffer will be hidden.
  1531. When set to nil, all markup is displayed in the buffer as it
  1532. appears in the file. An exception is when `markdown-hide-urls'
  1533. is non-nil.
  1534. Set this to a non-nil value to turn this feature on by default.
  1535. You can interactively toggle the value of this variable with
  1536. `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
  1537. or from the Markdown > Show & Hide menu.
  1538. Markup hiding works by adding text properties to positions in the
  1539. buffer---either the `invisible' property or the `display' property
  1540. in cases where alternative glyphs are used (e.g., list bullets).
  1541. This does not, however, affect printing or other output.
  1542. Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
  1543. not honor these text properties. For printing, it would be better
  1544. to first convert to HTML or PDF (e.g,. using Pandoc)."
  1545. :group 'markdown
  1546. :type 'boolean
  1547. :safe 'booleanp
  1548. :package-version '(markdown-mode . "2.3"))
  1549. (make-variable-buffer-local 'markdown-hide-markup)
  1550. (defun markdown-toggle-markup-hiding (&optional arg)
  1551. "Toggle the display or hiding of markup.
  1552. With a prefix argument ARG, enable markup hiding if ARG is positive,
  1553. and disable it otherwise.
  1554. See `markdown-hide-markup' for additional details."
  1555. (interactive (list (or current-prefix-arg 'toggle)))
  1556. (setq markdown-hide-markup
  1557. (if (eq arg 'toggle)
  1558. (not markdown-hide-markup)
  1559. (> (prefix-numeric-value arg) 0)))
  1560. (if markdown-hide-markup
  1561. (progn (add-to-invisibility-spec 'markdown-markup)
  1562. (message "markdown-mode markup hiding enabled"))
  1563. (progn (remove-from-invisibility-spec 'markdown-markup)
  1564. (message "markdown-mode markup hiding disabled")))
  1565. (markdown-reload-extensions))
  1566. ;;; Font Lock =================================================================
  1567. (require 'font-lock)
  1568. (defgroup markdown-faces nil
  1569. "Faces used in Markdown Mode."
  1570. :group 'markdown
  1571. :group 'faces)
  1572. (defface markdown-italic-face
  1573. '((t (:inherit italic)))
  1574. "Face for italic text."
  1575. :group 'markdown-faces)
  1576. (defface markdown-bold-face
  1577. '((t (:inherit bold)))
  1578. "Face for bold text."
  1579. :group 'markdown-faces)
  1580. (defface markdown-strike-through-face
  1581. '((t (:strike-through t)))
  1582. "Face for strike-through text."
  1583. :group 'markdown-faces)
  1584. (defface markdown-markup-face
  1585. '((t (:inherit shadow :slant normal :weight normal)))
  1586. "Face for markup elements."
  1587. :group 'markdown-faces)
  1588. (defface markdown-header-rule-face
  1589. '((t (:inherit markdown-markup-face)))
  1590. "Base face for headers rules."
  1591. :group 'markdown-faces)
  1592. (defface markdown-header-delimiter-face
  1593. '((t (:inherit markdown-markup-face)))
  1594. "Base face for headers hash delimiter."
  1595. :group 'markdown-faces)
  1596. (defface markdown-list-face
  1597. '((t (:inherit markdown-markup-face)))
  1598. "Face for list item markers."
  1599. :group 'markdown-faces)
  1600. (defface markdown-blockquote-face
  1601. '((t (:inherit font-lock-doc-face)))
  1602. "Face for blockquote sections."
  1603. :group 'markdown-faces)
  1604. (defface markdown-code-face
  1605. '((t (:inherit fixed-pitch)))
  1606. "Face for inline code, pre blocks, and fenced code blocks.
  1607. This may be used, for example, to add a contrasting background to
  1608. inline code fragments and code blocks."
  1609. :group 'markdown-faces)
  1610. (defface markdown-inline-code-face
  1611. '((t (:inherit (markdown-code-face font-lock-constant-face))))
  1612. "Face for inline code."
  1613. :group 'markdown-faces)
  1614. (defface markdown-pre-face
  1615. '((t (:inherit (markdown-code-face font-lock-constant-face))))
  1616. "Face for preformatted text."
  1617. :group 'markdown-faces)
  1618. (defface markdown-table-face
  1619. '((t (:inherit (markdown-code-face))))
  1620. "Face for tables."
  1621. :group 'markdown-faces)
  1622. (defface markdown-language-keyword-face
  1623. '((t (:inherit font-lock-type-face)))
  1624. "Face for programming language identifiers."
  1625. :group 'markdown-faces)
  1626. (defface markdown-language-info-face
  1627. '((t (:inherit font-lock-string-face)))
  1628. "Face for programming language info strings."
  1629. :group 'markdown-faces)
  1630. (defface markdown-link-face
  1631. '((t (:inherit link)))
  1632. "Face for links."
  1633. :group 'markdown-faces)
  1634. (defface markdown-missing-link-face
  1635. '((t (:inherit font-lock-warning-face)))
  1636. "Face for missing links."
  1637. :group 'markdown-faces)
  1638. (defface markdown-reference-face
  1639. '((t (:inherit markdown-markup-face)))
  1640. "Face for link references."
  1641. :group 'markdown-faces)
  1642. (defface markdown-footnote-marker-face
  1643. '((t (:inherit markdown-markup-face)))
  1644. "Face for footnote markers."
  1645. :group 'markdown-faces)
  1646. (defface markdown-footnote-text-face
  1647. '((t (:inherit font-lock-comment-face)))
  1648. "Face for footnote text."
  1649. :group 'markdown-faces)
  1650. (defface markdown-url-face
  1651. '((t (:inherit font-lock-string-face)))
  1652. "Face for URLs that are part of markup.
  1653. For example, this applies to URLs in inline links:
  1654. [link text](http://example.com/)."
  1655. :group 'markdown-faces)
  1656. (defface markdown-plain-url-face
  1657. '((t (:inherit markdown-link-face)))
  1658. "Face for URLs that are also links.
  1659. For example, this applies to plain angle bracket URLs:
  1660. <http://example.com/>."
  1661. :group 'markdown-faces)
  1662. (defface markdown-link-title-face
  1663. '((t (:inherit font-lock-comment-face)))
  1664. "Face for reference link titles."
  1665. :group 'markdown-faces)
  1666. (defface markdown-line-break-face
  1667. '((t (:inherit font-lock-constant-face :underline t)))
  1668. "Face for hard line breaks."
  1669. :group 'markdown-faces)
  1670. (defface markdown-comment-face
  1671. '((t (:inherit font-lock-comment-face)))
  1672. "Face for HTML comments."
  1673. :group 'markdown-faces)
  1674. (defface markdown-math-face
  1675. '((t (:inherit font-lock-string-face)))
  1676. "Face for LaTeX expressions."
  1677. :group 'markdown-faces)
  1678. (defface markdown-metadata-key-face
  1679. '((t (:inherit font-lock-variable-name-face)))
  1680. "Face for metadata keys."
  1681. :group 'markdown-faces)
  1682. (defface markdown-metadata-value-face
  1683. '((t (:inherit font-lock-string-face)))
  1684. "Face for metadata values."
  1685. :group 'markdown-faces)
  1686. (defface markdown-gfm-checkbox-face
  1687. '((t (:inherit font-lock-builtin-face)))
  1688. "Face for GFM checkboxes."
  1689. :group 'markdown-faces)
  1690. (defface markdown-highlight-face
  1691. '((t (:inherit highlight)))
  1692. "Face for mouse highlighting."
  1693. :group 'markdown-faces)
  1694. (defface markdown-hr-face
  1695. '((t (:inherit markdown-markup-face)))
  1696. "Face for horizontal rules."
  1697. :group 'markdown-faces)
  1698. (defface markdown-html-tag-name-face
  1699. '((t (:inherit font-lock-type-face)))
  1700. "Face for HTML tag names."
  1701. :group 'markdown-faces)
  1702. (defface markdown-html-tag-delimiter-face
  1703. '((t (:inherit markdown-markup-face)))
  1704. "Face for HTML tag delimiters."
  1705. :group 'markdown-faces)
  1706. (defface markdown-html-attr-name-face
  1707. '((t (:inherit font-lock-variable-name-face)))
  1708. "Face for HTML attribute names."
  1709. :group 'markdown-faces)
  1710. (defface markdown-html-attr-value-face
  1711. '((t (:inherit font-lock-string-face)))
  1712. "Face for HTML attribute values."
  1713. :group 'markdown-faces)
  1714. (defface markdown-html-entity-face
  1715. '((t (:inherit font-lock-variable-name-face)))
  1716. "Face for HTML entities."
  1717. :group 'markdown-faces)
  1718. (defcustom markdown-header-scaling nil
  1719. "Whether to use variable-height faces for headers.
  1720. When non-nil, `markdown-header-face' will inherit from
  1721. `variable-pitch' and the scaling values in
  1722. `markdown-header-scaling-values' will be applied to
  1723. headers of levels one through six respectively."
  1724. :type 'boolean
  1725. :initialize 'custom-initialize-default
  1726. :set (lambda (symbol value)
  1727. (set-default symbol value)
  1728. (markdown-update-header-faces value))
  1729. :group 'markdown-faces
  1730. :package-version '(markdown-mode . "2.2"))
  1731. (defcustom markdown-header-scaling-values
  1732. '(2.0 1.7 1.4 1.1 1.0 1.0)
  1733. "List of scaling values for headers of level one through six.
  1734. Used when `markdown-header-scaling' is non-nil."
  1735. :type 'list
  1736. :initialize 'custom-initialize-default
  1737. :set (lambda (symbol value)
  1738. (set-default symbol value)
  1739. (markdown-update-header-faces markdown-header-scaling value))
  1740. :group 'markdown-faces)
  1741. (defun markdown-make-header-faces ()
  1742. "Build the faces used for Markdown headers."
  1743. (let ((inherit-faces '(font-lock-function-name-face)))
  1744. (when markdown-header-scaling
  1745. (setq inherit-faces (cons 'variable-pitch inherit-faces)))
  1746. (defface markdown-header-face
  1747. `((t (:inherit ,inherit-faces :weight bold)))
  1748. "Base face for headers."
  1749. :group 'markdown-faces))
  1750. (dotimes (num 6)
  1751. (let* ((num1 (1+ num))
  1752. (face-name (intern (format "markdown-header-face-%s" num1)))
  1753. (scale (if markdown-header-scaling
  1754. (float (nth num markdown-header-scaling-values))
  1755. 1.0)))
  1756. (eval
  1757. `(defface ,face-name
  1758. '((t (:inherit markdown-header-face :height ,scale)))
  1759. (format "Face for level %s headers.
  1760. You probably don't want to customize this face directly. Instead
  1761. you can customize the base face `markdown-header-face' or the
  1762. variable-height variable `markdown-header-scaling'." ,num1)
  1763. :group 'markdown-faces)))))
  1764. (markdown-make-header-faces)
  1765. (defun markdown-update-header-faces (&optional scaling scaling-values)
  1766. "Update header faces, depending on if header SCALING is desired.
  1767. If so, use given list of SCALING-VALUES relative to the baseline
  1768. size of `markdown-header-face'."
  1769. (dotimes (num 6)
  1770. (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num))))
  1771. (scale (cond ((not scaling) 1.0)
  1772. (scaling-values (float (nth num scaling-values)))
  1773. (t (float (nth num markdown-header-scaling-values))))))
  1774. (unless (get face-name 'saved-face) ; Don't update customized faces
  1775. (set-face-attribute face-name nil :height scale)))))
  1776. (defun markdown-syntactic-face (state)
  1777. "Return font-lock face for characters with given STATE.
  1778. See `font-lock-syntactic-face-function' for details."
  1779. (let ((in-comment (nth 4 state)))
  1780. (cond
  1781. (in-comment 'markdown-comment-face)
  1782. (t nil))))
  1783. (defcustom markdown-list-item-bullets
  1784. '("" "" "" "" "" "" "")
  1785. "List of bullets to use for unordered lists.
  1786. It can contain any number of symbols, which will be repeated.
  1787. Depending on your font, some reasonable choices are:
  1788. ."
  1789. :group 'markdown
  1790. :type '(repeat (string :tag "Bullet character"))
  1791. :package-version '(markdown-mode . "2.3"))
  1792. (defun markdown--footnote-marker-properties ()
  1793. "Return a font-lock facespec expression for footnote marker text."
  1794. `(face markdown-footnote-marker-face
  1795. ,@(when markdown-hide-markup
  1796. `(display ,markdown-footnote-display))))
  1797. (defun markdown--pandoc-inline-footnote-properties ()
  1798. "Return a font-lock facespec expression for Pandoc inline footnote text."
  1799. `(face markdown-footnote-text-face
  1800. ,@(when markdown-hide-markup
  1801. `(display ,markdown-footnote-display))))
  1802. (defvar markdown-mode-font-lock-keywords
  1803. `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face)))
  1804. (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face)))
  1805. (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face)
  1806. (2 'markdown-markup-face)
  1807. (3 'markdown-metadata-value-face)))
  1808. (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties)
  1809. (2 markdown-markup-properties nil t)
  1810. (3 markdown-language-keyword-properties nil t)
  1811. (4 markdown-language-info-properties nil t)
  1812. (5 markdown-markup-properties nil t)))
  1813. (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties)))
  1814. (markdown-fontify-gfm-code-blocks)
  1815. (markdown-fontify-tables)
  1816. (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties)
  1817. (2 markdown-markup-properties nil t)
  1818. (3 markdown-language-keyword-properties nil t)
  1819. (4 markdown-language-info-properties nil t)
  1820. (5 markdown-markup-properties nil t)))
  1821. (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties)))
  1822. (markdown-fontify-fenced-code-blocks)
  1823. (markdown-match-pre-blocks . ((0 'markdown-pre-face)))
  1824. (markdown-fontify-headings)
  1825. (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face)
  1826. (2 'markdown-markup-face)
  1827. (3 'markdown-metadata-value-face)))
  1828. (markdown-match-pandoc-metadata . ((1 'markdown-markup-face)
  1829. (2 'markdown-markup-face)
  1830. (3 'markdown-metadata-value-face)))
  1831. (markdown-fontify-hrs)
  1832. (markdown-match-code . ((1 markdown-markup-properties prepend)
  1833. (2 'markdown-inline-code-face prepend)
  1834. (3 markdown-markup-properties prepend)))
  1835. (,markdown-regex-kbd . ((1 markdown-markup-properties)
  1836. (2 'markdown-inline-code-face)
  1837. (3 markdown-markup-properties)))
  1838. (markdown-fontify-angle-uris)
  1839. (,markdown-regex-email . 'markdown-plain-url-face)
  1840. (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t)
  1841. (2 'markdown-html-tag-name-face t)
  1842. (3 'markdown-html-tag-delimiter-face t)
  1843. ;; Anchored matcher for HTML tag attributes
  1844. (,markdown-regex-html-attr
  1845. ;; Before searching, move past tag
  1846. ;; name; set limit at tag close.
  1847. (progn
  1848. (goto-char (match-end 2)) (match-end 3))
  1849. nil
  1850. . ((1 'markdown-html-attr-name-face)
  1851. (3 'markdown-html-tag-delimiter-face nil t)
  1852. (4 'markdown-html-attr-value-face nil t)))))
  1853. (,markdown-regex-html-entity . 'markdown-html-entity-face)
  1854. (markdown-fontify-list-items)
  1855. (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^
  1856. (2 (markdown--footnote-marker-properties)) ; label
  1857. (3 markdown-markup-properties))) ; ]
  1858. (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^
  1859. (2 markdown-markup-properties) ; [
  1860. (3 (markdown--pandoc-inline-footnote-properties)) ; text
  1861. (4 markdown-markup-properties))) ; ]
  1862. (markdown-match-includes . ((1 markdown-markup-properties)
  1863. (2 markdown-markup-properties nil t)
  1864. (3 markdown-include-title-properties nil t)
  1865. (4 markdown-markup-properties nil t)
  1866. (5 markdown-markup-properties)
  1867. (6 'markdown-url-face)
  1868. (7 markdown-markup-properties)))
  1869. (markdown-fontify-inline-links)
  1870. (markdown-fontify-reference-links)
  1871. (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [
  1872. (2 'markdown-reference-face) ; label
  1873. (3 'markdown-markup-face) ; ]
  1874. (4 'markdown-markup-face) ; :
  1875. (5 'markdown-url-face) ; url
  1876. (6 'markdown-link-title-face))) ; "title" (optional)
  1877. (markdown-fontify-plain-uris)
  1878. ;; Math mode $..$
  1879. (markdown-match-math-single . ((1 'markdown-markup-face prepend)
  1880. (2 'markdown-math-face append)
  1881. (3 'markdown-markup-face prepend)))
  1882. ;; Math mode $$..$$
  1883. (markdown-match-math-double . ((1 'markdown-markup-face prepend)
  1884. (2 'markdown-math-face append)
  1885. (3 'markdown-markup-face prepend)))
  1886. ;; Math mode \[..\] and \\[..\\]
  1887. (markdown-match-math-display . ((1 'markdown-markup-face prepend)
  1888. (3 'markdown-math-face append)
  1889. (4 'markdown-markup-face prepend)))
  1890. (markdown-match-bold . ((1 markdown-markup-properties prepend)
  1891. (2 'markdown-bold-face append)
  1892. (3 markdown-markup-properties prepend)))
  1893. (markdown-match-italic . ((1 markdown-markup-properties prepend)
  1894. (2 'markdown-italic-face append)
  1895. (3 markdown-markup-properties prepend)))
  1896. (,markdown-regex-strike-through . ((3 markdown-markup-properties)
  1897. (4 'markdown-strike-through-face)
  1898. (5 markdown-markup-properties)))
  1899. (,markdown-regex-line-break . (1 'markdown-line-break-face prepend))
  1900. (markdown-fontify-sub-superscripts)
  1901. (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend)))
  1902. (markdown-match-leanpub-sections . ((0 markdown-markup-properties)))
  1903. (markdown-fontify-blockquotes)
  1904. (markdown-match-wiki-link . ((0 'markdown-link-face prepend))))
  1905. "Syntax highlighting for Markdown files.")
  1906. ;; Footnotes
  1907. (defvar-local markdown-footnote-counter 0
  1908. "Counter for footnote numbers.")
  1909. (defconst markdown-footnote-chars
  1910. "[[:alnum:]-]"
  1911. "Regular expression matching any character for a footnote identifier.")
  1912. (defconst markdown-regex-footnote-definition
  1913. (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)")
  1914. "Regular expression matching a footnote definition, capturing the label.")
  1915. ;;; Compatibility =============================================================
  1916. (defun markdown-flyspell-check-word-p ()
  1917. "Return t if `flyspell' should check word just before point.
  1918. Used for `flyspell-generic-check-word-predicate'."
  1919. (save-excursion
  1920. (goto-char (1- (point)))
  1921. ;; https://github.com/jrblevin/markdown-mode/issues/560
  1922. ;; enable spell check YAML meta data
  1923. (if (or (and (markdown-code-block-at-point-p)
  1924. (not (markdown-text-property-at-point 'markdown-yaml-metadata-section)))
  1925. (markdown-inline-code-at-point-p)
  1926. (markdown-in-comment-p)
  1927. (markdown--face-p (point) '(markdown-reference-face
  1928. markdown-markup-face
  1929. markdown-plain-url-face
  1930. markdown-inline-code-face
  1931. markdown-url-face)))
  1932. (prog1 nil
  1933. ;; If flyspell overlay is put, then remove it
  1934. (let ((bounds (bounds-of-thing-at-point 'word)))
  1935. (when bounds
  1936. (cl-loop for ov in (overlays-in (car bounds) (cdr bounds))
  1937. when (overlay-get ov 'flyspell-overlay)
  1938. do
  1939. (delete-overlay ov)))))
  1940. t)))
  1941. ;;; Markdown Parsing Functions ================================================
  1942. (defun markdown-cur-line-blank-p ()
  1943. "Return t if the current line is blank and nil otherwise."
  1944. (save-excursion
  1945. (beginning-of-line)
  1946. (looking-at-p markdown-regex-blank-line)))
  1947. (defun markdown-prev-line-blank ()
  1948. "Return t if the previous line is blank and nil otherwise.
  1949. If we are at the first line, then consider the previous line to be blank."
  1950. (or (= (line-beginning-position) (point-min))
  1951. (save-excursion
  1952. (forward-line -1)
  1953. (looking-at markdown-regex-blank-line))))
  1954. (defun markdown-prev-line-blank-p ()
  1955. "Like `markdown-prev-line-blank', but preserve `match-data'."
  1956. (save-match-data (markdown-prev-line-blank)))
  1957. (defun markdown-next-line-blank-p ()
  1958. "Return t if the next line is blank and nil otherwise.
  1959. If we are at the last line, then consider the next line to be blank."
  1960. (or (= (line-end-position) (point-max))
  1961. (save-excursion
  1962. (forward-line 1)
  1963. (markdown-cur-line-blank-p))))
  1964. (defun markdown-prev-line-indent ()
  1965. "Return the number of leading whitespace characters in the previous line.
  1966. Return 0 if the current line is the first line in the buffer."
  1967. (save-excursion
  1968. (if (= (line-beginning-position) (point-min))
  1969. 0
  1970. (forward-line -1)
  1971. (current-indentation))))
  1972. (defun markdown-next-line-indent ()
  1973. "Return the number of leading whitespace characters in the next line.
  1974. Return 0 if line is the last line in the buffer."
  1975. (save-excursion
  1976. (if (= (line-end-position) (point-max))
  1977. 0
  1978. (forward-line 1)
  1979. (current-indentation))))
  1980. (defun markdown-new-baseline ()
  1981. "Determine if the current line begins a new baseline level.
  1982. Assume point is positioned at beginning of line."
  1983. (or (looking-at markdown-regex-header)
  1984. (looking-at markdown-regex-hr)
  1985. (and (= (current-indentation) 0)
  1986. (not (looking-at markdown-regex-list))
  1987. (markdown-prev-line-blank))))
  1988. (defun markdown-search-backward-baseline ()
  1989. "Search backward baseline point with no indentation and not a list item."
  1990. (end-of-line)
  1991. (let (stop)
  1992. (while (not (or stop (bobp)))
  1993. (re-search-backward markdown-regex-block-separator-noindent nil t)
  1994. (when (match-end 2)
  1995. (goto-char (match-end 2))
  1996. (cond
  1997. ((markdown-new-baseline)
  1998. (setq stop t))
  1999. ((looking-at-p markdown-regex-list)
  2000. (setq stop nil))
  2001. (t (setq stop t)))))))
  2002. (defun markdown-update-list-levels (marker indent levels)
  2003. "Update list levels given list MARKER, block INDENT, and current LEVELS.
  2004. Here, MARKER is a string representing the type of list, INDENT is an integer
  2005. giving the indentation, in spaces, of the current block, and LEVELS is a
  2006. list of the indentation levels of parent list items. When LEVELS is nil,
  2007. it means we are at baseline (not inside of a nested list)."
  2008. (cond
  2009. ;; New list item at baseline.
  2010. ((and marker (null levels))
  2011. (setq levels (list indent)))
  2012. ;; List item with greater indentation (four or more spaces).
  2013. ;; Increase list level.
  2014. ((and marker (>= indent (+ (car levels) markdown-list-indent-width)))
  2015. (setq levels (cons indent levels)))
  2016. ;; List item with greater or equal indentation (less than four spaces).
  2017. ;; Do not increase list level.
  2018. ((and marker (>= indent (car levels)))
  2019. levels)
  2020. ;; Lesser indentation level.
  2021. ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
  2022. ;; indentation could move back more than one list level). Note
  2023. ;; that this block need not be the beginning of list item.
  2024. ((< indent (car levels))
  2025. (while (and (> (length levels) 1)
  2026. (< indent (+ (cadr levels) markdown-list-indent-width)))
  2027. (setq levels (cdr levels)))
  2028. levels)
  2029. ;; Otherwise, do nothing.
  2030. (t levels)))
  2031. (defun markdown-calculate-list-levels ()
  2032. "Calculate list levels at point.
  2033. Return a list of the form (n1 n2 n3 ...) where n1 is the
  2034. indentation of the deepest nested list item in the branch of
  2035. the list at the point, n2 is the indentation of the parent
  2036. list item, and so on. The depth of the list item is therefore
  2037. the length of the returned list. If the point is not at or
  2038. immediately after a list item, return nil."
  2039. (save-excursion
  2040. (let ((first (point)) levels indent pre-regexp)
  2041. ;; Find a baseline point with zero list indentation
  2042. (markdown-search-backward-baseline)
  2043. ;; Search for all list items between baseline and LOC
  2044. (while (and (< (point) first)
  2045. (re-search-forward markdown-regex-list first t))
  2046. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels))))
  2047. (beginning-of-line)
  2048. (cond
  2049. ;; Make sure this is not a header or hr
  2050. ((markdown-new-baseline) (setq levels nil))
  2051. ;; Make sure this is not a line from a pre block
  2052. ((looking-at-p pre-regexp))
  2053. ;; If not, then update levels
  2054. (t
  2055. (setq indent (current-indentation))
  2056. (setq levels (markdown-update-list-levels (match-string 2)
  2057. indent levels))))
  2058. (end-of-line))
  2059. levels)))
  2060. (defun markdown-prev-list-item (level)
  2061. "Search backward from point for a list item with indentation LEVEL.
  2062. Set point to the beginning of the item, and return point, or nil
  2063. upon failure."
  2064. (let (bounds indent prev)
  2065. (setq prev (point))
  2066. (forward-line -1)
  2067. (setq indent (current-indentation))
  2068. (while
  2069. (cond
  2070. ;; List item
  2071. ((and (looking-at-p markdown-regex-list)
  2072. (setq bounds (markdown-cur-list-item-bounds)))
  2073. (cond
  2074. ;; Stop and return point at item of equal indentation
  2075. ((= (nth 3 bounds) level)
  2076. (setq prev (point))
  2077. nil)
  2078. ;; Stop and return nil at item with lesser indentation
  2079. ((< (nth 3 bounds) level)
  2080. (setq prev nil)
  2081. nil)
  2082. ;; Stop at beginning of buffer
  2083. ((bobp) (setq prev nil))
  2084. ;; Continue at item with greater indentation
  2085. ((> (nth 3 bounds) level) t)))
  2086. ;; Stop at beginning of buffer
  2087. ((bobp) (setq prev nil))
  2088. ;; Continue if current line is blank
  2089. ((markdown-cur-line-blank-p) t)
  2090. ;; Continue while indentation is the same or greater
  2091. ((>= indent level) t)
  2092. ;; Stop if current indentation is less than list item
  2093. ;; and the next is blank
  2094. ((and (< indent level)
  2095. (markdown-next-line-blank-p))
  2096. (setq prev nil))
  2097. ;; Stop at a header
  2098. ((looking-at-p markdown-regex-header) (setq prev nil))
  2099. ;; Stop at a horizontal rule
  2100. ((looking-at-p markdown-regex-hr) (setq prev nil))
  2101. ;; Otherwise, continue.
  2102. (t t))
  2103. (forward-line -1)
  2104. (setq indent (current-indentation)))
  2105. prev))
  2106. (defun markdown-next-list-item (level)
  2107. "Search forward from point for the next list item with indentation LEVEL.
  2108. Set point to the beginning of the item, and return point, or nil
  2109. upon failure."
  2110. (let (bounds indent next)
  2111. (setq next (point))
  2112. (if (looking-at markdown-regex-header-setext)
  2113. (goto-char (match-end 0)))
  2114. (forward-line)
  2115. (setq indent (current-indentation))
  2116. (while
  2117. (cond
  2118. ;; Stop at end of the buffer.
  2119. ((eobp) nil)
  2120. ;; Continue if the current line is blank
  2121. ((markdown-cur-line-blank-p) t)
  2122. ;; List item
  2123. ((and (looking-at-p markdown-regex-list)
  2124. (setq bounds (markdown-cur-list-item-bounds)))
  2125. (cond
  2126. ;; Continue at item with greater indentation
  2127. ((> (nth 3 bounds) level) t)
  2128. ;; Stop and return point at item of equal indentation
  2129. ((= (nth 3 bounds) level)
  2130. (setq next (point))
  2131. nil)
  2132. ;; Stop and return nil at item with lesser indentation
  2133. ((< (nth 3 bounds) level)
  2134. (setq next nil)
  2135. nil)))
  2136. ;; Continue while indentation is the same or greater
  2137. ((>= indent level) t)
  2138. ;; Stop if current indentation is less than list item
  2139. ;; and the previous line was blank.
  2140. ((and (< indent level)
  2141. (markdown-prev-line-blank-p))
  2142. (setq next nil))
  2143. ;; Stop at a header
  2144. ((looking-at-p markdown-regex-header) (setq next nil))
  2145. ;; Stop at a horizontal rule
  2146. ((looking-at-p markdown-regex-hr) (setq next nil))
  2147. ;; Otherwise, continue.
  2148. (t t))
  2149. (forward-line)
  2150. (setq indent (current-indentation)))
  2151. next))
  2152. (defun markdown-cur-list-item-end (level)
  2153. "Move to end of list item with pre-marker indentation LEVEL.
  2154. Return the point at the end when a list item was found at the
  2155. original point. If the point is not in a list item, do nothing."
  2156. (let (indent)
  2157. (forward-line)
  2158. (setq indent (current-indentation))
  2159. (while
  2160. (cond
  2161. ;; Stop at end of the buffer.
  2162. ((eobp) nil)
  2163. ;; Continue while indentation is the same or greater
  2164. ((>= indent level) t)
  2165. ;; Continue if the current line is blank
  2166. ((looking-at markdown-regex-blank-line) t)
  2167. ;; Stop if current indentation is less than list item
  2168. ;; and the previous line was blank.
  2169. ((and (< indent level)
  2170. (markdown-prev-line-blank))
  2171. nil)
  2172. ;; Stop at a new list items of the same or lesser
  2173. ;; indentation, headings, and horizontal rules.
  2174. ((looking-at (concat "\\(?:" markdown-regex-list
  2175. "\\|" markdown-regex-header
  2176. "\\|" markdown-regex-hr "\\)"))
  2177. nil)
  2178. ;; Otherwise, continue.
  2179. (t t))
  2180. (forward-line)
  2181. (setq indent (current-indentation)))
  2182. ;; Don't skip over whitespace for empty list items (marker and
  2183. ;; whitespace only), just move to end of whitespace.
  2184. (if (save-excursion
  2185. (beginning-of-line)
  2186. (looking-at (concat markdown-regex-list "[ \t]*$")))
  2187. (goto-char (match-end 3))
  2188. (skip-chars-backward " \t\n"))
  2189. (end-of-line)
  2190. (point)))
  2191. (defun markdown-cur-list-item-bounds ()
  2192. "Return bounds for list item at point.
  2193. Return a list of the following form:
  2194. (begin end indent nonlist-indent marker checkbox match)
  2195. The named components are:
  2196. - begin: Position of beginning of list item, including leading indentation.
  2197. - end: Position of the end of the list item, including list item text.
  2198. - indent: Number of characters of indentation before list marker (an integer).
  2199. - nonlist-indent: Number characters of indentation, list
  2200. marker, and whitespace following list marker (an integer).
  2201. - marker: String containing the list marker and following whitespace
  2202. (e.g., \"- \" or \"* \").
  2203. - checkbox: String containing the GFM checkbox portion, if any,
  2204. including any trailing whitespace before the text
  2205. begins (e.g., \"[x] \").
  2206. - match: match data for markdown-regex-list
  2207. As an example, for the following unordered list item
  2208. - item
  2209. the returned list would be
  2210. (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
  2211. If the point is not inside a list item, return nil."
  2212. (car (get-text-property (point-at-bol) 'markdown-list-item)))
  2213. (defun markdown-list-item-at-point-p ()
  2214. "Return t if there is a list item at the point and nil otherwise."
  2215. (save-match-data (markdown-cur-list-item-bounds)))
  2216. (defun markdown-prev-list-item-bounds ()
  2217. "Return bounds of previous item in the same list of any level.
  2218. The return value has the same form as that of
  2219. `markdown-cur-list-item-bounds'."
  2220. (save-excursion
  2221. (let ((cur-bounds (markdown-cur-list-item-bounds))
  2222. (beginning-of-list (save-excursion (markdown-beginning-of-list)))
  2223. stop)
  2224. (when cur-bounds
  2225. (goto-char (nth 0 cur-bounds))
  2226. (while (and (not stop) (not (bobp))
  2227. (re-search-backward markdown-regex-list
  2228. beginning-of-list t))
  2229. (unless (or (looking-at markdown-regex-hr)
  2230. (markdown-code-block-at-point-p))
  2231. (setq stop (point))))
  2232. (markdown-cur-list-item-bounds)))))
  2233. (defun markdown-next-list-item-bounds ()
  2234. "Return bounds of next item in the same list of any level.
  2235. The return value has the same form as that of
  2236. `markdown-cur-list-item-bounds'."
  2237. (save-excursion
  2238. (let ((cur-bounds (markdown-cur-list-item-bounds))
  2239. (end-of-list (save-excursion (markdown-end-of-list)))
  2240. stop)
  2241. (when cur-bounds
  2242. (goto-char (nth 0 cur-bounds))
  2243. (end-of-line)
  2244. (while (and (not stop) (not (eobp))
  2245. (re-search-forward markdown-regex-list
  2246. end-of-list t))
  2247. (unless (or (looking-at markdown-regex-hr)
  2248. (markdown-code-block-at-point-p))
  2249. (setq stop (point))))
  2250. (when stop
  2251. (markdown-cur-list-item-bounds))))))
  2252. (defun markdown-beginning-of-list ()
  2253. "Move point to beginning of list at point, if any."
  2254. (interactive)
  2255. (let ((orig-point (point))
  2256. (list-begin (save-excursion
  2257. (markdown-search-backward-baseline)
  2258. ;; Stop at next list item, regardless of the indentation.
  2259. (markdown-next-list-item (point-max))
  2260. (when (looking-at markdown-regex-list)
  2261. (point)))))
  2262. (when (and list-begin (<= list-begin orig-point))
  2263. (goto-char list-begin))))
  2264. (defun markdown-end-of-list ()
  2265. "Move point to end of list at point, if any."
  2266. (interactive)
  2267. (let ((start (point))
  2268. (end (save-excursion
  2269. (when (markdown-beginning-of-list)
  2270. ;; Items can't have nonlist-indent <= 1, so this
  2271. ;; moves past all list items.
  2272. (markdown-next-list-item 1)
  2273. (skip-syntax-backward "-")
  2274. (unless (eobp) (forward-char 1))
  2275. (point)))))
  2276. (when (and end (>= end start))
  2277. (goto-char end))))
  2278. (defun markdown-up-list ()
  2279. "Move point to beginning of parent list item."
  2280. (interactive)
  2281. (let ((cur-bounds (markdown-cur-list-item-bounds)))
  2282. (when cur-bounds
  2283. (markdown-prev-list-item (1- (nth 3 cur-bounds)))
  2284. (let ((up-bounds (markdown-cur-list-item-bounds)))
  2285. (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds)))
  2286. (point))))))
  2287. (defun markdown-bounds-of-thing-at-point (thing)
  2288. "Call `bounds-of-thing-at-point' for THING with slight modifications.
  2289. Does not include trailing newlines when THING is 'line. Handles the
  2290. end of buffer case by setting both endpoints equal to the value of
  2291. `point-max', since an empty region will trigger empty markup insertion.
  2292. Return bounds of form (beg . end) if THING is found, or nil otherwise."
  2293. (let* ((bounds (bounds-of-thing-at-point thing))
  2294. (a (car bounds))
  2295. (b (cdr bounds)))
  2296. (when bounds
  2297. (when (eq thing 'line)
  2298. (cond ((and (eobp) (markdown-cur-line-blank-p))
  2299. (setq a b))
  2300. ((char-equal (char-before b) ?\^J)
  2301. (setq b (1- b)))))
  2302. (cons a b))))
  2303. (defun markdown-reference-definition (reference)
  2304. "Find out whether Markdown REFERENCE is defined.
  2305. REFERENCE should not include the square brackets.
  2306. When REFERENCE is defined, return a list of the form (text start end)
  2307. containing the definition text itself followed by the start and end
  2308. locations of the text. Otherwise, return nil.
  2309. Leave match data for `markdown-regex-reference-definition'
  2310. intact additional processing."
  2311. (let ((reference (downcase reference)))
  2312. (save-excursion
  2313. (goto-char (point-min))
  2314. (catch 'found
  2315. (while (re-search-forward markdown-regex-reference-definition nil t)
  2316. (when (string= reference (downcase (match-string-no-properties 2)))
  2317. (throw 'found
  2318. (list (match-string-no-properties 5)
  2319. (match-beginning 5) (match-end 5)))))))))
  2320. (defun markdown-get-defined-references ()
  2321. "Return all defined reference labels and their line numbers (not including square brackets)."
  2322. (save-excursion
  2323. (goto-char (point-min))
  2324. (let (refs)
  2325. (while (re-search-forward markdown-regex-reference-definition nil t)
  2326. (let ((target (match-string-no-properties 2)))
  2327. (cl-pushnew
  2328. (cons (downcase target)
  2329. (markdown-line-number-at-pos (match-beginning 2)))
  2330. refs :test #'equal :key #'car)))
  2331. (reverse refs))))
  2332. (defun markdown-get-used-uris ()
  2333. "Return a list of all used URIs in the buffer."
  2334. (save-excursion
  2335. (goto-char (point-min))
  2336. (let (uris)
  2337. (while (re-search-forward
  2338. (concat "\\(?:" markdown-regex-link-inline
  2339. "\\|" markdown-regex-angle-uri
  2340. "\\|" markdown-regex-uri
  2341. "\\|" markdown-regex-email
  2342. "\\)")
  2343. nil t)
  2344. (unless (or (markdown-inline-code-at-point-p)
  2345. (markdown-code-block-at-point-p))
  2346. (cl-pushnew (or (match-string-no-properties 6)
  2347. (match-string-no-properties 10)
  2348. (match-string-no-properties 12)
  2349. (match-string-no-properties 13))
  2350. uris :test #'equal)))
  2351. (reverse uris))))
  2352. (defun markdown-inline-code-at-pos (pos)
  2353. "Return non-nil if there is an inline code fragment at POS.
  2354. Return nil otherwise. Set match data according to
  2355. `markdown-match-code' upon success.
  2356. This function searches the block for a code fragment that
  2357. contains the point using `markdown-match-code'. We do this
  2358. because `thing-at-point-looking-at' does not work reliably with
  2359. `markdown-regex-code'.
  2360. The match data is set as follows:
  2361. Group 1 matches the opening backquotes.
  2362. Group 2 matches the code fragment itself, without backquotes.
  2363. Group 3 matches the closing backquotes."
  2364. (save-excursion
  2365. (goto-char pos)
  2366. (let ((old-point (point))
  2367. (end-of-block (progn (markdown-end-of-text-block) (point)))
  2368. found)
  2369. (markdown-beginning-of-text-block)
  2370. (while (and (markdown-match-code end-of-block)
  2371. (setq found t)
  2372. (< (match-end 0) old-point)))
  2373. (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1)))
  2374. (and found ; matched something
  2375. (<= (match-beginning match-group) old-point) ; match contains old-point
  2376. (> (match-end 0) old-point))))))
  2377. (defun markdown-inline-code-at-pos-p (pos)
  2378. "Return non-nil if there is an inline code fragment at POS.
  2379. Like `markdown-inline-code-at-pos`, but preserves match data."
  2380. (save-match-data (markdown-inline-code-at-pos pos)))
  2381. (defun markdown-inline-code-at-point ()
  2382. "Return non-nil if the point is at an inline code fragment.
  2383. See `markdown-inline-code-at-pos' for details."
  2384. (markdown-inline-code-at-pos (point)))
  2385. (defun markdown-inline-code-at-point-p (&optional pos)
  2386. "Return non-nil if there is inline code at the POS.
  2387. This is a predicate function counterpart to
  2388. `markdown-inline-code-at-point' which does not modify the match
  2389. data. See `markdown-code-block-at-point-p' for code blocks."
  2390. (save-match-data (markdown-inline-code-at-pos (or pos (point)))))
  2391. (defun markdown-code-block-at-pos (pos)
  2392. "Return match data list if there is a code block at POS.
  2393. Uses text properties at the beginning of the line position.
  2394. This includes pre blocks, tilde-fenced code blocks, and GFM
  2395. quoted code blocks. Return nil otherwise."
  2396. (let ((bol (save-excursion (goto-char pos) (point-at-bol))))
  2397. (or (get-text-property bol 'markdown-pre)
  2398. (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos))
  2399. (second (cl-second bounds)))
  2400. (if second
  2401. ;; chunks are right open
  2402. (when (< pos second)
  2403. bounds)
  2404. bounds)))))
  2405. ;; Function was renamed to emphasize that it does not modify match-data.
  2406. (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p)
  2407. (defun markdown-code-block-at-point-p (&optional pos)
  2408. "Return non-nil if there is a code block at the POS.
  2409. This includes pre blocks, tilde-fenced code blocks, and GFM
  2410. quoted code blocks. This function does not modify the match
  2411. data. See `markdown-inline-code-at-point-p' for inline code."
  2412. (save-match-data (markdown-code-block-at-pos (or pos (point)))))
  2413. (defun markdown-heading-at-point (&optional pos)
  2414. "Return non-nil if there is a heading at the POS.
  2415. Set match data for `markdown-regex-header'."
  2416. (let ((match-data (get-text-property (or pos (point)) 'markdown-heading)))
  2417. (when match-data
  2418. (set-match-data match-data)
  2419. t)))
  2420. (defun markdown-pipe-at-bol-p ()
  2421. "Return non-nil if the line begins with a pipe symbol.
  2422. This may be useful for tables and Pandoc's line_blocks extension."
  2423. (char-equal (char-after (point-at-bol)) ?|))
  2424. ;;; Markdown Font Lock Matching Functions =====================================
  2425. (defun markdown-range-property-any (begin end prop prop-values)
  2426. "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
  2427. Also returns t if PROP is a list containing one of the PROP-VALUES.
  2428. Return nil otherwise."
  2429. (let (props)
  2430. (catch 'found
  2431. (dolist (loc (number-sequence begin end))
  2432. (when (setq props (get-text-property loc prop))
  2433. (cond ((listp props)
  2434. ;; props is a list, check for membership
  2435. (dolist (val prop-values)
  2436. (when (memq val props) (throw 'found loc))))
  2437. (t
  2438. ;; props is a scalar, check for equality
  2439. (dolist (val prop-values)
  2440. (when (eq val props) (throw 'found loc))))))))))
  2441. (defun markdown-range-properties-exist (begin end props)
  2442. (cl-loop
  2443. for loc in (number-sequence begin end)
  2444. with result = nil
  2445. while (not
  2446. (setq result
  2447. (cl-some (lambda (prop) (get-text-property loc prop)) props)))
  2448. finally return result))
  2449. (defun markdown-match-inline-generic (regex last &optional faceless)
  2450. "Match inline REGEX from the point to LAST.
  2451. When FACELESS is non-nil, do not return matches where faces have been applied."
  2452. (when (re-search-forward regex last t)
  2453. (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
  2454. (face (and faceless (text-property-not-all
  2455. (match-beginning 0) (match-end 0) 'face nil))))
  2456. (cond
  2457. ;; In code block: move past it and recursively search again
  2458. (bounds
  2459. (when (< (goto-char (cl-second bounds)) last)
  2460. (markdown-match-inline-generic regex last faceless)))
  2461. ;; When faces are found in the match range, skip over the match and
  2462. ;; recursively search again.
  2463. (face
  2464. (when (< (goto-char (match-end 0)) last)
  2465. (markdown-match-inline-generic regex last faceless)))
  2466. ;; Keep match data and return t when in bounds.
  2467. (t
  2468. (<= (match-end 0) last))))))
  2469. (defun markdown-match-code (last)
  2470. "Match inline code fragments from point to LAST."
  2471. (unless (bobp)
  2472. (backward-char 1))
  2473. (when (markdown-search-until-condition
  2474. (lambda ()
  2475. (and
  2476. ;; Advance point in case of failure, but without exceeding last.
  2477. (goto-char (min (1+ (match-beginning 1)) last))
  2478. (not (markdown-in-comment-p (match-beginning 1)))
  2479. (not (markdown-in-comment-p (match-end 1)))
  2480. (not (markdown-code-block-at-pos (match-beginning 1)))))
  2481. markdown-regex-code last t)
  2482. (set-match-data (list (match-beginning 1) (match-end 1)
  2483. (match-beginning 2) (match-end 2)
  2484. (match-beginning 3) (match-end 3)
  2485. (match-beginning 4) (match-end 4)))
  2486. (goto-char (min (1+ (match-end 0)) last (point-max)))
  2487. t))
  2488. (defun markdown--gfm-markup-underscore-p (begin end)
  2489. (let ((is-underscore (eql (char-after begin) ?_)))
  2490. (if (not is-underscore)
  2491. t
  2492. (save-excursion
  2493. (save-match-data
  2494. (goto-char begin)
  2495. (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin))
  2496. (progn
  2497. (goto-char end)
  2498. (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)"))))))))
  2499. (defun markdown-match-bold (last)
  2500. "Match inline bold from the point to LAST."
  2501. (when (markdown-match-inline-generic markdown-regex-bold last)
  2502. (let ((is-gfm (derived-mode-p 'gfm-mode))
  2503. (begin (match-beginning 2))
  2504. (end (match-end 2)))
  2505. (if (or (markdown-inline-code-at-pos-p begin)
  2506. (markdown-inline-code-at-pos-p end)
  2507. (markdown-in-comment-p)
  2508. (markdown-range-property-any
  2509. begin begin 'face '(markdown-url-face
  2510. markdown-plain-url-face))
  2511. (markdown-range-property-any
  2512. begin end 'face '(markdown-hr-face
  2513. markdown-math-face))
  2514. (and is-gfm (not (markdown--gfm-markup-underscore-p begin end))))
  2515. (progn (goto-char (min (1+ begin) last))
  2516. (when (< (point) last)
  2517. (markdown-match-bold last)))
  2518. (set-match-data (list (match-beginning 2) (match-end 2)
  2519. (match-beginning 3) (match-end 3)
  2520. (match-beginning 4) (match-end 4)
  2521. (match-beginning 5) (match-end 5)))
  2522. t))))
  2523. (defun markdown-match-italic (last)
  2524. "Match inline italics from the point to LAST."
  2525. (let* ((is-gfm (derived-mode-p 'gfm-mode))
  2526. (regex (if is-gfm
  2527. markdown-regex-gfm-italic
  2528. markdown-regex-italic)))
  2529. (when (and (markdown-match-inline-generic regex last)
  2530. (not (markdown--face-p
  2531. (match-beginning 1)
  2532. '(markdown-html-attr-name-face markdown-html-attr-value-face))))
  2533. (let ((begin (match-beginning 1))
  2534. (end (match-end 1))
  2535. (close-end (match-end 4)))
  2536. (if (or (eql (char-before begin) (char-after begin))
  2537. (markdown-inline-code-at-pos-p begin)
  2538. (markdown-inline-code-at-pos-p (1- end))
  2539. (markdown-in-comment-p)
  2540. (markdown-range-property-any
  2541. begin begin 'face '(markdown-url-face
  2542. markdown-plain-url-face))
  2543. (markdown-range-property-any
  2544. begin end 'face '(markdown-bold-face
  2545. markdown-list-face
  2546. markdown-hr-face
  2547. markdown-math-face))
  2548. (and is-gfm
  2549. (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case
  2550. (not (markdown--gfm-markup-underscore-p begin close-end)))))
  2551. (progn (goto-char (min (1+ begin) last))
  2552. (when (< (point) last)
  2553. (markdown-match-italic last)))
  2554. (set-match-data (list (match-beginning 1) (match-end 1)
  2555. (match-beginning 2) (match-end 2)
  2556. (match-beginning 3) (match-end 3)
  2557. (match-beginning 4) (match-end 4)))
  2558. t)))))
  2559. (defun markdown-match-math-generic (regex last)
  2560. "Match REGEX from point to LAST.
  2561. REGEX is either `markdown-regex-math-inline-single' for matching
  2562. $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
  2563. (when (markdown-match-inline-generic regex last)
  2564. (let ((begin (match-beginning 1)) (end (match-end 1)))
  2565. (prog1
  2566. (if (or (markdown-range-property-any
  2567. begin end 'face
  2568. '(markdown-inline-code-face markdown-bold-face))
  2569. (markdown-range-properties-exist
  2570. begin end
  2571. (markdown-get-fenced-block-middle-properties)))
  2572. (markdown-match-math-generic regex last)
  2573. t)
  2574. (goto-char (1+ (match-end 0)))))))
  2575. (defun markdown-match-list-items (last)
  2576. "Match list items from point to LAST."
  2577. (let* ((first (point))
  2578. (pos first)
  2579. (prop 'markdown-list-item)
  2580. (bounds (car (get-text-property pos prop))))
  2581. (while
  2582. (and (or (null (setq bounds (car (get-text-property pos prop))))
  2583. (< (cl-first bounds) pos))
  2584. (< (point) last)
  2585. (setq pos (next-single-property-change pos prop nil last))
  2586. (goto-char pos)))
  2587. (when bounds
  2588. (set-match-data (cl-seventh bounds))
  2589. ;; Step at least one character beyond point. Otherwise
  2590. ;; `font-lock-fontify-keywords-region' infloops.
  2591. (goto-char (min (1+ (max (point-at-eol) first))
  2592. (point-max)))
  2593. t)))
  2594. (defun markdown-match-math-single (last)
  2595. "Match single quoted $..$ math from point to LAST."
  2596. (when markdown-enable-math
  2597. (when (and (char-equal (char-after) ?$)
  2598. (not (bolp))
  2599. (not (char-equal (char-before) ?\\))
  2600. (not (char-equal (char-before) ?$)))
  2601. (forward-char -1))
  2602. (markdown-match-math-generic markdown-regex-math-inline-single last)))
  2603. (defun markdown-match-math-double (last)
  2604. "Match double quoted $$..$$ math from point to LAST."
  2605. (when markdown-enable-math
  2606. (when (and (char-equal (char-after) ?$)
  2607. (char-equal (char-after (1+ (point))) ?$)
  2608. (not (bolp))
  2609. (not (char-equal (char-before) ?\\))
  2610. (not (char-equal (char-before) ?$)))
  2611. (forward-char -1))
  2612. (markdown-match-math-generic markdown-regex-math-inline-double last)))
  2613. (defun markdown-match-math-display (last)
  2614. "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
  2615. (when markdown-enable-math
  2616. (markdown-match-math-generic markdown-regex-math-display last)))
  2617. (defun markdown-match-propertized-text (property last)
  2618. "Match text with PROPERTY from point to LAST.
  2619. Restore match data previously stored in PROPERTY."
  2620. (let ((saved (get-text-property (point) property))
  2621. pos)
  2622. (unless saved
  2623. (setq pos (next-single-property-change (point) property nil last))
  2624. (unless (= pos last)
  2625. (setq saved (get-text-property pos property))))
  2626. (when saved
  2627. (set-match-data saved)
  2628. ;; Step at least one character beyond point. Otherwise
  2629. ;; `font-lock-fontify-keywords-region' infloops.
  2630. (goto-char (min (1+ (max (match-end 0) (point)))
  2631. (point-max)))
  2632. saved)))
  2633. (defun markdown-match-pre-blocks (last)
  2634. "Match preformatted blocks from point to LAST.
  2635. Use data stored in 'markdown-pre text property during syntax
  2636. analysis."
  2637. (markdown-match-propertized-text 'markdown-pre last))
  2638. (defun markdown-match-gfm-code-blocks (last)
  2639. "Match GFM quoted code blocks from point to LAST.
  2640. Use data stored in 'markdown-gfm-code text property during syntax
  2641. analysis."
  2642. (markdown-match-propertized-text 'markdown-gfm-code last))
  2643. (defun markdown-match-gfm-open-code-blocks (last)
  2644. (markdown-match-propertized-text 'markdown-gfm-block-begin last))
  2645. (defun markdown-match-gfm-close-code-blocks (last)
  2646. (markdown-match-propertized-text 'markdown-gfm-block-end last))
  2647. (defun markdown-match-fenced-code-blocks (last)
  2648. "Match fenced code blocks from the point to LAST."
  2649. (markdown-match-propertized-text 'markdown-fenced-code last))
  2650. (defun markdown-match-fenced-start-code-block (last)
  2651. (markdown-match-propertized-text 'markdown-tilde-fence-begin last))
  2652. (defun markdown-match-fenced-end-code-block (last)
  2653. (markdown-match-propertized-text 'markdown-tilde-fence-end last))
  2654. (defun markdown-match-blockquotes (last)
  2655. "Match blockquotes from point to LAST.
  2656. Use data stored in 'markdown-blockquote text property during syntax
  2657. analysis."
  2658. (markdown-match-propertized-text 'markdown-blockquote last))
  2659. (defun markdown-match-hr (last)
  2660. "Match horizontal rules comments from the point to LAST."
  2661. (markdown-match-propertized-text 'markdown-hr last))
  2662. (defun markdown-match-comments (last)
  2663. "Match HTML comments from the point to LAST."
  2664. (when (and (skip-syntax-forward "^<" last))
  2665. (let ((beg (point)))
  2666. (when (and (skip-syntax-forward "^>" last) (< (point) last))
  2667. (forward-char)
  2668. (set-match-data (list beg (point)))
  2669. t))))
  2670. (defun markdown-match-generic-links (last ref)
  2671. "Match inline links from point to LAST.
  2672. When REF is non-nil, match reference links instead of standard
  2673. links with URLs.
  2674. This function should only be used during font-lock, as it
  2675. determines syntax based on the presence of faces for previously
  2676. processed elements."
  2677. ;; Search for the next potential link (not in a code block).
  2678. (let ((prohibited-faces '(markdown-pre-face
  2679. markdown-code-face
  2680. markdown-inline-code-face
  2681. markdown-comment-face))
  2682. found)
  2683. (while
  2684. (and (not found) (< (point) last)
  2685. (progn
  2686. ;; Clear match data to test for a match after functions returns.
  2687. (set-match-data nil)
  2688. ;; Preliminary regular expression search so we can return
  2689. ;; quickly upon failure. This doesn't handle malformed links
  2690. ;; or nested square brackets well, so if it passes we back up
  2691. ;; continue with a more precise search.
  2692. (re-search-forward
  2693. (if ref
  2694. markdown-regex-link-reference
  2695. markdown-regex-link-inline)
  2696. last 'limit)))
  2697. ;; Keep searching if this is in a code block, inline code, or a
  2698. ;; comment, or if it is include syntax. The link text portion
  2699. ;; (group 3) may contain inline code or comments, but the
  2700. ;; markup, URL, and title should not be part of such elements.
  2701. (if (or (markdown-range-property-any
  2702. (match-beginning 0) (match-end 2) 'face prohibited-faces)
  2703. (markdown-range-property-any
  2704. (match-beginning 4) (match-end 0) 'face prohibited-faces)
  2705. (and (char-equal (char-after (point-at-bol)) ?<)
  2706. (char-equal (char-after (1+ (point-at-bol))) ?<)))
  2707. (set-match-data nil)
  2708. (setq found t))))
  2709. ;; Match opening exclamation point (optional) and left bracket.
  2710. (when (match-beginning 2)
  2711. (let* ((bang (match-beginning 1))
  2712. (first-begin (match-beginning 2))
  2713. ;; Find end of block to prevent matching across blocks.
  2714. (end-of-block (save-excursion
  2715. (progn
  2716. (goto-char (match-beginning 2))
  2717. (markdown-end-of-text-block)
  2718. (point))))
  2719. ;; Move over balanced expressions to closing right bracket.
  2720. ;; Catch unbalanced expression errors and return nil.
  2721. (first-end (condition-case nil
  2722. (and (goto-char first-begin)
  2723. (scan-sexps (point) 1))
  2724. (error nil)))
  2725. ;; Continue with point at CONT-POINT upon failure.
  2726. (cont-point (min (1+ first-begin) last))
  2727. second-begin second-end url-begin url-end
  2728. title-begin title-end)
  2729. ;; When bracket found, in range, and followed by a left paren/bracket...
  2730. (when (and first-end (< first-end end-of-block) (goto-char first-end)
  2731. (char-equal (char-after (point)) (if ref ?\[ ?\()))
  2732. ;; Scan across balanced expressions for closing parenthesis/bracket.
  2733. (setq second-begin (point)
  2734. second-end (condition-case nil
  2735. (scan-sexps (point) 1)
  2736. (error nil)))
  2737. ;; Check that closing parenthesis/bracket is in range.
  2738. (if (and second-end (<= second-end end-of-block) (<= second-end last))
  2739. (progn
  2740. ;; Search for (optional) title inside closing parenthesis
  2741. (when (and (not ref) (search-forward "\"" second-end t))
  2742. (setq title-begin (1- (point))
  2743. title-end (and (goto-char second-end)
  2744. (search-backward "\"" (1+ title-begin) t))
  2745. title-end (and title-end (1+ title-end))))
  2746. ;; Store URL/reference range
  2747. (setq url-begin (1+ second-begin)
  2748. url-end (1- (or title-begin second-end)))
  2749. ;; Set match data, move point beyond link, and return
  2750. (set-match-data
  2751. (list (or bang first-begin) second-end ; 0 - all
  2752. bang (and bang (1+ bang)) ; 1 - bang
  2753. first-begin (1+ first-begin) ; 2 - markup
  2754. (1+ first-begin) (1- first-end) ; 3 - link text
  2755. (1- first-end) first-end ; 4 - markup
  2756. second-begin (1+ second-begin) ; 5 - markup
  2757. url-begin url-end ; 6 - url/reference
  2758. title-begin title-end ; 7 - title
  2759. (1- second-end) second-end)) ; 8 - markup
  2760. ;; Nullify cont-point and leave point at end and
  2761. (setq cont-point nil)
  2762. (goto-char second-end))
  2763. ;; If no closing parenthesis in range, update continuation point
  2764. (setq cont-point (min end-of-block second-begin))))
  2765. (cond
  2766. ;; On failure, continue searching at cont-point
  2767. ((and cont-point (< cont-point last))
  2768. (goto-char cont-point)
  2769. (markdown-match-generic-links last ref))
  2770. ;; No more text, return nil
  2771. ((and cont-point (= cont-point last))
  2772. nil)
  2773. ;; Return t if a match occurred
  2774. (t t)))))
  2775. (defun markdown-match-angle-uris (last)
  2776. "Match angle bracket URIs from point to LAST."
  2777. (when (markdown-match-inline-generic markdown-regex-angle-uri last)
  2778. (goto-char (1+ (match-end 0)))))
  2779. (defun markdown-match-plain-uris (last)
  2780. "Match plain URIs from point to LAST."
  2781. (when (markdown-match-inline-generic markdown-regex-uri last t)
  2782. (goto-char (1+ (match-end 0)))))
  2783. (defvar markdown-conditional-search-function #'re-search-forward
  2784. "Conditional search function used in `markdown-search-until-condition'.
  2785. Made into a variable to allow for dynamic let-binding.")
  2786. (defun markdown-search-until-condition (condition &rest args)
  2787. (let (ret)
  2788. (while (and (not ret) (apply markdown-conditional-search-function args))
  2789. (setq ret (funcall condition)))
  2790. ret))
  2791. (defun markdown-metadata-line-p (pos regexp)
  2792. (save-excursion
  2793. (or (= (line-number-at-pos pos) 1)
  2794. (progn
  2795. (forward-line -1)
  2796. ;; skip multi-line metadata
  2797. (while (and (looking-at-p "^\\s-+[[:alpha:]]")
  2798. (> (line-number-at-pos (point)) 1))
  2799. (forward-line -1))
  2800. (looking-at-p regexp)))))
  2801. (defun markdown-match-generic-metadata (regexp last)
  2802. "Match metadata declarations specified by REGEXP from point to LAST.
  2803. These declarations must appear inside a metadata block that begins at
  2804. the beginning of the buffer and ends with a blank line (or the end of
  2805. the buffer)."
  2806. (let* ((first (point))
  2807. (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
  2808. (block-begin (goto-char 1))
  2809. (block-end (re-search-forward end-re nil t)))
  2810. (if (and block-end (> first block-end))
  2811. ;; Don't match declarations if there is no metadata block or if
  2812. ;; the point is beyond the block. Move point to point-max to
  2813. ;; prevent additional searches and return return nil since nothing
  2814. ;; was found.
  2815. (progn (goto-char (point-max)) nil)
  2816. ;; If a block was found that begins before LAST and ends after
  2817. ;; point, search for declarations inside it. If the starting is
  2818. ;; before the beginning of the block, start there. Otherwise,
  2819. ;; move back to FIRST.
  2820. (goto-char (if (< first block-begin) block-begin first))
  2821. (if (and (re-search-forward regexp (min last block-end) t)
  2822. (markdown-metadata-line-p (point) regexp))
  2823. ;; If a metadata declaration is found, set match-data and return t.
  2824. (let ((key-beginning (match-beginning 1))
  2825. (key-end (match-end 1))
  2826. (markup-begin (match-beginning 2))
  2827. (markup-end (match-end 2))
  2828. (value-beginning (match-beginning 3)))
  2829. (set-match-data (list key-beginning (point) ; complete metadata
  2830. key-beginning key-end ; key
  2831. markup-begin markup-end ; markup
  2832. value-beginning (point))) ; value
  2833. t)
  2834. ;; Otherwise, move the point to last and return nil
  2835. (goto-char last)
  2836. nil))))
  2837. (defun markdown-match-declarative-metadata (last)
  2838. "Match declarative metadata from the point to LAST."
  2839. (markdown-match-generic-metadata markdown-regex-declarative-metadata last))
  2840. (defun markdown-match-pandoc-metadata (last)
  2841. "Match Pandoc metadata from the point to LAST."
  2842. (markdown-match-generic-metadata markdown-regex-pandoc-metadata last))
  2843. (defun markdown-match-yaml-metadata-begin (last)
  2844. (markdown-match-propertized-text 'markdown-yaml-metadata-begin last))
  2845. (defun markdown-match-yaml-metadata-end (last)
  2846. (markdown-match-propertized-text 'markdown-yaml-metadata-end last))
  2847. (defun markdown-match-yaml-metadata-key (last)
  2848. (markdown-match-propertized-text 'markdown-metadata-key last))
  2849. (defun markdown-match-wiki-link (last)
  2850. "Match wiki links from point to LAST."
  2851. (when (and markdown-enable-wiki-links
  2852. (not markdown-wiki-link-fontify-missing)
  2853. (markdown-match-inline-generic markdown-regex-wiki-link last))
  2854. (let ((begin (match-beginning 1)) (end (match-end 1)))
  2855. (if (or (markdown-in-comment-p begin)
  2856. (markdown-in-comment-p end)
  2857. (markdown-inline-code-at-pos-p begin)
  2858. (markdown-inline-code-at-pos-p end)
  2859. (markdown-code-block-at-pos begin))
  2860. (progn (goto-char (min (1+ begin) last))
  2861. (when (< (point) last)
  2862. (markdown-match-wiki-link last)))
  2863. (set-match-data (list begin end))
  2864. t))))
  2865. (defun markdown-match-inline-attributes (last)
  2866. "Match inline attributes from point to LAST."
  2867. ;; #428 re-search-forward markdown-regex-inline-attributes is very slow.
  2868. ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes
  2869. ;; against matched string.
  2870. (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last)
  2871. (if (not (string-match-p markdown-regex-inline-attributes (match-string 0)))
  2872. (markdown-match-inline-attributes last)
  2873. (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
  2874. (markdown-inline-code-at-pos-p (match-end 0))
  2875. (markdown-in-comment-p))
  2876. t))))
  2877. (defun markdown-match-leanpub-sections (last)
  2878. "Match Leanpub section markers from point to LAST."
  2879. (when (markdown-match-inline-generic markdown-regex-leanpub-sections last)
  2880. (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
  2881. (markdown-inline-code-at-pos-p (match-end 0))
  2882. (markdown-in-comment-p))
  2883. t)))
  2884. (defun markdown-match-includes (last)
  2885. "Match include statements from point to LAST.
  2886. Sets match data for the following seven groups:
  2887. Group 1: opening two angle brackets
  2888. Group 2: opening title delimiter (optional)
  2889. Group 3: title text (optional)
  2890. Group 4: closing title delimiter (optional)
  2891. Group 5: opening filename delimiter
  2892. Group 6: filename
  2893. Group 7: closing filename delimiter"
  2894. (when (markdown-match-inline-generic markdown-regex-include last)
  2895. (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
  2896. (markdown-in-comment-p (match-end 0))
  2897. (markdown-code-block-at-pos (match-beginning 0))))))
  2898. (cond
  2899. ;; Parentheses and maybe square brackets, but no curly braces:
  2900. ;; match optional title in square brackets and file in parentheses.
  2901. ((and valid (match-beginning 5)
  2902. (not (match-beginning 8)))
  2903. (set-match-data (list (match-beginning 1) (match-end 7)
  2904. (match-beginning 1) (match-end 1)
  2905. (match-beginning 2) (match-end 2)
  2906. (match-beginning 3) (match-end 3)
  2907. (match-beginning 4) (match-end 4)
  2908. (match-beginning 5) (match-end 5)
  2909. (match-beginning 6) (match-end 6)
  2910. (match-beginning 7) (match-end 7))))
  2911. ;; Only square brackets present: match file in square brackets.
  2912. ((and valid (match-beginning 2)
  2913. (not (match-beginning 5))
  2914. (not (match-beginning 7)))
  2915. (set-match-data (list (match-beginning 1) (match-end 4)
  2916. (match-beginning 1) (match-end 1)
  2917. nil nil
  2918. nil nil
  2919. nil nil
  2920. (match-beginning 2) (match-end 2)
  2921. (match-beginning 3) (match-end 3)
  2922. (match-beginning 4) (match-end 4))))
  2923. ;; Only curly braces present: match file in curly braces.
  2924. ((and valid (match-beginning 8)
  2925. (not (match-beginning 2))
  2926. (not (match-beginning 5)))
  2927. (set-match-data (list (match-beginning 1) (match-end 10)
  2928. (match-beginning 1) (match-end 1)
  2929. nil nil
  2930. nil nil
  2931. nil nil
  2932. (match-beginning 8) (match-end 8)
  2933. (match-beginning 9) (match-end 9)
  2934. (match-beginning 10) (match-end 10))))
  2935. (t
  2936. ;; Not a valid match, move to next line and search again.
  2937. (forward-line)
  2938. (when (< (point) last)
  2939. (setq valid (markdown-match-includes last)))))
  2940. valid)))
  2941. (defun markdown-match-html-tag (last)
  2942. "Match HTML tags from point to LAST."
  2943. (when (and markdown-enable-html
  2944. (markdown-match-inline-generic markdown-regex-html-tag last t))
  2945. (set-match-data (list (match-beginning 0) (match-end 0)
  2946. (match-beginning 1) (match-end 1)
  2947. (match-beginning 2) (match-end 2)
  2948. (match-beginning 9) (match-end 9)))
  2949. t))
  2950. ;;; Markdown Font Fontification Functions =====================================
  2951. (defun markdown--first-displayable (seq)
  2952. "Return the first displayable character or string in SEQ.
  2953. SEQ may be an atom or a sequence."
  2954. (let ((seq (if (listp seq) seq (list seq))))
  2955. (cond ((stringp (car seq))
  2956. (cl-find-if
  2957. (lambda (str)
  2958. (and (mapcar #'char-displayable-p (string-to-list str))))
  2959. seq))
  2960. ((characterp (car seq))
  2961. (cl-find-if #'char-displayable-p seq)))))
  2962. (defun markdown--marginalize-string (level)
  2963. "Generate atx markup string of given LEVEL for left margin."
  2964. (let ((margin-left-space-count
  2965. (- markdown-marginalize-headers-margin-width level)))
  2966. (concat (make-string margin-left-space-count ? )
  2967. (make-string level ?#))))
  2968. (defun markdown-marginalize-update-current ()
  2969. "Update the window configuration to create a left margin."
  2970. (if window-system
  2971. (let* ((header-delimiter-font-width
  2972. (window-font-width nil 'markdown-header-delimiter-face))
  2973. (margin-pixel-width (* markdown-marginalize-headers-margin-width
  2974. header-delimiter-font-width))
  2975. (margin-char-width (/ margin-pixel-width (default-font-width))))
  2976. (set-window-margins nil margin-char-width))
  2977. ;; As a fallback, simply set margin based on character count.
  2978. (set-window-margins nil markdown-marginalize-headers-margin-width)))
  2979. (defun markdown-fontify-headings (last)
  2980. "Add text properties to headings from point to LAST."
  2981. (when (markdown-match-propertized-text 'markdown-heading last)
  2982. (let* ((level (markdown-outline-level))
  2983. (heading-face
  2984. (intern (format "markdown-header-face-%d" level)))
  2985. (heading-props `(face ,heading-face))
  2986. (left-markup-props
  2987. `(face markdown-header-delimiter-face
  2988. ,@(cond
  2989. (markdown-hide-markup
  2990. `(display ""))
  2991. (markdown-marginalize-headers
  2992. `(display ((margin left-margin)
  2993. ,(markdown--marginalize-string level)))))))
  2994. (right-markup-props
  2995. `(face markdown-header-delimiter-face
  2996. ,@(when markdown-hide-markup `(display ""))))
  2997. (rule-props `(face markdown-header-rule-face
  2998. ,@(when markdown-hide-markup `(display "")))))
  2999. (if (match-end 1)
  3000. ;; Setext heading
  3001. (progn (add-text-properties
  3002. (match-beginning 1) (match-end 1) heading-props)
  3003. (if (= level 1)
  3004. (add-text-properties
  3005. (match-beginning 2) (match-end 2) rule-props)
  3006. (add-text-properties
  3007. (match-beginning 3) (match-end 3) rule-props)))
  3008. ;; atx heading
  3009. (add-text-properties
  3010. (match-beginning 4) (match-end 4) left-markup-props)
  3011. (add-text-properties
  3012. (match-beginning 5) (match-end 5) heading-props)
  3013. (when (match-end 6)
  3014. (add-text-properties
  3015. (match-beginning 6) (match-end 6) right-markup-props))))
  3016. t))
  3017. (defun markdown-fontify-tables (last)
  3018. (when (and (re-search-forward "|" last t)
  3019. (markdown-table-at-point-p))
  3020. (font-lock-append-text-property
  3021. (line-beginning-position) (min (1+ (line-end-position)) (point-max))
  3022. 'face 'markdown-table-face)
  3023. (forward-line 1)
  3024. t))
  3025. (defun markdown-fontify-blockquotes (last)
  3026. "Apply font-lock properties to blockquotes from point to LAST."
  3027. (when (markdown-match-blockquotes last)
  3028. (let ((display-string
  3029. (markdown--first-displayable markdown-blockquote-display-char)))
  3030. (add-text-properties
  3031. (match-beginning 1) (match-end 1)
  3032. (if markdown-hide-markup
  3033. `(face markdown-blockquote-face display ,display-string)
  3034. `(face markdown-markup-face)))
  3035. (font-lock-append-text-property
  3036. (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face)
  3037. t)))
  3038. (defun markdown-fontify-list-items (last)
  3039. "Apply font-lock properties to list markers from point to LAST."
  3040. (when (markdown-match-list-items last)
  3041. (let* ((indent (length (match-string-no-properties 1)))
  3042. (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ...
  3043. (bullet (nth (mod level (length markdown-list-item-bullets))
  3044. markdown-list-item-bullets)))
  3045. (add-text-properties
  3046. (match-beginning 2) (match-end 2) '(face markdown-list-face))
  3047. (when markdown-hide-markup
  3048. (cond
  3049. ;; Unordered lists
  3050. ((string-match-p "[\\*\\+-]" (match-string 2))
  3051. (add-text-properties
  3052. (match-beginning 2) (match-end 2) `(display ,bullet)))
  3053. ;; Definition lists
  3054. ((string-equal ":" (match-string 2))
  3055. (let ((display-string
  3056. (char-to-string (markdown--first-displayable
  3057. markdown-definition-display-char))))
  3058. (add-text-properties (match-beginning 2) (match-end 2)
  3059. `(display ,display-string)))))))
  3060. t))
  3061. (defun markdown-fontify-hrs (last)
  3062. "Add text properties to horizontal rules from point to LAST."
  3063. (when (markdown-match-hr last)
  3064. (let ((hr-char (markdown--first-displayable markdown-hr-display-char)))
  3065. (add-text-properties
  3066. (match-beginning 0) (match-end 0)
  3067. `(face markdown-hr-face
  3068. font-lock-multiline t
  3069. ,@(when (and markdown-hide-markup hr-char)
  3070. `(display ,(make-string
  3071. (1- (window-body-width)) hr-char)))))
  3072. t)))
  3073. (defun markdown-fontify-sub-superscripts (last)
  3074. "Apply text properties to sub- and superscripts from point to LAST."
  3075. (when (markdown-search-until-condition
  3076. (lambda () (and (not (markdown-code-block-at-point-p))
  3077. (not (markdown-inline-code-at-point-p))
  3078. (not (markdown-in-comment-p))))
  3079. markdown-regex-sub-superscript last t)
  3080. (let* ((subscript-p (string= (match-string 2) "~"))
  3081. (props
  3082. (if subscript-p
  3083. (car markdown-sub-superscript-display)
  3084. (cdr markdown-sub-superscript-display)))
  3085. (mp (list 'face 'markdown-markup-face
  3086. 'invisible 'markdown-markup)))
  3087. (when markdown-hide-markup
  3088. (put-text-property (match-beginning 3) (match-end 3)
  3089. 'display props))
  3090. (add-text-properties (match-beginning 2) (match-end 2) mp)
  3091. (add-text-properties (match-beginning 4) (match-end 4) mp)
  3092. t)))
  3093. ;;; Syntax Table ==============================================================
  3094. (defvar markdown-mode-syntax-table
  3095. (let ((tab (make-syntax-table text-mode-syntax-table)))
  3096. (modify-syntax-entry ?\" "." tab)
  3097. tab)
  3098. "Syntax table for `markdown-mode'.")
  3099. ;;; Element Insertion =========================================================
  3100. (defun markdown-ensure-blank-line-before ()
  3101. "If previous line is not already blank, insert a blank line before point."
  3102. (unless (bolp) (insert "\n"))
  3103. (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n")))
  3104. (defun markdown-ensure-blank-line-after ()
  3105. "If following line is not already blank, insert a blank line after point.
  3106. Return the point where it was originally."
  3107. (save-excursion
  3108. (unless (eolp) (insert "\n"))
  3109. (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
  3110. (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end)
  3111. "Insert the strings S1 and S2, wrapping around region or THING.
  3112. If a region is specified by the optional BEG and END arguments,
  3113. wrap the strings S1 and S2 around that region.
  3114. If there is an active region, wrap the strings S1 and S2 around
  3115. the region. If there is not an active region but the point is at
  3116. THING, wrap that thing (which defaults to word). Otherwise, just
  3117. insert S1 and S2 and place the point in between. Return the
  3118. bounds of the entire wrapped string, or nil if nothing was wrapped
  3119. and S1 and S2 were only inserted."
  3120. (let (a b bounds new-point)
  3121. (cond
  3122. ;; Given region
  3123. ((and beg end)
  3124. (setq a beg
  3125. b end
  3126. new-point (+ (point) (length s1))))
  3127. ;; Active region
  3128. ((use-region-p)
  3129. (setq a (region-beginning)
  3130. b (region-end)
  3131. new-point (+ (point) (length s1))))
  3132. ;; Thing (word) at point
  3133. ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word)))
  3134. (setq a (car bounds)
  3135. b (cdr bounds)
  3136. new-point (+ (point) (length s1))))
  3137. ;; No active region and no word
  3138. (t
  3139. (setq a (point)
  3140. b (point))))
  3141. (goto-char b)
  3142. (insert s2)
  3143. (goto-char a)
  3144. (insert s1)
  3145. (when new-point (goto-char new-point))
  3146. (if (= a b)
  3147. nil
  3148. (setq b (+ b (length s1) (length s2)))
  3149. (cons a b))))
  3150. (defun markdown-point-after-unwrap (cur prefix suffix)
  3151. "Return desired position of point after an unwrapping operation.
  3152. CUR gives the position of the point before the operation.
  3153. Additionally, two cons cells must be provided. PREFIX gives the
  3154. bounds of the prefix string and SUFFIX gives the bounds of the
  3155. suffix string."
  3156. (cond ((< cur (cdr prefix)) (car prefix))
  3157. ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix))))
  3158. ((<= cur (cdr suffix))
  3159. (- cur (+ (- (cdr prefix) (car prefix))
  3160. (- cur (car suffix)))))
  3161. (t cur)))
  3162. (defun markdown-unwrap-thing-at-point (regexp all text)
  3163. "Remove prefix and suffix of thing at point and reposition the point.
  3164. When the thing at point matches REGEXP, replace the subexpression
  3165. ALL with the string in subexpression TEXT. Reposition the point
  3166. in an appropriate location accounting for the removal of prefix
  3167. and suffix strings. Return new bounds of string from group TEXT.
  3168. When REGEXP is nil, assumes match data is already set."
  3169. (when (or (null regexp)
  3170. (thing-at-point-looking-at regexp))
  3171. (let ((cur (point))
  3172. (prefix (cons (match-beginning all) (match-beginning text)))
  3173. (suffix (cons (match-end text) (match-end all)))
  3174. (bounds (cons (match-beginning text) (match-end text))))
  3175. ;; Replace the thing at point
  3176. (replace-match (match-string text) t t nil all)
  3177. ;; Reposition the point
  3178. (goto-char (markdown-point-after-unwrap cur prefix suffix))
  3179. ;; Adjust bounds
  3180. (setq bounds (cons (car prefix)
  3181. (- (cdr bounds) (- (cdr prefix) (car prefix))))))))
  3182. (defun markdown-unwrap-things-in-region (beg end regexp all text)
  3183. "Remove prefix and suffix of all things in region from BEG to END.
  3184. When a thing in the region matches REGEXP, replace the
  3185. subexpression ALL with the string in subexpression TEXT.
  3186. Return a cons cell containing updated bounds for the region."
  3187. (save-excursion
  3188. (goto-char beg)
  3189. (let ((removed 0) len-all len-text)
  3190. (while (re-search-forward regexp (- end removed) t)
  3191. (setq len-all (length (match-string-no-properties all)))
  3192. (setq len-text (length (match-string-no-properties text)))
  3193. (setq removed (+ removed (- len-all len-text)))
  3194. (replace-match (match-string text) t t nil all))
  3195. (cons beg (- end removed)))))
  3196. (defun markdown-insert-hr (arg)
  3197. "Insert or replace a horizontal rule.
  3198. By default, use the first element of `markdown-hr-strings'. When
  3199. ARG is non-nil, as when given a prefix, select a different
  3200. element as follows. When prefixed with \\[universal-argument],
  3201. use the last element of `markdown-hr-strings' instead. When
  3202. prefixed with an integer from 1 to the length of
  3203. `markdown-hr-strings', use the element in that position instead."
  3204. (interactive "*P")
  3205. (when (thing-at-point-looking-at markdown-regex-hr)
  3206. (delete-region (match-beginning 0) (match-end 0)))
  3207. (markdown-ensure-blank-line-before)
  3208. (cond ((equal arg '(4))
  3209. (insert (car (reverse markdown-hr-strings))))
  3210. ((and (integerp arg) (> arg 0)
  3211. (<= arg (length markdown-hr-strings)))
  3212. (insert (nth (1- arg) markdown-hr-strings)))
  3213. (t
  3214. (insert (car markdown-hr-strings))))
  3215. (markdown-ensure-blank-line-after))
  3216. (defun markdown--insert-common (start-delim end-delim regex start-group end-group face
  3217. &optional skip-space)
  3218. (if (use-region-p)
  3219. ;; Active region
  3220. (let* ((bounds (markdown-unwrap-things-in-region
  3221. (region-beginning) (region-end)
  3222. regex start-group end-group))
  3223. (beg (car bounds))
  3224. (end (cdr bounds)))
  3225. (when (and beg skip-space)
  3226. (save-excursion
  3227. (goto-char beg)
  3228. (skip-chars-forward "[ \t]")
  3229. (setq beg (point))))
  3230. (when (and end skip-space)
  3231. (save-excursion
  3232. (goto-char end)
  3233. (skip-chars-backward "[ \t]")
  3234. (setq end (point))))
  3235. (markdown-wrap-or-insert start-delim end-delim nil beg end))
  3236. (if (markdown--face-p (point) (list face))
  3237. (save-excursion
  3238. (while (and (markdown--face-p (point) (list face)) (not (bobp)))
  3239. (forward-char -1))
  3240. (forward-char (- (1- (length start-delim)))) ;; for delimiter
  3241. (unless (bolp)
  3242. (forward-char -1))
  3243. (when (looking-at regex)
  3244. (markdown-unwrap-thing-at-point nil start-group end-group)))
  3245. (if (thing-at-point-looking-at regex)
  3246. (markdown-unwrap-thing-at-point nil start-group end-group)
  3247. (markdown-wrap-or-insert start-delim end-delim 'word nil nil)))))
  3248. (defun markdown-insert-bold ()
  3249. "Insert markup to make a region or word bold.
  3250. If there is an active region, make the region bold. If the point
  3251. is at a non-bold word, make the word bold. If the point is at a
  3252. bold word or phrase, remove the bold markup. Otherwise, simply
  3253. insert bold delimiters and place the point in between them."
  3254. (interactive)
  3255. (let ((delim (if markdown-bold-underscore "__" "**")))
  3256. (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t)))
  3257. (defun markdown-insert-italic ()
  3258. "Insert markup to make a region or word italic.
  3259. If there is an active region, make the region italic. If the point
  3260. is at a non-italic word, make the word italic. If the point is at an
  3261. italic word or phrase, remove the italic markup. Otherwise, simply
  3262. insert italic delimiters and place the point in between them."
  3263. (interactive)
  3264. (let ((delim (if markdown-italic-underscore "_" "*")))
  3265. (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t)))
  3266. (defun markdown-insert-strike-through ()
  3267. "Insert markup to make a region or word strikethrough.
  3268. If there is an active region, make the region strikethrough. If the point
  3269. is at a non-bold word, make the word strikethrough. If the point is at a
  3270. strikethrough word or phrase, remove the strikethrough markup. Otherwise,
  3271. simply insert bold delimiters and place the point in between them."
  3272. (interactive)
  3273. (markdown--insert-common
  3274. "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t))
  3275. (defun markdown-insert-code ()
  3276. "Insert markup to make a region or word an inline code fragment.
  3277. If there is an active region, make the region an inline code
  3278. fragment. If the point is at a word, make the word an inline
  3279. code fragment. Otherwise, simply insert code delimiters and
  3280. place the point in between them."
  3281. (interactive)
  3282. (if (use-region-p)
  3283. ;; Active region
  3284. (let ((bounds (markdown-unwrap-things-in-region
  3285. (region-beginning) (region-end)
  3286. markdown-regex-code 1 3)))
  3287. (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds)))
  3288. ;; Code markup removal, code markup for word, or empty markup insertion
  3289. (if (markdown-inline-code-at-point)
  3290. (markdown-unwrap-thing-at-point nil 0 2)
  3291. (markdown-wrap-or-insert "`" "`" 'word nil nil))))
  3292. (defun markdown-insert-kbd ()
  3293. "Insert markup to wrap region or word in <kbd> tags.
  3294. If there is an active region, use the region. If the point is at
  3295. a word, use the word. Otherwise, simply insert <kbd> tags and
  3296. place the point in between them."
  3297. (interactive)
  3298. (if (use-region-p)
  3299. ;; Active region
  3300. (let ((bounds (markdown-unwrap-things-in-region
  3301. (region-beginning) (region-end)
  3302. markdown-regex-kbd 0 2)))
  3303. (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds)))
  3304. ;; Markup removal, markup for word, or empty markup insertion
  3305. (if (thing-at-point-looking-at markdown-regex-kbd)
  3306. (markdown-unwrap-thing-at-point nil 0 2)
  3307. (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil))))
  3308. (defun markdown-insert-inline-link (text url &optional title)
  3309. "Insert an inline link with TEXT pointing to URL.
  3310. Optionally, the user can provide a TITLE."
  3311. (let ((cur (point)))
  3312. (setq title (and title (concat " \"" title "\"")))
  3313. (insert (concat "[" text "](" url title ")"))
  3314. (cond ((not text) (goto-char (+ 1 cur)))
  3315. ((not url) (goto-char (+ 3 (length text) cur))))))
  3316. (defun markdown-insert-inline-image (text url &optional title)
  3317. "Insert an inline link with alt TEXT pointing to URL.
  3318. Optionally, also provide a TITLE."
  3319. (let ((cur (point)))
  3320. (setq title (and title (concat " \"" title "\"")))
  3321. (insert (concat "![" text "](" url title ")"))
  3322. (cond ((not text) (goto-char (+ 2 cur)))
  3323. ((not url) (goto-char (+ 4 (length text) cur))))))
  3324. (defun markdown-insert-reference-link (text label &optional url title)
  3325. "Insert a reference link and, optionally, a reference definition.
  3326. The link TEXT will be inserted followed by the optional LABEL.
  3327. If a URL is given, also insert a definition for the reference
  3328. LABEL according to `markdown-reference-location'. If a TITLE is
  3329. given, it will be added to the end of the reference definition
  3330. and will be used to populate the title attribute when converted
  3331. to XHTML. If URL is nil, insert only the link portion (for
  3332. example, when a reference label is already defined)."
  3333. (insert (concat "[" text "][" label "]"))
  3334. (when url
  3335. (markdown-insert-reference-definition
  3336. (if (string-equal label "") text label)
  3337. url title)))
  3338. (defun markdown-insert-reference-image (text label &optional url title)
  3339. "Insert a reference image and, optionally, a reference definition.
  3340. The alt TEXT will be inserted followed by the optional LABEL.
  3341. If a URL is given, also insert a definition for the reference
  3342. LABEL according to `markdown-reference-location'. If a TITLE is
  3343. given, it will be added to the end of the reference definition
  3344. and will be used to populate the title attribute when converted
  3345. to XHTML. If URL is nil, insert only the link portion (for
  3346. example, when a reference label is already defined)."
  3347. (insert (concat "![" text "][" label "]"))
  3348. (when url
  3349. (markdown-insert-reference-definition
  3350. (if (string-equal label "") text label)
  3351. url title)))
  3352. (defun markdown-insert-reference-definition (label &optional url title)
  3353. "Add definition for reference LABEL with URL and TITLE.
  3354. LABEL is a Markdown reference label without square brackets.
  3355. URL and TITLE are optional. When given, the TITLE will
  3356. be used to populate the title attribute when converted to XHTML."
  3357. ;; END specifies where to leave the point upon return
  3358. (let ((end (point)))
  3359. (cl-case markdown-reference-location
  3360. (end (goto-char (point-max)))
  3361. (immediately (markdown-end-of-text-block))
  3362. (subtree (markdown-end-of-subtree))
  3363. (header (markdown-end-of-defun)))
  3364. ;; Skip backwards over local variables. This logic is similar to the one
  3365. ;; used in ‘hack-local-variables’.
  3366. (when (and enable-local-variables (eobp))
  3367. (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move)
  3368. (when (let ((case-fold-search t))
  3369. (search-forward "Local Variables:" nil :move))
  3370. (beginning-of-line 0)
  3371. (when (eq (char-before) ?\n) (backward-char))))
  3372. (unless (or (markdown-cur-line-blank-p)
  3373. (thing-at-point-looking-at markdown-regex-reference-definition))
  3374. (insert "\n"))
  3375. (insert "\n[" label "]: ")
  3376. (if url
  3377. (insert url)
  3378. ;; When no URL is given, leave point at END following the colon
  3379. (setq end (point)))
  3380. (when (> (length title) 0)
  3381. (insert " \"" title "\""))
  3382. (unless (looking-at-p "\n")
  3383. (insert "\n"))
  3384. (goto-char end)
  3385. (when url
  3386. (message
  3387. (markdown--substitute-command-keys
  3388. "Reference [%s] was defined, press \\[markdown-do] to jump there")
  3389. label))))
  3390. (defcustom markdown-link-make-text-function nil
  3391. "Function that automatically generates a link text for a URL.
  3392. If non-nil, this function will be called by
  3393. `markdown--insert-link-or-image' and the result will be the
  3394. default link text. The function should receive exactly one
  3395. argument that corresponds to the link URL."
  3396. :group 'markdown
  3397. :type 'function
  3398. :package-version '(markdown-mode . "2.5"))
  3399. (defcustom markdown-disable-tooltip-prompt nil
  3400. "Disable prompt for tooltip when inserting a link or image.
  3401. If non-nil, `markdown-insert-link' and `markdown-insert-link'
  3402. will not prompt the user to insert a tooltip text for the given
  3403. link or image."
  3404. :group 'markdown
  3405. :type 'boolean
  3406. :safe 'booleanp
  3407. :package-version '(markdown-mode . "2.5"))
  3408. (defun markdown--insert-link-or-image (image)
  3409. "Interactively insert new or update an existing link or image.
  3410. When IMAGE is non-nil, insert an image. Otherwise, insert a link.
  3411. This is an internal function called by
  3412. `markdown-insert-link' and `markdown-insert-image'."
  3413. (cl-multiple-value-bind (begin end text uri ref title)
  3414. (if (use-region-p)
  3415. ;; Use region as either link text or URL as appropriate.
  3416. (let ((region (buffer-substring-no-properties
  3417. (region-beginning) (region-end))))
  3418. (if (string-match markdown-regex-uri region)
  3419. ;; Region contains a URL; use it as such.
  3420. (list (region-beginning) (region-end)
  3421. nil (match-string 0 region) nil nil)
  3422. ;; Region doesn't contain a URL, so use it as text.
  3423. (list (region-beginning) (region-end)
  3424. region nil nil nil)))
  3425. ;; Extract and use properties of existing link, if any.
  3426. (markdown-link-at-pos (point)))
  3427. (let* ((ref (when ref (concat "[" ref "]")))
  3428. (defined-refs (mapcar #'car (markdown-get-defined-references)))
  3429. (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs))
  3430. (used-uris (markdown-get-used-uris))
  3431. (uri-or-ref (completing-read
  3432. "URL or [reference]: "
  3433. (append defined-ref-cands used-uris)
  3434. nil nil (or uri ref)))
  3435. (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref)
  3436. (match-string 1 uri-or-ref))
  3437. ((string-equal "" uri-or-ref)
  3438. "")))
  3439. (uri (unless ref uri-or-ref))
  3440. (text-prompt (if image
  3441. "Alt text: "
  3442. (if ref
  3443. "Link text: "
  3444. "Link text (blank for plain URL): ")))
  3445. (text (or text (and markdown-link-make-text-function uri
  3446. (funcall markdown-link-make-text-function uri))))
  3447. (text (completing-read text-prompt defined-refs nil nil text))
  3448. (text (if (= (length text) 0) nil text))
  3449. (plainp (and uri (not text)))
  3450. (implicitp (string-equal ref ""))
  3451. (ref (if implicitp text ref))
  3452. (definedp (and ref (markdown-reference-definition ref)))
  3453. (ref-url (unless (or uri definedp)
  3454. (completing-read "Reference URL: " used-uris)))
  3455. (title (unless (or plainp definedp markdown-disable-tooltip-prompt)
  3456. (read-string "Title (tooltip text, optional): " title)))
  3457. (title (if (= (length title) 0) nil title)))
  3458. (when (and image implicitp)
  3459. (user-error "Reference required: implicit image references are invalid"))
  3460. (when (and begin end)
  3461. (delete-region begin end))
  3462. (cond
  3463. ((and (not image) uri text)
  3464. (markdown-insert-inline-link text uri title))
  3465. ((and image uri text)
  3466. (markdown-insert-inline-image text uri title))
  3467. ((and ref text)
  3468. (if image
  3469. (markdown-insert-reference-image text (unless implicitp ref) nil title)
  3470. (markdown-insert-reference-link text (unless implicitp ref) nil title))
  3471. (unless definedp
  3472. (markdown-insert-reference-definition ref ref-url title)))
  3473. ((and (not image) uri)
  3474. (markdown-insert-uri uri))))))
  3475. (defun markdown-insert-link ()
  3476. "Insert new or update an existing link, with interactive prompts.
  3477. If the point is at an existing link or URL, update the link text,
  3478. URL, reference label, and/or title. Otherwise, insert a new link.
  3479. The type of link inserted (inline, reference, or plain URL)
  3480. depends on which values are provided:
  3481. * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
  3482. * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
  3483. * If only TEXT is given, insert an implicit reference link: [TEXT][].
  3484. * If only a URL is given, insert a plain link: <URL>.
  3485. In other words, to create an implicit reference link, leave the
  3486. URL prompt empty and to create a plain URL link, leave the link
  3487. text empty.
  3488. If there is an active region, use the text as the default URL, if
  3489. it seems to be a URL, or link text value otherwise.
  3490. If a given reference is not defined, this function will
  3491. additionally prompt for the URL and optional title. In this case,
  3492. the reference definition is placed at the location determined by
  3493. `markdown-reference-location'. In addition, it is possible to
  3494. have the `markdown-link-make-text-function' function, if non-nil,
  3495. define the default link text before prompting the user for it.
  3496. If `markdown-disable-tooltip-prompt' is non-nil, the user will
  3497. not be prompted to add or modify a tooltip text.
  3498. Through updating the link, this function can be used to convert a
  3499. link of one type (inline, reference, or plain) to another type by
  3500. selectively adding or removing information via the prompts."
  3501. (interactive)
  3502. (markdown--insert-link-or-image nil))
  3503. (defun markdown-insert-image ()
  3504. "Insert new or update an existing image, with interactive prompts.
  3505. If the point is at an existing image, update the alt text, URL,
  3506. reference label, and/or title. Otherwise, insert a new image.
  3507. The type of image inserted (inline or reference) depends on which
  3508. values are provided:
  3509. * If a URL and ALT-TEXT are given, insert an inline image:
  3510. ![ALT-TEXT](URL).
  3511. * If [REF] and ALT-TEXT are given, insert a reference image:
  3512. ![ALT-TEXT][REF].
  3513. If there is an active region, use the text as the default URL, if
  3514. it seems to be a URL, or alt text value otherwise.
  3515. If a given reference is not defined, this function will
  3516. additionally prompt for the URL and optional title. In this case,
  3517. the reference definition is placed at the location determined by
  3518. `markdown-reference-location'.
  3519. Through updating the image, this function can be used to convert an
  3520. image of one type (inline or reference) to another type by
  3521. selectively adding or removing information via the prompts."
  3522. (interactive)
  3523. (markdown--insert-link-or-image t))
  3524. (defun markdown-insert-uri (&optional uri)
  3525. "Insert markup for an inline URI.
  3526. If there is an active region, use it as the URI. If the point is
  3527. at a URI, wrap it with angle brackets. If the point is at an
  3528. inline URI, remove the angle brackets. Otherwise, simply insert
  3529. angle brackets place the point between them."
  3530. (interactive)
  3531. (if (use-region-p)
  3532. ;; Active region
  3533. (let ((bounds (markdown-unwrap-things-in-region
  3534. (region-beginning) (region-end)
  3535. markdown-regex-angle-uri 0 2)))
  3536. (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds)))
  3537. ;; Markup removal, URI at point, new URI, or empty markup insertion
  3538. (if (thing-at-point-looking-at markdown-regex-angle-uri)
  3539. (markdown-unwrap-thing-at-point nil 0 2)
  3540. (if uri
  3541. (insert "<" uri ">")
  3542. (markdown-wrap-or-insert "<" ">" 'url nil nil)))))
  3543. (defun markdown-insert-wiki-link ()
  3544. "Insert a wiki link of the form [[WikiLink]].
  3545. If there is an active region, use the region as the link text.
  3546. If the point is at a word, use the word as the link text. If
  3547. there is no active region and the point is not at word, simply
  3548. insert link markup."
  3549. (interactive)
  3550. (if (use-region-p)
  3551. ;; Active region
  3552. (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end))
  3553. ;; Markup removal, wiki link at at point, or empty markup insertion
  3554. (if (thing-at-point-looking-at markdown-regex-wiki-link)
  3555. (if (or markdown-wiki-link-alias-first
  3556. (null (match-string 5)))
  3557. (markdown-unwrap-thing-at-point nil 1 3)
  3558. (markdown-unwrap-thing-at-point nil 1 5))
  3559. (markdown-wrap-or-insert "[[" "]]"))))
  3560. (defun markdown-remove-header ()
  3561. "Remove header markup if point is at a header.
  3562. Return bounds of remaining header text if a header was removed
  3563. and nil otherwise."
  3564. (interactive "*")
  3565. (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2)
  3566. (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1)))
  3567. (defun markdown-insert-header (&optional level text setext)
  3568. "Insert or replace header markup.
  3569. The level of the header is specified by LEVEL and header text is
  3570. given by TEXT. LEVEL must be an integer from 1 and 6, and the
  3571. default value is 1.
  3572. When TEXT is nil, the header text is obtained as follows.
  3573. If there is an active region, it is used as the header text.
  3574. Otherwise, the current line will be used as the header text.
  3575. If there is not an active region and the point is at a header,
  3576. remove the header markup and replace with level N header.
  3577. Otherwise, insert empty header markup and place the point in
  3578. between.
  3579. The style of the header will be atx (hash marks) unless
  3580. SETEXT is non-nil, in which case a setext-style (underlined)
  3581. header will be inserted."
  3582. (interactive "p\nsHeader text: ")
  3583. (setq level (min (max (or level 1) 1) (if setext 2 6)))
  3584. ;; Determine header text if not given
  3585. (when (null text)
  3586. (if (use-region-p)
  3587. ;; Active region
  3588. (setq text (delete-and-extract-region (region-beginning) (region-end)))
  3589. ;; No active region
  3590. (markdown-remove-header)
  3591. (setq text (delete-and-extract-region
  3592. (line-beginning-position) (line-end-position)))
  3593. (when (and setext (string-match-p "^[ \t]*$" text))
  3594. (setq text (read-string "Header text: "))))
  3595. (setq text (markdown-compress-whitespace-string text)))
  3596. ;; Insertion with given text
  3597. (markdown-ensure-blank-line-before)
  3598. (let (hdr)
  3599. (cond (setext
  3600. (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=)))
  3601. (insert text "\n" hdr))
  3602. (t
  3603. (setq hdr (make-string level ?#))
  3604. (insert hdr " " text)
  3605. (when (null markdown-asymmetric-header) (insert " " hdr)))))
  3606. (markdown-ensure-blank-line-after)
  3607. ;; Leave point at end of text
  3608. (cond (setext
  3609. (backward-char (1+ (string-width text))))
  3610. ((null markdown-asymmetric-header)
  3611. (backward-char (1+ level)))))
  3612. (defun markdown-insert-header-dwim (&optional arg setext)
  3613. "Insert or replace header markup.
  3614. The level and type of the header are determined automatically by
  3615. the type and level of the previous header, unless a prefix
  3616. argument is given via ARG.
  3617. With a numeric prefix valued 1 to 6, insert a header of the given
  3618. level, with the type being determined automatically (note that
  3619. only level 1 or 2 setext headers are possible).
  3620. With a \\[universal-argument] prefix (i.e., when ARG is (4)),
  3621. promote the heading by one level.
  3622. With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
  3623. demote the heading by one level.
  3624. When SETEXT is non-nil, prefer setext-style headers when
  3625. possible (levels one and two).
  3626. When there is an active region, use it for the header text. When
  3627. the point is at an existing header, change the type and level
  3628. according to the rules above.
  3629. Otherwise, if the line is not empty, create a header using the
  3630. text on the current line as the header text.
  3631. Finally, if the point is on a blank line, insert empty header
  3632. markup (atx) or prompt for text (setext).
  3633. See `markdown-insert-header' for more details about how the
  3634. header text is determined."
  3635. (interactive "*P")
  3636. (let (level)
  3637. (save-excursion
  3638. (when (or (thing-at-point-looking-at markdown-regex-header)
  3639. (re-search-backward markdown-regex-header nil t))
  3640. ;; level of current or previous header
  3641. (setq level (markdown-outline-level))
  3642. ;; match group 1 indicates a setext header
  3643. (setq setext (match-end 1))))
  3644. ;; check prefix argument
  3645. (cond
  3646. ((and (equal arg '(4)) level (> level 1)) ;; C-u
  3647. (cl-decf level))
  3648. ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u
  3649. (cl-incf level))
  3650. (arg ;; numeric prefix
  3651. (setq level (prefix-numeric-value arg))))
  3652. ;; setext headers must be level one or two
  3653. (and level (setq setext (and setext (<= level 2))))
  3654. ;; insert the heading
  3655. (markdown-insert-header level nil setext)))
  3656. (defun markdown-insert-header-setext-dwim (&optional arg)
  3657. "Insert or replace header markup, with preference for setext.
  3658. See `markdown-insert-header-dwim' for details, including how ARG is handled."
  3659. (interactive "*P")
  3660. (markdown-insert-header-dwim arg t))
  3661. (defun markdown-insert-header-atx-1 ()
  3662. "Insert a first level atx-style (hash mark) header.
  3663. See `markdown-insert-header'."
  3664. (interactive "*")
  3665. (markdown-insert-header 1 nil nil))
  3666. (defun markdown-insert-header-atx-2 ()
  3667. "Insert a level two atx-style (hash mark) header.
  3668. See `markdown-insert-header'."
  3669. (interactive "*")
  3670. (markdown-insert-header 2 nil nil))
  3671. (defun markdown-insert-header-atx-3 ()
  3672. "Insert a level three atx-style (hash mark) header.
  3673. See `markdown-insert-header'."
  3674. (interactive "*")
  3675. (markdown-insert-header 3 nil nil))
  3676. (defun markdown-insert-header-atx-4 ()
  3677. "Insert a level four atx-style (hash mark) header.
  3678. See `markdown-insert-header'."
  3679. (interactive "*")
  3680. (markdown-insert-header 4 nil nil))
  3681. (defun markdown-insert-header-atx-5 ()
  3682. "Insert a level five atx-style (hash mark) header.
  3683. See `markdown-insert-header'."
  3684. (interactive "*")
  3685. (markdown-insert-header 5 nil nil))
  3686. (defun markdown-insert-header-atx-6 ()
  3687. "Insert a sixth level atx-style (hash mark) header.
  3688. See `markdown-insert-header'."
  3689. (interactive "*")
  3690. (markdown-insert-header 6 nil nil))
  3691. (defun markdown-insert-header-setext-1 ()
  3692. "Insert a setext-style (underlined) first-level header.
  3693. See `markdown-insert-header'."
  3694. (interactive "*")
  3695. (markdown-insert-header 1 nil t))
  3696. (defun markdown-insert-header-setext-2 ()
  3697. "Insert a setext-style (underlined) second-level header.
  3698. See `markdown-insert-header'."
  3699. (interactive "*")
  3700. (markdown-insert-header 2 nil t))
  3701. (defun markdown-blockquote-indentation (loc)
  3702. "Return string containing necessary indentation for a blockquote at LOC.
  3703. Also see `markdown-pre-indentation'."
  3704. (save-excursion
  3705. (goto-char loc)
  3706. (let* ((list-level (length (markdown-calculate-list-levels)))
  3707. (indent ""))
  3708. (dotimes (_ list-level indent)
  3709. (setq indent (concat indent " "))))))
  3710. (defun markdown-insert-blockquote ()
  3711. "Start a blockquote section (or blockquote the region).
  3712. If Transient Mark mode is on and a region is active, it is used as
  3713. the blockquote text."
  3714. (interactive)
  3715. (if (use-region-p)
  3716. (markdown-blockquote-region (region-beginning) (region-end))
  3717. (markdown-ensure-blank-line-before)
  3718. (insert (markdown-blockquote-indentation (point)) "> ")
  3719. (markdown-ensure-blank-line-after)))
  3720. (defun markdown-block-region (beg end prefix)
  3721. "Format the region using a block prefix.
  3722. Arguments BEG and END specify the beginning and end of the
  3723. region. The characters PREFIX will appear at the beginning
  3724. of each line."
  3725. (save-excursion
  3726. (let* ((end-marker (make-marker))
  3727. (beg-marker (make-marker))
  3728. (prefix-without-trailing-whitespace
  3729. (replace-regexp-in-string (rx (+ blank) eos) "" prefix)))
  3730. ;; Ensure blank line after and remove extra whitespace
  3731. (goto-char end)
  3732. (skip-syntax-backward "-")
  3733. (set-marker end-marker (point))
  3734. (delete-horizontal-space)
  3735. (markdown-ensure-blank-line-after)
  3736. ;; Ensure blank line before and remove extra whitespace
  3737. (goto-char beg)
  3738. (skip-syntax-forward "-")
  3739. (delete-horizontal-space)
  3740. (markdown-ensure-blank-line-before)
  3741. (set-marker beg-marker (point))
  3742. ;; Insert PREFIX before each line
  3743. (goto-char beg-marker)
  3744. (while (and (< (line-beginning-position) end-marker)
  3745. (not (eobp)))
  3746. ;; Don’t insert trailing whitespace.
  3747. (insert (if (eolp) prefix-without-trailing-whitespace prefix))
  3748. (forward-line)))))
  3749. (defun markdown-blockquote-region (beg end)
  3750. "Blockquote the region.
  3751. Arguments BEG and END specify the beginning and end of the region."
  3752. (interactive "*r")
  3753. (markdown-block-region
  3754. beg end (concat (markdown-blockquote-indentation
  3755. (max (point-min) (1- beg))) "> ")))
  3756. (defun markdown-pre-indentation (loc)
  3757. "Return string containing necessary whitespace for a pre block at LOC.
  3758. Also see `markdown-blockquote-indentation'."
  3759. (save-excursion
  3760. (goto-char loc)
  3761. (let* ((list-level (length (markdown-calculate-list-levels)))
  3762. indent)
  3763. (dotimes (_ (1+ list-level) indent)
  3764. (setq indent (concat indent " "))))))
  3765. (defun markdown-insert-pre ()
  3766. "Start a preformatted section (or apply to the region).
  3767. If Transient Mark mode is on and a region is active, it is marked
  3768. as preformatted text."
  3769. (interactive)
  3770. (if (use-region-p)
  3771. (markdown-pre-region (region-beginning) (region-end))
  3772. (markdown-ensure-blank-line-before)
  3773. (insert (markdown-pre-indentation (point)))
  3774. (markdown-ensure-blank-line-after)))
  3775. (defun markdown-pre-region (beg end)
  3776. "Format the region as preformatted text.
  3777. Arguments BEG and END specify the beginning and end of the region."
  3778. (interactive "*r")
  3779. (let ((indent (markdown-pre-indentation (max (point-min) (1- beg)))))
  3780. (markdown-block-region beg end indent)))
  3781. (defun markdown-electric-backquote (arg)
  3782. "Insert a backquote.
  3783. The numeric prefix argument ARG says how many times to repeat the insertion.
  3784. Call `markdown-insert-gfm-code-block' interactively
  3785. if three backquotes inserted at the beginning of line."
  3786. (interactive "*P")
  3787. (self-insert-command (prefix-numeric-value arg))
  3788. (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil))
  3789. (replace-match "")
  3790. (call-interactively #'markdown-insert-gfm-code-block)))
  3791. (defconst markdown-gfm-recognized-languages
  3792. ;; To reproduce/update, evaluate the let-form in
  3793. ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
  3794. ;; but with appropriate use of a keyboard macro, indenting and filling it
  3795. ;; properly is pretty fast.
  3796. '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
  3797. "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada"
  3798. "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer"
  3799. "AngelScript" "Ant-Build-System" "ApacheConf" "Apex"
  3800. "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly"
  3801. "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile"
  3802. "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax"
  3803. "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump"
  3804. "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb"
  3805. "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
  3806. "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
  3807. "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript"
  3808. "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language"
  3809. "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound"
  3810. "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump"
  3811. "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch"
  3812. "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript"
  3813. "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild"
  3814. "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm"
  3815. "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor"
  3816. "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth"
  3817. "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS"
  3818. "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN"
  3819. "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass"
  3820. "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config"
  3821. "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu"
  3822. "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL"
  3823. "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML"
  3824. "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP"
  3825. "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC"
  3826. "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7"
  3827. "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON"
  3828. "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java"
  3829. "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison"
  3830. "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout"
  3831. "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE"
  3832. "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
  3833. "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
  3834. "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript"
  3835. "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB"
  3836. "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako"
  3837. "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki"
  3838. "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah"
  3839. "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode"
  3840. "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL"
  3841. "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
  3842. "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
  3843. "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C"
  3844. "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal"
  3845. "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript"
  3846. "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox"
  3847. "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus"
  3848. "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn"
  3849. "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod"
  3850. "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell"
  3851. "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer"
  3852. "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
  3853. "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc"
  3854. "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket"
  3855. "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol"
  3856. "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript"
  3857. "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage"
  3858. "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
  3859. "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass"
  3860. "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
  3861. "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity"
  3862. "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark"
  3863. "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift"
  3864. "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh"
  3865. "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle"
  3866. "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
  3867. "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL"
  3868. "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue"
  3869. "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly"
  3870. "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok"
  3871. "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap"
  3872. "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS"
  3873. "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL"
  3874. "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors"
  3875. "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc"
  3876. "reStructuredText" "sed" "wdl" "wisp" "xBase")
  3877. "Language specifiers recognized by GitHub's syntax highlighting features.")
  3878. (defvar-local markdown-gfm-used-languages nil
  3879. "Language names used in GFM code blocks.")
  3880. (defun markdown-trim-whitespace (str)
  3881. (replace-regexp-in-string
  3882. "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str))
  3883. (defun markdown-clean-language-string (str)
  3884. (replace-regexp-in-string
  3885. "{\\.?\\|}" "" (markdown-trim-whitespace str)))
  3886. (defun markdown-validate-language-string (widget)
  3887. (let ((str (widget-value widget)))
  3888. (unless (string= str (markdown-clean-language-string str))
  3889. (widget-put widget :error (format "Invalid language spec: '%s'" str))
  3890. widget)))
  3891. (defun markdown-gfm-get-corpus ()
  3892. "Create corpus of recognized GFM code block languages for the given buffer."
  3893. (let ((given-corpus (append markdown-gfm-additional-languages
  3894. markdown-gfm-recognized-languages)))
  3895. (append
  3896. markdown-gfm-used-languages
  3897. (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus)
  3898. given-corpus))))
  3899. (defun markdown-gfm-add-used-language (lang)
  3900. "Clean LANG and add to list of used languages."
  3901. (setq markdown-gfm-used-languages
  3902. (cons lang (remove lang markdown-gfm-used-languages))))
  3903. (defcustom markdown-spaces-after-code-fence 1
  3904. "Number of space characters to insert after a code fence.
  3905. \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
  3906. opening code fence and an info string."
  3907. :group 'markdown
  3908. :type 'integer
  3909. :safe #'natnump
  3910. :package-version '(markdown-mode . "2.3"))
  3911. (defcustom markdown-code-block-braces nil
  3912. "When non-nil, automatically insert braces for GFM code blocks."
  3913. :group 'markdown
  3914. :type 'boolean)
  3915. (defun markdown-insert-gfm-code-block (&optional lang edit)
  3916. "Insert GFM code block for language LANG.
  3917. If LANG is nil, the language will be queried from user. If a
  3918. region is active, wrap this region with the markup instead. If
  3919. the region boundaries are not on empty lines, these are added
  3920. automatically in order to have the correct markup. When EDIT is
  3921. non-nil (e.g., when \\[universal-argument] is given), edit the
  3922. code block in an indirect buffer after insertion."
  3923. (interactive
  3924. (list (let ((completion-ignore-case nil))
  3925. (condition-case nil
  3926. (markdown-clean-language-string
  3927. (completing-read
  3928. "Programming language: "
  3929. (markdown-gfm-get-corpus)
  3930. nil 'confirm (car markdown-gfm-used-languages)
  3931. 'markdown-gfm-language-history))
  3932. (quit "")))
  3933. current-prefix-arg))
  3934. (unless (string= lang "") (markdown-gfm-add-used-language lang))
  3935. (when (and (> (length lang) 0)
  3936. (not markdown-code-block-braces))
  3937. (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s)
  3938. lang)))
  3939. (let ((gfm-open-brace (if markdown-code-block-braces "{" ""))
  3940. (gfm-close-brace (if markdown-code-block-braces "}" "")))
  3941. (if (use-region-p)
  3942. (let* ((b (region-beginning)) (e (region-end)) end
  3943. (indent (progn (goto-char b) (current-indentation))))
  3944. (goto-char e)
  3945. ;; if we're on a blank line, don't newline, otherwise the ```
  3946. ;; should go on its own line
  3947. (unless (looking-back "\n" nil)
  3948. (newline))
  3949. (indent-to indent)
  3950. (insert "```")
  3951. (markdown-ensure-blank-line-after)
  3952. (setq end (point))
  3953. (goto-char b)
  3954. ;; if we're on a blank line, insert the quotes here, otherwise
  3955. ;; add a new line first
  3956. (unless (looking-at-p "\n")
  3957. (newline)
  3958. (forward-line -1))
  3959. (markdown-ensure-blank-line-before)
  3960. (indent-to indent)
  3961. (insert "```" gfm-open-brace lang gfm-close-brace)
  3962. (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end))
  3963. (let ((indent (current-indentation))
  3964. start-bol)
  3965. (delete-horizontal-space :backward-only)
  3966. (markdown-ensure-blank-line-before)
  3967. (indent-to indent)
  3968. (setq start-bol (point-at-bol))
  3969. (insert "```" gfm-open-brace lang gfm-close-brace "\n")
  3970. (indent-to indent)
  3971. (unless edit (insert ?\n))
  3972. (indent-to indent)
  3973. (insert "```")
  3974. (markdown-ensure-blank-line-after)
  3975. (markdown-syntax-propertize-fenced-block-constructs start-bol (point)))
  3976. (end-of-line 0)
  3977. (when edit (markdown-edit-code-block)))))
  3978. (defun markdown-code-block-lang (&optional pos-prop)
  3979. "Return the language name for a GFM or tilde fenced code block.
  3980. The beginning of the block may be described by POS-PROP,
  3981. a cons of (pos . prop) giving the position and property
  3982. at the beginning of the block."
  3983. (or pos-prop
  3984. (setq pos-prop
  3985. (markdown-max-of-seq
  3986. #'car
  3987. (cl-remove-if
  3988. #'null
  3989. (cl-mapcar
  3990. #'markdown-find-previous-prop
  3991. (markdown-get-fenced-block-begin-properties))))))
  3992. (when pos-prop
  3993. (goto-char (car pos-prop))
  3994. (set-match-data (get-text-property (point) (cdr pos-prop)))
  3995. ;; Note: Hard-coded group number assumes tilde
  3996. ;; and GFM fenced code regexp groups agree.
  3997. (let ((begin (match-beginning 3))
  3998. (end (match-end 3)))
  3999. (when (and begin end)
  4000. ;; Fix language strings beginning with periods, like ".ruby".
  4001. (when (eq (char-after begin) ?.)
  4002. (setq begin (1+ begin)))
  4003. (buffer-substring-no-properties begin end)))))
  4004. (defun markdown-gfm-parse-buffer-for-languages (&optional buffer)
  4005. (with-current-buffer (or buffer (current-buffer))
  4006. (save-excursion
  4007. (goto-char (point-min))
  4008. (cl-loop
  4009. with prop = 'markdown-gfm-block-begin
  4010. for pos-prop = (markdown-find-next-prop prop)
  4011. while pos-prop
  4012. for lang = (markdown-code-block-lang pos-prop)
  4013. do (progn (when lang (markdown-gfm-add-used-language lang))
  4014. (goto-char (next-single-property-change (point) prop)))))))
  4015. (defun markdown-insert-foldable-block ()
  4016. "Insert details disclosure element to make content foldable.
  4017. If a region is active, wrap this region with the disclosure
  4018. element. More detais here 'https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details'."
  4019. (interactive)
  4020. (let ((details-open-tag "<details>")
  4021. (details-close-tag "</details>")
  4022. (summary-open-tag "<summary>")
  4023. (summary-close-tag " </summary>"))
  4024. (if (use-region-p)
  4025. (let* ((b (region-beginning))
  4026. (e (region-end))
  4027. (indent (progn (goto-char b) (current-indentation))))
  4028. (goto-char e)
  4029. ;; if we're on a blank line, don't newline, otherwise the tags
  4030. ;; should go on its own line
  4031. (unless (looking-back "\n" nil)
  4032. (newline))
  4033. (indent-to indent)
  4034. (insert details-close-tag)
  4035. (markdown-ensure-blank-line-after)
  4036. (goto-char b)
  4037. ;; if we're on a blank line, insert the quotes here, otherwise
  4038. ;; add a new line first
  4039. (unless (looking-at-p "\n")
  4040. (newline)
  4041. (forward-line -1))
  4042. (markdown-ensure-blank-line-before)
  4043. (indent-to indent)
  4044. (insert details-open-tag "\n")
  4045. (insert summary-open-tag summary-close-tag)
  4046. (search-backward summary-close-tag))
  4047. (let ((indent (current-indentation)))
  4048. (delete-horizontal-space :backward-only)
  4049. (markdown-ensure-blank-line-before)
  4050. (indent-to indent)
  4051. (insert details-open-tag "\n")
  4052. (insert summary-open-tag summary-close-tag "\n")
  4053. (insert details-close-tag)
  4054. (indent-to indent)
  4055. (markdown-ensure-blank-line-after)
  4056. (search-backward summary-close-tag)))))
  4057. ;;; Footnotes =================================================================
  4058. (defun markdown-footnote-counter-inc ()
  4059. "Increment `markdown-footnote-counter' and return the new value."
  4060. (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet.
  4061. (save-excursion
  4062. (goto-char (point-min))
  4063. (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:")
  4064. (point-max) t)
  4065. (let ((fn (string-to-number (match-string 1))))
  4066. (when (> fn markdown-footnote-counter)
  4067. (setq markdown-footnote-counter fn))))))
  4068. (cl-incf markdown-footnote-counter))
  4069. (defun markdown-insert-footnote ()
  4070. "Insert footnote with a new number and move point to footnote definition."
  4071. (interactive)
  4072. (let ((fn (markdown-footnote-counter-inc)))
  4073. (insert (format "[^%d]" fn))
  4074. (markdown-footnote-text-find-new-location)
  4075. (markdown-ensure-blank-line-before)
  4076. (unless (markdown-cur-line-blank-p)
  4077. (insert "\n"))
  4078. (insert (format "[^%d]: " fn))
  4079. (markdown-ensure-blank-line-after)))
  4080. (defun markdown-footnote-text-find-new-location ()
  4081. "Position the point at the proper location for a new footnote text."
  4082. (cond
  4083. ((eq markdown-footnote-location 'end) (goto-char (point-max)))
  4084. ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block))
  4085. ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree))
  4086. ((eq markdown-footnote-location 'header) (markdown-end-of-defun))))
  4087. (defun markdown-footnote-kill ()
  4088. "Kill the footnote at point.
  4089. The footnote text is killed (and added to the kill ring), the
  4090. footnote marker is deleted. Point has to be either at the
  4091. footnote marker or in the footnote text."
  4092. (interactive)
  4093. (let ((marker-pos nil)
  4094. (skip-deleting-marker nil)
  4095. (starting-footnote-text-positions
  4096. (markdown-footnote-text-positions)))
  4097. (when starting-footnote-text-positions
  4098. ;; We're starting in footnote text, so mark our return position and jump
  4099. ;; to the marker if possible.
  4100. (let ((marker-pos (markdown-footnote-find-marker
  4101. (cl-first starting-footnote-text-positions))))
  4102. (if marker-pos
  4103. (goto-char (1- marker-pos))
  4104. ;; If there isn't a marker, we still want to kill the text.
  4105. (setq skip-deleting-marker t))))
  4106. ;; Either we didn't start in the text, or we started in the text and jumped
  4107. ;; to the marker. We want to assume we're at the marker now and error if
  4108. ;; we're not.
  4109. (unless skip-deleting-marker
  4110. (let ((marker (markdown-footnote-delete-marker)))
  4111. (unless marker
  4112. (error "Not at a footnote"))
  4113. ;; Even if we knew the text position before, it changed when we deleted
  4114. ;; the label.
  4115. (setq marker-pos (cl-second marker))
  4116. (let ((new-text-pos (markdown-footnote-find-text (cl-first marker))))
  4117. (unless new-text-pos
  4118. (error "No text for footnote `%s'" (cl-first marker)))
  4119. (goto-char new-text-pos))))
  4120. (let ((pos (markdown-footnote-kill-text)))
  4121. (goto-char (if starting-footnote-text-positions
  4122. pos
  4123. marker-pos)))))
  4124. (defun markdown-footnote-delete-marker ()
  4125. "Delete a footnote marker at point.
  4126. Returns a list (ID START) containing the footnote ID and the
  4127. start position of the marker before deletion. If no footnote
  4128. marker was deleted, this function returns NIL."
  4129. (let ((marker (markdown-footnote-marker-positions)))
  4130. (when marker
  4131. (delete-region (cl-second marker) (cl-third marker))
  4132. (butlast marker))))
  4133. (defun markdown-footnote-kill-text ()
  4134. "Kill footnote text at point.
  4135. Returns the start position of the footnote text before deletion,
  4136. or NIL if point was not inside a footnote text.
  4137. The killed text is placed in the kill ring (without the footnote
  4138. number)."
  4139. (let ((fn (markdown-footnote-text-positions)))
  4140. (when fn
  4141. (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn))))
  4142. (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text)
  4143. (kill-new (match-string 1 text))
  4144. (when (and (markdown-cur-line-blank-p)
  4145. (markdown-prev-line-blank-p)
  4146. (not (bobp)))
  4147. (delete-region (1- (point)) (point)))
  4148. (cl-second fn)))))
  4149. (defun markdown-footnote-goto-text ()
  4150. "Jump to the text of the footnote at point."
  4151. (interactive)
  4152. (let ((fn (car (markdown-footnote-marker-positions))))
  4153. (unless fn
  4154. (user-error "Not at a footnote marker"))
  4155. (let ((new-pos (markdown-footnote-find-text fn)))
  4156. (unless new-pos
  4157. (error "No definition found for footnote `%s'" fn))
  4158. (goto-char new-pos))))
  4159. (defun markdown-footnote-return ()
  4160. "Return from a footnote to its footnote number in the main text."
  4161. (interactive)
  4162. (let ((fn (save-excursion
  4163. (car (markdown-footnote-text-positions)))))
  4164. (unless fn
  4165. (user-error "Not in a footnote"))
  4166. (let ((new-pos (markdown-footnote-find-marker fn)))
  4167. (unless new-pos
  4168. (error "Footnote marker `%s' not found" fn))
  4169. (goto-char new-pos))))
  4170. (defun markdown-footnote-find-marker (id)
  4171. "Find the location of the footnote marker with ID.
  4172. The actual buffer position returned is the position directly
  4173. following the marker's closing bracket. If no marker is found,
  4174. NIL is returned."
  4175. (save-excursion
  4176. (goto-char (point-min))
  4177. (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t)
  4178. (skip-chars-backward "^]")
  4179. (point))))
  4180. (defun markdown-footnote-find-text (id)
  4181. "Find the location of the text of footnote ID.
  4182. The actual buffer position returned is the position of the first
  4183. character of the text, after the footnote's identifier. If no
  4184. footnote text is found, NIL is returned."
  4185. (save-excursion
  4186. (goto-char (point-min))
  4187. (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t)
  4188. (skip-chars-forward "[ \t]")
  4189. (point))))
  4190. (defun markdown-footnote-marker-positions ()
  4191. "Return the position and ID of the footnote marker point is on.
  4192. The return value is a list (ID START END). If point is not on a
  4193. footnote, NIL is returned."
  4194. ;; first make sure we're at a footnote marker
  4195. (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position))
  4196. (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]")))
  4197. (save-excursion
  4198. ;; move point between [ and ^:
  4199. (if (looking-at-p "\\[")
  4200. (forward-char 1)
  4201. (skip-chars-backward "^["))
  4202. (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]"))
  4203. (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
  4204. (defun markdown-footnote-text-positions ()
  4205. "Return the start and end positions of the footnote text point is in.
  4206. The exact return value is a list of three elements: (ID START END).
  4207. The start position is the position of the opening bracket
  4208. of the footnote id. The end position is directly after the
  4209. newline that ends the footnote. If point is not in a footnote,
  4210. NIL is returned instead."
  4211. (save-excursion
  4212. (let (result)
  4213. (move-beginning-of-line 1)
  4214. ;; Try to find the label. If we haven't found the label and we're at a blank
  4215. ;; or indented line, back up if possible.
  4216. (while (and
  4217. (not (and (looking-at markdown-regex-footnote-definition)
  4218. (setq result (list (match-string 1) (point)))))
  4219. (and (not (bobp))
  4220. (or (markdown-cur-line-blank-p)
  4221. (>= (current-indentation) 4))))
  4222. (forward-line -1))
  4223. (when result
  4224. ;; Advance if there is a next line that is either blank or indented.
  4225. ;; (Need to check if we're on the last line, because
  4226. ;; markdown-next-line-blank-p returns true for last line in buffer.)
  4227. (while (and (/= (line-end-position) (point-max))
  4228. (or (markdown-next-line-blank-p)
  4229. (>= (markdown-next-line-indent) 4)))
  4230. (forward-line))
  4231. ;; Move back while the current line is blank.
  4232. (while (markdown-cur-line-blank-p)
  4233. (forward-line -1))
  4234. ;; Advance to capture this line and a single trailing newline (if there
  4235. ;; is one).
  4236. (forward-line)
  4237. (append result (list (point)))))))
  4238. (defun markdown-get-defined-footnotes ()
  4239. "Return a list of all defined footnotes.
  4240. Result is an alist of pairs (MARKER . LINE), where MARKER is the
  4241. footnote marker, a string, and LINE is the line number containing
  4242. the footnote definition.
  4243. For example, suppose the following footnotes are defined at positions
  4244. 448 and 475:
  4245. \[^1]: First footnote here.
  4246. \[^marker]: Second footnote.
  4247. Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
  4248. (save-excursion
  4249. (goto-char (point-min))
  4250. (let (footnotes)
  4251. (while (markdown-search-until-condition
  4252. (lambda () (and (not (markdown-code-block-at-point-p))
  4253. (not (markdown-inline-code-at-point-p))
  4254. (not (markdown-in-comment-p))))
  4255. markdown-regex-footnote-definition nil t)
  4256. (let ((marker (match-string-no-properties 1))
  4257. (pos (match-beginning 0)))
  4258. (unless (zerop (length marker))
  4259. (cl-pushnew (cons marker pos) footnotes :test #'equal))))
  4260. (reverse footnotes))))
  4261. ;;; Element Removal ===========================================================
  4262. (defun markdown-kill-thing-at-point ()
  4263. "Kill thing at point and add important text, without markup, to kill ring.
  4264. Possible things to kill include (roughly in order of precedence):
  4265. inline code, headers, horizontal rules, links (add link text to
  4266. kill ring), images (add alt text to kill ring), angle uri, email
  4267. addresses, bold, italics, reference definition (add URI to kill
  4268. ring), footnote markers and text (kill both marker and text, add
  4269. text to kill ring), and list items."
  4270. (interactive "*")
  4271. (let (val)
  4272. (cond
  4273. ;; Inline code
  4274. ((markdown-inline-code-at-point)
  4275. (kill-new (match-string 2))
  4276. (delete-region (match-beginning 0) (match-end 0)))
  4277. ;; ATX header
  4278. ((thing-at-point-looking-at markdown-regex-header-atx)
  4279. (kill-new (match-string 2))
  4280. (delete-region (match-beginning 0) (match-end 0)))
  4281. ;; Setext header
  4282. ((thing-at-point-looking-at markdown-regex-header-setext)
  4283. (kill-new (match-string 1))
  4284. (delete-region (match-beginning 0) (match-end 0)))
  4285. ;; Horizontal rule
  4286. ((thing-at-point-looking-at markdown-regex-hr)
  4287. (kill-new (match-string 0))
  4288. (delete-region (match-beginning 0) (match-end 0)))
  4289. ;; Inline link or image (add link or alt text to kill ring)
  4290. ((thing-at-point-looking-at markdown-regex-link-inline)
  4291. (kill-new (match-string 3))
  4292. (delete-region (match-beginning 0) (match-end 0)))
  4293. ;; Reference link or image (add link or alt text to kill ring)
  4294. ((thing-at-point-looking-at markdown-regex-link-reference)
  4295. (kill-new (match-string 3))
  4296. (delete-region (match-beginning 0) (match-end 0)))
  4297. ;; Angle URI (add URL to kill ring)
  4298. ((thing-at-point-looking-at markdown-regex-angle-uri)
  4299. (kill-new (match-string 2))
  4300. (delete-region (match-beginning 0) (match-end 0)))
  4301. ;; Email address in angle brackets (add email address to kill ring)
  4302. ((thing-at-point-looking-at markdown-regex-email)
  4303. (kill-new (match-string 1))
  4304. (delete-region (match-beginning 0) (match-end 0)))
  4305. ;; Wiki link (add alias text to kill ring)
  4306. ((and markdown-enable-wiki-links
  4307. (thing-at-point-looking-at markdown-regex-wiki-link))
  4308. (kill-new (markdown-wiki-link-alias))
  4309. (delete-region (match-beginning 1) (match-end 1)))
  4310. ;; Bold
  4311. ((thing-at-point-looking-at markdown-regex-bold)
  4312. (kill-new (match-string 4))
  4313. (delete-region (match-beginning 2) (match-end 2)))
  4314. ;; Italics
  4315. ((thing-at-point-looking-at markdown-regex-italic)
  4316. (kill-new (match-string 3))
  4317. (delete-region (match-beginning 1) (match-end 1)))
  4318. ;; Strikethrough
  4319. ((thing-at-point-looking-at markdown-regex-strike-through)
  4320. (kill-new (match-string 4))
  4321. (delete-region (match-beginning 2) (match-end 2)))
  4322. ;; Footnote marker (add footnote text to kill ring)
  4323. ((thing-at-point-looking-at markdown-regex-footnote)
  4324. (markdown-footnote-kill))
  4325. ;; Footnote text (add footnote text to kill ring)
  4326. ((setq val (markdown-footnote-text-positions))
  4327. (markdown-footnote-kill))
  4328. ;; Reference definition (add URL to kill ring)
  4329. ((thing-at-point-looking-at markdown-regex-reference-definition)
  4330. (kill-new (match-string 5))
  4331. (delete-region (match-beginning 0) (match-end 0)))
  4332. ;; List item
  4333. ((setq val (markdown-cur-list-item-bounds))
  4334. (kill-new (delete-and-extract-region (cl-first val) (cl-second val))))
  4335. (t
  4336. (user-error "Nothing found at point to kill")))))
  4337. (defun markdown-kill-outline ()
  4338. "Kill visible heading and add it to `kill-ring'."
  4339. (interactive)
  4340. (save-excursion
  4341. (markdown-outline-previous)
  4342. (kill-region (point) (progn (markdown-outline-next) (point)))))
  4343. (defun markdown-kill-block ()
  4344. "Kill visible code block, list item, or blockquote and add it to `kill-ring'."
  4345. (interactive)
  4346. (save-excursion
  4347. (markdown-backward-block)
  4348. (kill-region (point) (progn (markdown-forward-block) (point)))))
  4349. ;;; Indentation ===============================================================
  4350. (defun markdown-indent-find-next-position (cur-pos positions)
  4351. "Return the position after the index of CUR-POS in POSITIONS.
  4352. Positions are calculated by `markdown-calc-indents'."
  4353. (while (and positions
  4354. (not (equal cur-pos (car positions))))
  4355. (setq positions (cdr positions)))
  4356. (or (cadr positions) 0))
  4357. (defun markdown-outdent-find-next-position (cur-pos positions)
  4358. "Return the maximal element that precedes CUR-POS from POSITIONS.
  4359. Positions are calculated by `markdown-calc-indents'."
  4360. (let ((result 0))
  4361. (dolist (i positions)
  4362. (when (< i cur-pos)
  4363. (setq result (max result i))))
  4364. result))
  4365. (defun markdown-indent-line ()
  4366. "Indent the current line using some heuristics.
  4367. If the _previous_ command was either `markdown-enter-key' or
  4368. `markdown-cycle', then we should cycle to the next
  4369. reasonable indentation position. Otherwise, we could have been
  4370. called directly by `markdown-enter-key', by an initial call of
  4371. `markdown-cycle', or indirectly by `auto-fill-mode'. In
  4372. these cases, indent to the default position.
  4373. Positions are calculated by `markdown-calc-indents'."
  4374. (interactive)
  4375. (let ((positions (markdown-calc-indents))
  4376. (point-pos (current-column))
  4377. (_ (back-to-indentation))
  4378. (cur-pos (current-column)))
  4379. (if (not (equal this-command 'markdown-cycle))
  4380. (indent-line-to (car positions))
  4381. (setq positions (sort (delete-dups positions) '<))
  4382. (let* ((next-pos (markdown-indent-find-next-position cur-pos positions))
  4383. (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0)))
  4384. (indent-line-to next-pos)
  4385. (move-to-column new-point-pos)))))
  4386. (defun markdown-calc-indents ()
  4387. "Return a list of indentation columns to cycle through.
  4388. The first element in the returned list should be considered the
  4389. default indentation level. This function does not worry about
  4390. duplicate positions, which are handled up by calling functions."
  4391. (let (pos prev-line-pos positions)
  4392. ;; Indentation of previous line
  4393. (setq prev-line-pos (markdown-prev-line-indent))
  4394. (setq positions (cons prev-line-pos positions))
  4395. ;; Indentation of previous non-list-marker text
  4396. (when (setq pos (save-excursion
  4397. (forward-line -1)
  4398. (when (looking-at markdown-regex-list)
  4399. (- (match-end 3) (match-beginning 0)))))
  4400. (setq positions (cons pos positions)))
  4401. ;; Indentation required for a pre block in current context
  4402. (setq pos (length (markdown-pre-indentation (point))))
  4403. (setq positions (cons pos positions))
  4404. ;; Indentation of the previous line + tab-width
  4405. (if prev-line-pos
  4406. (setq positions (cons (+ prev-line-pos tab-width) positions))
  4407. (setq positions (cons tab-width positions)))
  4408. ;; Indentation of the previous line - tab-width
  4409. (if (and prev-line-pos (> prev-line-pos tab-width))
  4410. (setq positions (cons (- prev-line-pos tab-width) positions)))
  4411. ;; Indentation of all preceding list markers (when in a list)
  4412. (when (setq pos (markdown-calculate-list-levels))
  4413. (setq positions (append pos positions)))
  4414. ;; First column
  4415. (setq positions (cons 0 positions))
  4416. ;; Return reversed list
  4417. (reverse positions)))
  4418. (defun markdown-enter-key ()
  4419. "Handle RET depending on the context.
  4420. If the point is at a table, move to the next row. Otherwise,
  4421. indent according to value of `markdown-indent-on-enter'.
  4422. When it is nil, simply call `newline'. Otherwise, indent the next line
  4423. following RET using `markdown-indent-line'. Furthermore, when it
  4424. is set to 'indent-and-new-item and the point is in a list item,
  4425. start a new item with the same indentation. If the point is in an
  4426. empty list item, remove it (so that pressing RET twice when in a
  4427. list simply adds a blank line)."
  4428. (interactive)
  4429. (cond
  4430. ;; Table
  4431. ((markdown-table-at-point-p)
  4432. (call-interactively #'markdown-table-next-row))
  4433. ;; Indent non-table text
  4434. (markdown-indent-on-enter
  4435. (let (bounds)
  4436. (if (and (memq markdown-indent-on-enter '(indent-and-new-item))
  4437. (setq bounds (markdown-cur-list-item-bounds)))
  4438. (let ((beg (cl-first bounds))
  4439. (end (cl-second bounds))
  4440. (length (cl-fourth bounds)))
  4441. ;; Point is in a list item
  4442. (if (= (- end beg) length)
  4443. ;; Delete blank list
  4444. (progn
  4445. (delete-region beg end)
  4446. (newline)
  4447. (markdown-indent-line))
  4448. (call-interactively #'markdown-insert-list-item)))
  4449. ;; Point is not in a list
  4450. (newline)
  4451. (markdown-indent-line))))
  4452. ;; Insert a raw newline
  4453. (t (newline))))
  4454. (defun markdown-outdent-or-delete (arg)
  4455. "Handle BACKSPACE by cycling through indentation points.
  4456. When BACKSPACE is pressed, if there is only whitespace
  4457. before the current point, then outdent the line one level.
  4458. Otherwise, do normal delete by repeating
  4459. `backward-delete-char-untabify' ARG times."
  4460. (interactive "*p")
  4461. (if (use-region-p)
  4462. (backward-delete-char-untabify arg)
  4463. (let ((cur-pos (current-column))
  4464. (start-of-indention (save-excursion
  4465. (back-to-indentation)
  4466. (current-column)))
  4467. (positions (markdown-calc-indents)))
  4468. (if (and (> cur-pos 0) (= cur-pos start-of-indention))
  4469. (indent-line-to (markdown-outdent-find-next-position cur-pos positions))
  4470. (backward-delete-char-untabify arg)))))
  4471. (defun markdown-find-leftmost-column (beg end)
  4472. "Find the leftmost column in the region from BEG to END."
  4473. (let ((mincol 1000))
  4474. (save-excursion
  4475. (goto-char beg)
  4476. (while (< (point) end)
  4477. (back-to-indentation)
  4478. (unless (looking-at-p "[ \t]*$")
  4479. (setq mincol (min mincol (current-column))))
  4480. (forward-line 1)
  4481. ))
  4482. mincol))
  4483. (defun markdown-indent-region (beg end arg)
  4484. "Indent the region from BEG to END using some heuristics.
  4485. When ARG is non-nil, outdent the region instead.
  4486. See `markdown-indent-line' and `markdown-indent-line'."
  4487. (interactive "*r\nP")
  4488. (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
  4489. (leftmostcol (markdown-find-leftmost-column beg end))
  4490. (next-pos (if arg
  4491. (markdown-outdent-find-next-position leftmostcol positions)
  4492. (markdown-indent-find-next-position leftmostcol positions))))
  4493. (indent-rigidly beg end (- next-pos leftmostcol))
  4494. (setq deactivate-mark nil)))
  4495. (defun markdown-outdent-region (beg end)
  4496. "Call `markdown-indent-region' on region from BEG to END with prefix."
  4497. (interactive "*r")
  4498. (markdown-indent-region beg end t))
  4499. (defun markdown--indent-region (start end)
  4500. (let ((deactivate-mark nil))
  4501. (save-excursion
  4502. (goto-char end)
  4503. (setq end (point-marker))
  4504. (goto-char start)
  4505. (when (bolp)
  4506. (forward-line 1))
  4507. (while (< (point) end)
  4508. (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp)))
  4509. (indent-according-to-mode))
  4510. (forward-line 1))
  4511. (move-marker end nil))))
  4512. ;;; Markup Completion =========================================================
  4513. (defconst markdown-complete-alist
  4514. '((markdown-regex-header-atx . markdown-complete-atx)
  4515. (markdown-regex-header-setext . markdown-complete-setext)
  4516. (markdown-regex-hr . markdown-complete-hr))
  4517. "Association list of form (regexp . function) for markup completion.")
  4518. (defun markdown-incomplete-atx-p ()
  4519. "Return t if ATX header markup is incomplete and nil otherwise.
  4520. Assumes match data is available for `markdown-regex-header-atx'.
  4521. Checks that the number of trailing hash marks equals the number of leading
  4522. hash marks, that there is only a single space before and after the text,
  4523. and that there is no extraneous whitespace in the text."
  4524. (or
  4525. ;; Number of starting and ending hash marks differs
  4526. (not (= (length (match-string 1)) (length (match-string 3))))
  4527. ;; When the header text is not empty...
  4528. (and (> (length (match-string 2)) 0)
  4529. ;; ...if there are extra leading, trailing, or interior spaces
  4530. (or (not (= (match-beginning 2) (1+ (match-end 1))))
  4531. (not (= (match-beginning 3) (1+ (match-end 2))))
  4532. (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
  4533. ;; When the header text is empty...
  4534. (and (= (length (match-string 2)) 0)
  4535. ;; ...if there are too many or too few spaces
  4536. (not (= (match-beginning 3) (+ (match-end 1) 2))))))
  4537. (defun markdown-complete-atx ()
  4538. "Complete and normalize ATX headers.
  4539. Add or remove hash marks to the end of the header to match the
  4540. beginning. Ensure that there is only a single space between hash
  4541. marks and header text. Removes extraneous whitespace from header text.
  4542. Assumes match data is available for `markdown-regex-header-atx'.
  4543. Return nil if markup was complete and non-nil if markup was completed."
  4544. (when (markdown-incomplete-atx-p)
  4545. (let* ((new-marker (make-marker))
  4546. (new-marker (set-marker new-marker (match-end 2))))
  4547. ;; Hash marks and spacing at end
  4548. (goto-char (match-end 2))
  4549. (delete-region (match-end 2) (match-end 3))
  4550. (insert " " (match-string 1))
  4551. ;; Remove extraneous whitespace from title
  4552. (replace-match (markdown-compress-whitespace-string (match-string 2))
  4553. t t nil 2)
  4554. ;; Spacing at beginning
  4555. (goto-char (match-end 1))
  4556. (delete-region (match-end 1) (match-beginning 2))
  4557. (insert " ")
  4558. ;; Leave point at end of text
  4559. (goto-char new-marker))))
  4560. (defun markdown-incomplete-setext-p ()
  4561. "Return t if setext header markup is incomplete and nil otherwise.
  4562. Assumes match data is available for `markdown-regex-header-setext'.
  4563. Checks that length of underline matches text and that there is no
  4564. extraneous whitespace in the text."
  4565. (or (not (= (length (match-string 1)) (length (match-string 2))))
  4566. (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
  4567. (defun markdown-complete-setext ()
  4568. "Complete and normalize setext headers.
  4569. Add or remove underline characters to match length of header
  4570. text. Removes extraneous whitespace from header text. Assumes
  4571. match data is available for `markdown-regex-header-setext'.
  4572. Return nil if markup was complete and non-nil if markup was completed."
  4573. (when (markdown-incomplete-setext-p)
  4574. (let* ((text (markdown-compress-whitespace-string (match-string 1)))
  4575. (char (char-after (match-beginning 2)))
  4576. (level (if (char-equal char ?-) 2 1)))
  4577. (goto-char (match-beginning 0))
  4578. (delete-region (match-beginning 0) (match-end 0))
  4579. (markdown-insert-header level text t)
  4580. t)))
  4581. (defun markdown-incomplete-hr-p ()
  4582. "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
  4583. Assumes match data is available for `markdown-regex-hr'."
  4584. (not (member (match-string 0) markdown-hr-strings)))
  4585. (defun markdown-complete-hr ()
  4586. "Complete horizontal rules.
  4587. If horizontal rule string is a member of `markdown-hr-strings',
  4588. do nothing. Otherwise, replace with the car of
  4589. `markdown-hr-strings'.
  4590. Assumes match data is available for `markdown-regex-hr'.
  4591. Return nil if markup was complete and non-nil if markup was completed."
  4592. (when (markdown-incomplete-hr-p)
  4593. (replace-match (car markdown-hr-strings))
  4594. t))
  4595. (defun markdown-complete ()
  4596. "Complete markup of object near point or in region when active.
  4597. Handle all objects in `markdown-complete-alist', in order.
  4598. See `markdown-complete-at-point' and `markdown-complete-region'."
  4599. (interactive "*")
  4600. (if (use-region-p)
  4601. (markdown-complete-region (region-beginning) (region-end))
  4602. (markdown-complete-at-point)))
  4603. (defun markdown-complete-at-point ()
  4604. "Complete markup of object near point.
  4605. Handle all elements of `markdown-complete-alist' in order."
  4606. (interactive "*")
  4607. (let ((list markdown-complete-alist) found changed)
  4608. (while list
  4609. (let ((regexp (eval (caar list)))
  4610. (function (cdar list)))
  4611. (setq list (cdr list))
  4612. (when (thing-at-point-looking-at regexp)
  4613. (setq found t)
  4614. (setq changed (funcall function))
  4615. (setq list nil))))
  4616. (if found
  4617. (or changed (user-error "Markup at point is complete"))
  4618. (user-error "Nothing to complete at point"))))
  4619. (defun markdown-complete-region (beg end)
  4620. "Complete markup of objects in region from BEG to END.
  4621. Handle all objects in `markdown-complete-alist', in order. Each
  4622. match is checked to ensure that a previous regexp does not also
  4623. match."
  4624. (interactive "*r")
  4625. (let ((end-marker (set-marker (make-marker) end))
  4626. previous)
  4627. (dolist (element markdown-complete-alist)
  4628. (let ((regexp (eval (car element)))
  4629. (function (cdr element)))
  4630. (goto-char beg)
  4631. (while (re-search-forward regexp end-marker 'limit)
  4632. (when (match-string 0)
  4633. ;; Make sure this is not a match for any of the preceding regexps.
  4634. ;; This prevents mistaking an HR for a Setext subheading.
  4635. (let (match)
  4636. (save-match-data
  4637. (dolist (prev-regexp previous)
  4638. (or match (setq match (looking-back prev-regexp nil)))))
  4639. (unless match
  4640. (save-excursion (funcall function))))))
  4641. (cl-pushnew regexp previous :test #'equal)))
  4642. previous))
  4643. (defun markdown-complete-buffer ()
  4644. "Complete markup for all objects in the current buffer."
  4645. (interactive "*")
  4646. (markdown-complete-region (point-min) (point-max)))
  4647. ;;; Markup Cycling ============================================================
  4648. (defun markdown-cycle-atx (arg &optional remove)
  4649. "Cycle ATX header markup.
  4650. Promote header (decrease level) when ARG is 1 and demote
  4651. header (increase level) if arg is -1. When REMOVE is non-nil,
  4652. remove the header when the level reaches zero and stop cycling
  4653. when it reaches six. Otherwise, perform a proper cycling through
  4654. levels one through six. Assumes match data is available for
  4655. `markdown-regex-header-atx'."
  4656. (let* ((old-level (length (match-string 1)))
  4657. (new-level (+ old-level arg))
  4658. (text (match-string 2)))
  4659. (when (not remove)
  4660. (setq new-level (% new-level 6))
  4661. (setq new-level (cond ((= new-level 0) 6)
  4662. ((< new-level 0) (+ new-level 6))
  4663. (t new-level))))
  4664. (cond
  4665. ((= new-level 0)
  4666. (markdown-unwrap-thing-at-point nil 0 2))
  4667. ((<= new-level 6)
  4668. (goto-char (match-beginning 0))
  4669. (delete-region (match-beginning 0) (match-end 0))
  4670. (markdown-insert-header new-level text nil)))))
  4671. (defun markdown-cycle-setext (arg &optional remove)
  4672. "Cycle setext header markup.
  4673. Promote header (increase level) when ARG is 1 and demote
  4674. header (decrease level or remove) if arg is -1. When demoting a
  4675. level-two setext header, replace with a level-three atx header.
  4676. When REMOVE is non-nil, remove the header when the level reaches
  4677. zero. Otherwise, cycle back to a level six atx header. Assumes
  4678. match data is available for `markdown-regex-header-setext'."
  4679. (let* ((char (char-after (match-beginning 2)))
  4680. (old-level (if (char-equal char ?=) 1 2))
  4681. (new-level (+ old-level arg)))
  4682. (when (and (not remove) (= new-level 0))
  4683. (setq new-level 6))
  4684. (cond
  4685. ((= new-level 0)
  4686. (markdown-unwrap-thing-at-point nil 0 1))
  4687. ((<= new-level 2)
  4688. (markdown-insert-header new-level nil t))
  4689. ((<= new-level 6)
  4690. (markdown-insert-header new-level nil nil)))))
  4691. (defun markdown-cycle-hr (arg &optional remove)
  4692. "Cycle string used for horizontal rule from `markdown-hr-strings'.
  4693. When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
  4694. backwards (promote). When REMOVE is non-nil, remove the hr instead
  4695. of cycling when the end of the list is reached.
  4696. Assumes match data is available for `markdown-regex-hr'."
  4697. (let* ((strings (if (= arg -1)
  4698. (reverse markdown-hr-strings)
  4699. markdown-hr-strings))
  4700. (tail (member (match-string 0) strings))
  4701. (new (or (cadr tail)
  4702. (if remove
  4703. (if (= arg 1)
  4704. ""
  4705. (car tail))
  4706. (car strings)))))
  4707. (replace-match new)))
  4708. (defun markdown-cycle-bold ()
  4709. "Cycle bold markup between underscores and asterisks.
  4710. Assumes match data is available for `markdown-regex-bold'."
  4711. (save-excursion
  4712. (let* ((old-delim (match-string 3))
  4713. (new-delim (if (string-equal old-delim "**") "__" "**")))
  4714. (replace-match new-delim t t nil 3)
  4715. (replace-match new-delim t t nil 5))))
  4716. (defun markdown-cycle-italic ()
  4717. "Cycle italic markup between underscores and asterisks.
  4718. Assumes match data is available for `markdown-regex-italic'."
  4719. (save-excursion
  4720. (let* ((old-delim (match-string 2))
  4721. (new-delim (if (string-equal old-delim "*") "_" "*")))
  4722. (replace-match new-delim t t nil 2)
  4723. (replace-match new-delim t t nil 4))))
  4724. ;;; Keymap ====================================================================
  4725. (defun markdown--style-map-prompt ()
  4726. "Return a formatted prompt for Markdown markup insertion."
  4727. (when markdown-enable-prefix-prompts
  4728. (concat
  4729. "Markdown: "
  4730. (propertize "bold" 'face 'markdown-bold-face) ", "
  4731. (propertize "italic" 'face 'markdown-italic-face) ", "
  4732. (propertize "code" 'face 'markdown-inline-code-face) ", "
  4733. (propertize "C = GFM code" 'face 'markdown-code-face) ", "
  4734. (propertize "pre" 'face 'markdown-pre-face) ", "
  4735. (propertize "footnote" 'face 'markdown-footnote-text-face) ", "
  4736. (propertize "F = foldable" 'face 'markdown-bold-face) ", "
  4737. (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", "
  4738. (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", "
  4739. (propertize "- = hr" 'face 'markdown-hr-face) ", "
  4740. "C-h = more")))
  4741. (defun markdown--command-map-prompt ()
  4742. "Return prompt for Markdown buffer-wide commands."
  4743. (when markdown-enable-prefix-prompts
  4744. (concat
  4745. "Command: "
  4746. (propertize "m" 'face 'markdown-bold-face) "arkdown, "
  4747. (propertize "p" 'face 'markdown-bold-face) "review, "
  4748. (propertize "o" 'face 'markdown-bold-face) "pen, "
  4749. (propertize "e" 'face 'markdown-bold-face) "xport, "
  4750. "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, "
  4751. (propertize "c" 'face 'markdown-bold-face) "heck refs, "
  4752. (propertize "u" 'face 'markdown-bold-face) "nused refs, "
  4753. "C-h = more")))
  4754. (defvar markdown-mode-style-map
  4755. (let ((map (make-keymap (markdown--style-map-prompt))))
  4756. (define-key map (kbd "1") 'markdown-insert-header-atx-1)
  4757. (define-key map (kbd "2") 'markdown-insert-header-atx-2)
  4758. (define-key map (kbd "3") 'markdown-insert-header-atx-3)
  4759. (define-key map (kbd "4") 'markdown-insert-header-atx-4)
  4760. (define-key map (kbd "5") 'markdown-insert-header-atx-5)
  4761. (define-key map (kbd "6") 'markdown-insert-header-atx-6)
  4762. (define-key map (kbd "!") 'markdown-insert-header-setext-1)
  4763. (define-key map (kbd "@") 'markdown-insert-header-setext-2)
  4764. (define-key map (kbd "b") 'markdown-insert-bold)
  4765. (define-key map (kbd "c") 'markdown-insert-code)
  4766. (define-key map (kbd "C") 'markdown-insert-gfm-code-block)
  4767. (define-key map (kbd "f") 'markdown-insert-footnote)
  4768. (define-key map (kbd "F") 'markdown-insert-foldable-block)
  4769. (define-key map (kbd "h") 'markdown-insert-header-dwim)
  4770. (define-key map (kbd "H") 'markdown-insert-header-setext-dwim)
  4771. (define-key map (kbd "i") 'markdown-insert-italic)
  4772. (define-key map (kbd "k") 'markdown-insert-kbd)
  4773. (define-key map (kbd "l") 'markdown-insert-link)
  4774. (define-key map (kbd "p") 'markdown-insert-pre)
  4775. (define-key map (kbd "P") 'markdown-pre-region)
  4776. (define-key map (kbd "q") 'markdown-insert-blockquote)
  4777. (define-key map (kbd "s") 'markdown-insert-strike-through)
  4778. (define-key map (kbd "t") 'markdown-insert-table)
  4779. (define-key map (kbd "Q") 'markdown-blockquote-region)
  4780. (define-key map (kbd "w") 'markdown-insert-wiki-link)
  4781. (define-key map (kbd "-") 'markdown-insert-hr)
  4782. (define-key map (kbd "[") 'markdown-insert-gfm-checkbox)
  4783. ;; Deprecated keys that may be removed in a future version
  4784. (define-key map (kbd "e") 'markdown-insert-italic)
  4785. map)
  4786. "Keymap for Markdown text styling commands.")
  4787. (defvar markdown-mode-command-map
  4788. (let ((map (make-keymap (markdown--command-map-prompt))))
  4789. (define-key map (kbd "m") 'markdown-other-window)
  4790. (define-key map (kbd "p") 'markdown-preview)
  4791. (define-key map (kbd "e") 'markdown-export)
  4792. (define-key map (kbd "v") 'markdown-export-and-preview)
  4793. (define-key map (kbd "o") 'markdown-open)
  4794. (define-key map (kbd "l") 'markdown-live-preview-mode)
  4795. (define-key map (kbd "w") 'markdown-kill-ring-save)
  4796. (define-key map (kbd "c") 'markdown-check-refs)
  4797. (define-key map (kbd "u") 'markdown-unused-refs)
  4798. (define-key map (kbd "n") 'markdown-cleanup-list-numbers)
  4799. (define-key map (kbd "]") 'markdown-complete-buffer)
  4800. (define-key map (kbd "^") 'markdown-table-sort-lines)
  4801. (define-key map (kbd "|") 'markdown-table-convert-region)
  4802. (define-key map (kbd "t") 'markdown-table-transpose)
  4803. map)
  4804. "Keymap for Markdown buffer-wide commands.")
  4805. (defvar markdown-mode-map
  4806. (let ((map (make-keymap)))
  4807. ;; Markup insertion & removal
  4808. (define-key map (kbd "C-c C-s") markdown-mode-style-map)
  4809. (define-key map (kbd "C-c C-l") 'markdown-insert-link)
  4810. (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point)
  4811. ;; Promotion, demotion, and cycling
  4812. (define-key map (kbd "C-c C--") 'markdown-promote)
  4813. (define-key map (kbd "C-c C-=") 'markdown-demote)
  4814. (define-key map (kbd "C-c C-]") 'markdown-complete)
  4815. ;; Following and doing things
  4816. (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point)
  4817. (define-key map (kbd "C-c C-d") 'markdown-do)
  4818. (define-key map (kbd "C-c '") 'markdown-edit-code-block)
  4819. ;; Indentation
  4820. (define-key map (kbd "C-m") 'markdown-enter-key)
  4821. (define-key map (kbd "DEL") 'markdown-outdent-or-delete)
  4822. (define-key map (kbd "C-c >") 'markdown-indent-region)
  4823. (define-key map (kbd "C-c <") 'markdown-outdent-region)
  4824. ;; Visibility cycling
  4825. (define-key map (kbd "TAB") 'markdown-cycle)
  4826. (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
  4827. (define-key map (kbd "<S-tab>") 'markdown-shifttab)
  4828. (define-key map (kbd "<backtab>") 'markdown-shifttab)
  4829. ;; Heading and list navigation
  4830. (define-key map (kbd "C-c C-n") 'markdown-outline-next)
  4831. (define-key map (kbd "C-c C-p") 'markdown-outline-previous)
  4832. (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level)
  4833. (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level)
  4834. (define-key map (kbd "C-c C-u") 'markdown-outline-up)
  4835. ;; Buffer-wide commands
  4836. (define-key map (kbd "C-c C-c") markdown-mode-command-map)
  4837. ;; Subtree, list, and table editing
  4838. (define-key map (kbd "C-c <up>") 'markdown-move-up)
  4839. (define-key map (kbd "C-c <down>") 'markdown-move-down)
  4840. (define-key map (kbd "C-c <left>") 'markdown-promote)
  4841. (define-key map (kbd "C-c <right>") 'markdown-demote)
  4842. (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row)
  4843. (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row)
  4844. (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column)
  4845. (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column)
  4846. (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree)
  4847. (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree)
  4848. (define-key map (kbd "M-RET") 'markdown-insert-list-item)
  4849. (define-key map (kbd "C-c C-j") 'markdown-insert-list-item)
  4850. ;; Paragraphs (Markdown context aware)
  4851. (define-key map [remap backward-paragraph] 'markdown-backward-paragraph)
  4852. (define-key map [remap forward-paragraph] 'markdown-forward-paragraph)
  4853. (define-key map [remap mark-paragraph] 'markdown-mark-paragraph)
  4854. ;; Blocks (one or more paragraphs)
  4855. (define-key map (kbd "C-M-{") 'markdown-backward-block)
  4856. (define-key map (kbd "C-M-}") 'markdown-forward-block)
  4857. (define-key map (kbd "C-c M-h") 'markdown-mark-block)
  4858. (define-key map (kbd "C-x n b") 'markdown-narrow-to-block)
  4859. ;; Pages (top-level sections)
  4860. (define-key map [remap backward-page] 'markdown-backward-page)
  4861. (define-key map [remap forward-page] 'markdown-forward-page)
  4862. (define-key map [remap mark-page] 'markdown-mark-page)
  4863. (define-key map [remap narrow-to-page] 'markdown-narrow-to-page)
  4864. ;; Link Movement
  4865. (define-key map (kbd "M-n") 'markdown-next-link)
  4866. (define-key map (kbd "M-p") 'markdown-previous-link)
  4867. ;; Toggling functionality
  4868. (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math)
  4869. (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively)
  4870. (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images)
  4871. (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding)
  4872. (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding)
  4873. ;; Alternative keys (in case of problems with the arrow keys)
  4874. (define-key map (kbd "C-c C-x u") 'markdown-move-up)
  4875. (define-key map (kbd "C-c C-x d") 'markdown-move-down)
  4876. (define-key map (kbd "C-c C-x l") 'markdown-promote)
  4877. (define-key map (kbd "C-c C-x r") 'markdown-demote)
  4878. ;; Deprecated keys that may be removed in a future version
  4879. (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l
  4880. (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l
  4881. (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l
  4882. (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l
  4883. (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote)
  4884. (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link)
  4885. (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1)
  4886. (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2)
  4887. (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3)
  4888. (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4)
  4889. (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5)
  4890. (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6)
  4891. (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1)
  4892. (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2)
  4893. (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim)
  4894. (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim)
  4895. (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2)
  4896. (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1)
  4897. (define-key map (kbd "C-c C-i") 'markdown-insert-image)
  4898. (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j
  4899. (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d
  4900. (define-key map (kbd "C-c -") 'markdown-insert-hr)
  4901. map)
  4902. "Keymap for Markdown major mode.")
  4903. (defvar markdown-mode-mouse-map
  4904. (when markdown-mouse-follow-link
  4905. (let ((map (make-sparse-keymap)))
  4906. (define-key map [follow-link] 'mouse-face)
  4907. (define-key map [mouse-2] #'markdown-follow-thing-at-point)
  4908. map))
  4909. "Keymap for following links with mouse.")
  4910. (defvar gfm-mode-map
  4911. (let ((map (make-sparse-keymap)))
  4912. (set-keymap-parent map markdown-mode-map)
  4913. (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through)
  4914. (define-key map "`" 'markdown-electric-backquote)
  4915. map)
  4916. "Keymap for `gfm-mode'.
  4917. See also `markdown-mode-map'.")
  4918. ;;; Menu ======================================================================
  4919. (easy-menu-define markdown-mode-menu markdown-mode-map
  4920. "Menu for Markdown mode."
  4921. '("Markdown"
  4922. "---"
  4923. ("Movement"
  4924. ["Jump" markdown-do]
  4925. ["Follow Link" markdown-follow-thing-at-point]
  4926. ["Next Link" markdown-next-link]
  4927. ["Previous Link" markdown-previous-link]
  4928. "---"
  4929. ["Next Heading or List Item" markdown-outline-next]
  4930. ["Previous Heading or List Item" markdown-outline-previous]
  4931. ["Next at Same Level" markdown-outline-next-same-level]
  4932. ["Previous at Same Level" markdown-outline-previous-same-level]
  4933. ["Up to Parent" markdown-outline-up]
  4934. "---"
  4935. ["Forward Paragraph" markdown-forward-paragraph]
  4936. ["Backward Paragraph" markdown-backward-paragraph]
  4937. ["Forward Block" markdown-forward-block]
  4938. ["Backward Block" markdown-backward-block])
  4939. ("Show & Hide"
  4940. ["Cycle Heading Visibility" markdown-cycle
  4941. :enable (markdown-on-heading-p)]
  4942. ["Cycle Heading Visibility (Global)" markdown-shifttab]
  4943. "---"
  4944. ["Narrow to Region" narrow-to-region]
  4945. ["Narrow to Block" markdown-narrow-to-block]
  4946. ["Narrow to Section" narrow-to-defun]
  4947. ["Narrow to Subtree" markdown-narrow-to-subtree]
  4948. ["Widen" widen (buffer-narrowed-p)]
  4949. "---"
  4950. ["Toggle Markup Hiding" markdown-toggle-markup-hiding
  4951. :keys "C-c C-x C-m"
  4952. :style radio
  4953. :selected markdown-hide-markup])
  4954. "---"
  4955. ("Headings & Structure"
  4956. ["Automatic Heading" markdown-insert-header-dwim
  4957. :keys "C-c C-s h"]
  4958. ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
  4959. :keys "C-c C-s H"]
  4960. ("Specific Heading (atx)"
  4961. ["First Level atx" markdown-insert-header-atx-1
  4962. :keys "C-c C-s 1"]
  4963. ["Second Level atx" markdown-insert-header-atx-2
  4964. :keys "C-c C-s 2"]
  4965. ["Third Level atx" markdown-insert-header-atx-3
  4966. :keys "C-c C-s 3"]
  4967. ["Fourth Level atx" markdown-insert-header-atx-4
  4968. :keys "C-c C-s 4"]
  4969. ["Fifth Level atx" markdown-insert-header-atx-5
  4970. :keys "C-c C-s 5"]
  4971. ["Sixth Level atx" markdown-insert-header-atx-6
  4972. :keys "C-c C-s 6"])
  4973. ("Specific Heading (Setext)"
  4974. ["First Level Setext" markdown-insert-header-setext-1
  4975. :keys "C-c C-s !"]
  4976. ["Second Level Setext" markdown-insert-header-setext-2
  4977. :keys "C-c C-s @"])
  4978. ["Horizontal Rule" markdown-insert-hr
  4979. :keys "C-c C-s -"]
  4980. "---"
  4981. ["Move Subtree Up" markdown-move-up
  4982. :keys "C-c <up>"]
  4983. ["Move Subtree Down" markdown-move-down
  4984. :keys "C-c <down>"]
  4985. ["Promote Subtree" markdown-promote
  4986. :keys "C-c <left>"]
  4987. ["Demote Subtree" markdown-demote
  4988. :keys "C-c <right>"])
  4989. ("Region & Mark"
  4990. ["Indent Region" markdown-indent-region]
  4991. ["Outdent Region" markdown-outdent-region]
  4992. "--"
  4993. ["Mark Paragraph" mark-paragraph]
  4994. ["Mark Block" markdown-mark-block]
  4995. ["Mark Section" mark-defun]
  4996. ["Mark Subtree" markdown-mark-subtree])
  4997. ("Tables"
  4998. ["Move Row Up" markdown-move-up
  4999. :enable (markdown-table-at-point-p)
  5000. :keys "C-c <up>"]
  5001. ["Move Row Down" markdown-move-down
  5002. :enable (markdown-table-at-point-p)
  5003. :keys "C-c <down>"]
  5004. ["Move Column Left" markdown-demote
  5005. :enable (markdown-table-at-point-p)
  5006. :keys "C-c <left>"]
  5007. ["Move Column Right" markdown-promote
  5008. :enable (markdown-table-at-point-p)
  5009. :keys "C-c <right>"]
  5010. ["Delete Row" markdown-table-delete-row
  5011. :enable (markdown-table-at-point-p)]
  5012. ["Insert Row" markdown-table-insert-row
  5013. :enable (markdown-table-at-point-p)]
  5014. ["Delete Column" markdown-table-delete-column
  5015. :enable (markdown-table-at-point-p)]
  5016. ["Insert Column" markdown-table-insert-column
  5017. :enable (markdown-table-at-point-p)]
  5018. ["Insert Table" markdown-insert-table]
  5019. "--"
  5020. ["Convert Region to Table" markdown-table-convert-region]
  5021. ["Sort Table Lines" markdown-table-sort-lines
  5022. :enable (markdown-table-at-point-p)]
  5023. ["Transpose Table" markdown-table-transpose
  5024. :enable (markdown-table-at-point-p)])
  5025. ("Lists"
  5026. ["Insert List Item" markdown-insert-list-item]
  5027. ["Move Subtree Up" markdown-move-up
  5028. :keys "C-c <up>"]
  5029. ["Move Subtree Down" markdown-move-down
  5030. :keys "C-c <down>"]
  5031. ["Indent Subtree" markdown-demote
  5032. :keys "C-c <right>"]
  5033. ["Outdent Subtree" markdown-promote
  5034. :keys "C-c <left>"]
  5035. ["Renumber List" markdown-cleanup-list-numbers]
  5036. ["Insert Task List Item" markdown-insert-gfm-checkbox
  5037. :keys "C-c C-x ["]
  5038. ["Toggle Task List Item" markdown-toggle-gfm-checkbox
  5039. :enable (markdown-gfm-task-list-item-at-point)
  5040. :keys "C-c C-d"])
  5041. ("Links & Images"
  5042. ["Insert Link" markdown-insert-link]
  5043. ["Insert Image" markdown-insert-image]
  5044. ["Insert Footnote" markdown-insert-footnote
  5045. :keys "C-c C-s f"]
  5046. ["Insert Wiki Link" markdown-insert-wiki-link
  5047. :keys "C-c C-s w"]
  5048. "---"
  5049. ["Check References" markdown-check-refs]
  5050. ["Find Unused References" markdown-unused-refs]
  5051. ["Toggle URL Hiding" markdown-toggle-url-hiding
  5052. :style radio
  5053. :selected markdown-hide-urls]
  5054. ["Toggle Inline Images" markdown-toggle-inline-images
  5055. :keys "C-c C-x C-i"
  5056. :style radio
  5057. :selected markdown-inline-image-overlays]
  5058. ["Toggle Wiki Links" markdown-toggle-wiki-links
  5059. :style radio
  5060. :selected markdown-enable-wiki-links])
  5061. ("Styles"
  5062. ["Bold" markdown-insert-bold]
  5063. ["Italic" markdown-insert-italic]
  5064. ["Code" markdown-insert-code]
  5065. ["Strikethrough" markdown-insert-strike-through]
  5066. ["Keyboard" markdown-insert-kbd]
  5067. "---"
  5068. ["Blockquote" markdown-insert-blockquote]
  5069. ["Preformatted" markdown-insert-pre]
  5070. ["GFM Code Block" markdown-insert-gfm-code-block]
  5071. ["Edit Code Block" markdown-edit-code-block
  5072. :enable (markdown-code-block-at-point-p)]
  5073. ["Foldable Block" markdown-insert-foldable-block]
  5074. "---"
  5075. ["Blockquote Region" markdown-blockquote-region]
  5076. ["Preformatted Region" markdown-pre-region]
  5077. "---"
  5078. ["Fontify Code Blocks Natively"
  5079. markdown-toggle-fontify-code-blocks-natively
  5080. :style radio
  5081. :selected markdown-fontify-code-blocks-natively]
  5082. ["LaTeX Math Support" markdown-toggle-math
  5083. :style radio
  5084. :selected markdown-enable-math])
  5085. "---"
  5086. ("Preview & Export"
  5087. ["Compile" markdown-other-window]
  5088. ["Preview" markdown-preview]
  5089. ["Export" markdown-export]
  5090. ["Export & View" markdown-export-and-preview]
  5091. ["Open" markdown-open]
  5092. ["Live Export" markdown-live-preview-mode
  5093. :style radio
  5094. :selected markdown-live-preview-mode]
  5095. ["Kill ring save" markdown-kill-ring-save])
  5096. ("Markup Completion and Cycling"
  5097. ["Complete Markup" markdown-complete]
  5098. ["Promote Element" markdown-promote
  5099. :keys "C-c C--"]
  5100. ["Demote Element" markdown-demote
  5101. :keys "C-c C-="])
  5102. "---"
  5103. ["Kill Element" markdown-kill-thing-at-point]
  5104. "---"
  5105. ("Documentation"
  5106. ["Version" markdown-show-version]
  5107. ["Homepage" markdown-mode-info]
  5108. ["Describe Mode" (describe-function 'markdown-mode)]
  5109. ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
  5110. ;;; imenu =====================================================================
  5111. (defun markdown-imenu-create-nested-index ()
  5112. "Create and return a nested imenu index alist for the current buffer.
  5113. See `imenu-create-index-function' and `imenu--index-alist' for details."
  5114. (let* ((root '(nil . nil))
  5115. (min-level 9999)
  5116. hashes headers)
  5117. (save-excursion
  5118. ;; Headings
  5119. (goto-char (point-min))
  5120. (while (re-search-forward markdown-regex-header (point-max) t)
  5121. (unless (or (markdown-code-block-at-point-p)
  5122. (and (match-beginning 3)
  5123. (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end)))
  5124. (cond
  5125. ((match-string-no-properties 2) ;; level 1 setext
  5126. (setq min-level 1)
  5127. (push (list :heading (match-string-no-properties 1)
  5128. :point (match-beginning 1)
  5129. :level 1) headers))
  5130. ((match-string-no-properties 3) ;; level 2 setext
  5131. (setq min-level (min min-level 2))
  5132. (push (list :heading (match-string-no-properties 1)
  5133. :point (match-beginning 1)
  5134. :level (- 2 (1- min-level))) headers))
  5135. ((setq hashes (markdown-trim-whitespace
  5136. (match-string-no-properties 4)))
  5137. (setq min-level (min min-level (length hashes)))
  5138. (push (list :heading (match-string-no-properties 5)
  5139. :point (match-beginning 4)
  5140. :level (- (length hashes) (1- min-level))) headers)))))
  5141. (cl-loop with cur-level = 0
  5142. with cur-alist = nil
  5143. with empty-heading = "-"
  5144. with self-heading = "."
  5145. for header in (reverse headers)
  5146. for level = (plist-get header :level)
  5147. do
  5148. (let ((alist (list (cons (plist-get header :heading) (plist-get header :point)))))
  5149. (cond
  5150. ((= cur-level level) ; new sibling
  5151. (setcdr cur-alist alist)
  5152. (setq cur-alist alist))
  5153. ((< cur-level level) ; first child
  5154. (dotimes (_ (- level cur-level 1))
  5155. (setq alist (list (cons empty-heading alist))))
  5156. (if cur-alist
  5157. (let* ((parent (car cur-alist))
  5158. (self-pos (cdr parent)))
  5159. (setcdr parent (cons (cons self-heading self-pos) alist)))
  5160. (setcdr root alist)) ; primogenitor
  5161. (setq cur-alist alist)
  5162. (setq cur-level level))
  5163. (t ; new sibling of an ancestor
  5164. (let ((sibling-alist (last (cdr root))))
  5165. (dotimes (_ (1- level))
  5166. (setq sibling-alist (last (cdar sibling-alist))))
  5167. (setcdr sibling-alist alist)
  5168. (setq cur-alist alist))
  5169. (setq cur-level level)))))
  5170. ;; Footnotes
  5171. (let ((fn (markdown-get-defined-footnotes)))
  5172. (if (or (zerop (length fn))
  5173. (null markdown-add-footnotes-to-imenu))
  5174. (cdr root)
  5175. (nconc (cdr root) (list (cons "Footnotes" fn))))))))
  5176. (defun markdown-imenu-create-flat-index ()
  5177. "Create and return a flat imenu index alist for the current buffer.
  5178. See `imenu-create-index-function' and `imenu--index-alist' for details."
  5179. (let* ((empty-heading "-") index heading pos)
  5180. (save-excursion
  5181. ;; Headings
  5182. (goto-char (point-min))
  5183. (while (re-search-forward markdown-regex-header (point-max) t)
  5184. (when (and (not (markdown-code-block-at-point-p (point-at-bol)))
  5185. (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin)))
  5186. (cond
  5187. ((setq heading (match-string-no-properties 1))
  5188. (setq pos (match-beginning 1)))
  5189. ((setq heading (match-string-no-properties 5))
  5190. (setq pos (match-beginning 4))))
  5191. (or (> (length heading) 0)
  5192. (setq heading empty-heading))
  5193. (setq index (append index (list (cons heading pos))))))
  5194. ;; Footnotes
  5195. (when markdown-add-footnotes-to-imenu
  5196. (nconc index (markdown-get-defined-footnotes)))
  5197. index)))
  5198. ;;; References ================================================================
  5199. (defun markdown-reference-goto-definition ()
  5200. "Jump to the definition of the reference at point or create it."
  5201. (interactive)
  5202. (when (thing-at-point-looking-at markdown-regex-link-reference)
  5203. (let* ((text (match-string-no-properties 3))
  5204. (reference (match-string-no-properties 6))
  5205. (target (downcase (if (string= reference "") text reference)))
  5206. (loc (cadr (save-match-data (markdown-reference-definition target)))))
  5207. (if loc
  5208. (goto-char loc)
  5209. (goto-char (match-beginning 0))
  5210. (markdown-insert-reference-definition target)))))
  5211. (defun markdown-reference-find-links (reference)
  5212. "Return a list of all links for REFERENCE.
  5213. REFERENCE should not include the surrounding square brackets.
  5214. Elements of the list have the form (text start line), where
  5215. text is the link text, start is the location at the beginning of
  5216. the link, and line is the line number on which the link appears."
  5217. (let* ((ref-quote (regexp-quote reference))
  5218. (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
  5219. ref-quote ref-quote))
  5220. links)
  5221. (save-excursion
  5222. (goto-char (point-min))
  5223. (while (re-search-forward regexp nil t)
  5224. (let* ((text (or (match-string-no-properties 1)
  5225. (match-string-no-properties 2)))
  5226. (start (match-beginning 0))
  5227. (line (markdown-line-number-at-pos)))
  5228. (cl-pushnew (list text start line) links :test #'equal))))
  5229. links))
  5230. (defmacro markdown-for-all-refs (f)
  5231. `(let ((result))
  5232. (save-excursion
  5233. (goto-char (point-min))
  5234. (while
  5235. (re-search-forward markdown-regex-link-reference nil t)
  5236. (let* ((text (match-string-no-properties 3))
  5237. (reference (match-string-no-properties 6))
  5238. (target (downcase (if (string= reference "") text reference))))
  5239. (,f text target result))))
  5240. (reverse result)))
  5241. (defmacro markdown-collect-always (_ target result)
  5242. `(cl-pushnew ,target ,result :test #'equal))
  5243. (defmacro markdown-collect-undefined (text target result)
  5244. `(unless (markdown-reference-definition target)
  5245. (let ((entry (assoc ,target ,result)))
  5246. (if (not entry)
  5247. (cl-pushnew
  5248. (cons ,target (list (cons ,text (markdown-line-number-at-pos))))
  5249. ,result :test #'equal)
  5250. (setcdr entry
  5251. (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos)))))))))
  5252. (defun markdown-get-all-refs ()
  5253. "Return a list of all Markdown references."
  5254. (markdown-for-all-refs markdown-collect-always))
  5255. (defun markdown-get-undefined-refs ()
  5256. "Return a list of undefined Markdown references.
  5257. Result is an alist of pairs (reference . occurrences), where
  5258. occurrences is itself another alist of pairs (label . line-number).
  5259. For example, an alist corresponding to [Nice editor][Emacs] at line 12,
  5260. \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
  5261. \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
  5262. (markdown-for-all-refs markdown-collect-undefined))
  5263. (defun markdown-get-unused-refs ()
  5264. (cl-sort
  5265. (cl-set-difference
  5266. (markdown-get-defined-references) (markdown-get-all-refs)
  5267. :test (lambda (e1 e2) (equal (car e1) e2)))
  5268. #'< :key #'cdr))
  5269. (defmacro defun-markdown-buffer (name docstring)
  5270. "Define a function to name and return a buffer.
  5271. By convention, NAME must be a name of a string constant with
  5272. %buffer% placeholder used to name the buffer, and will also be
  5273. used as a name of the function defined.
  5274. DOCSTRING will be used as the first part of the docstring."
  5275. `(defun ,name (&optional buffer-name)
  5276. ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.")
  5277. (or buffer-name (setq buffer-name (buffer-name)))
  5278. (let ((refbuf (get-buffer-create (replace-regexp-in-string
  5279. "%buffer%" buffer-name
  5280. ,name))))
  5281. (with-current-buffer refbuf
  5282. (when view-mode
  5283. (View-exit-and-edit))
  5284. (use-local-map button-buffer-map)
  5285. (erase-buffer))
  5286. refbuf)))
  5287. (defconst markdown-reference-check-buffer
  5288. "*Undefined references for %buffer%*"
  5289. "Pattern for name of buffer for listing undefined references.
  5290. The string %buffer% will be replaced by the corresponding
  5291. `markdown-mode' buffer name.")
  5292. (defun-markdown-buffer
  5293. markdown-reference-check-buffer
  5294. "Name and return buffer for reference checking.")
  5295. (defconst markdown-unused-references-buffer
  5296. "*Unused references for %buffer%*"
  5297. "Pattern for name of buffer for listing unused references.
  5298. The string %buffer% will be replaced by the corresponding
  5299. `markdown-mode' buffer name.")
  5300. (defun-markdown-buffer
  5301. markdown-unused-references-buffer
  5302. "Name and return buffer for unused reference checking.")
  5303. (defconst markdown-reference-links-buffer
  5304. "*Reference links for %buffer%*"
  5305. "Pattern for name of buffer for listing references.
  5306. The string %buffer% will be replaced by the corresponding buffer name.")
  5307. (defun-markdown-buffer
  5308. markdown-reference-links-buffer
  5309. "Name, setup, and return a buffer for listing links.")
  5310. ;; Add an empty Markdown reference definition to buffer
  5311. ;; specified in the 'target-buffer property. The reference name is
  5312. ;; the button's label.
  5313. (define-button-type 'markdown-undefined-reference-button
  5314. 'help-echo "mouse-1, RET: create definition for undefined reference"
  5315. 'follow-link t
  5316. 'face 'bold
  5317. 'action (lambda (b)
  5318. (let ((buffer (button-get b 'target-buffer))
  5319. (line (button-get b 'target-line))
  5320. (label (button-label b)))
  5321. (switch-to-buffer-other-window buffer)
  5322. (goto-char (point-min))
  5323. (forward-line line)
  5324. (markdown-insert-reference-definition label)
  5325. (markdown-check-refs t))))
  5326. ;; Jump to line in buffer specified by 'target-buffer property.
  5327. ;; Line number is button's 'target-line property.
  5328. (define-button-type 'markdown-goto-line-button
  5329. 'help-echo "mouse-1, RET: go to line"
  5330. 'follow-link t
  5331. 'face 'italic
  5332. 'action (lambda (b)
  5333. (switch-to-buffer-other-window (button-get b 'target-buffer))
  5334. ;; use call-interactively to silence compiler
  5335. (let ((current-prefix-arg (button-get b 'target-line)))
  5336. (call-interactively 'goto-line))))
  5337. ;; Kill a line in buffer specified by 'target-buffer property.
  5338. ;; Line number is button's 'target-line property.
  5339. (define-button-type 'markdown-kill-line-button
  5340. 'help-echo "mouse-1, RET: kill line"
  5341. 'follow-link t
  5342. 'face 'italic
  5343. 'action (lambda (b)
  5344. (switch-to-buffer-other-window (button-get b 'target-buffer))
  5345. ;; use call-interactively to silence compiler
  5346. (let ((current-prefix-arg (button-get b 'target-line)))
  5347. (call-interactively 'goto-line))
  5348. (kill-line 1)
  5349. (markdown-unused-refs t)))
  5350. ;; Jumps to a particular link at location given by 'target-char
  5351. ;; property in buffer given by 'target-buffer property.
  5352. (define-button-type 'markdown-location-button
  5353. 'help-echo "mouse-1, RET: jump to location of link"
  5354. 'follow-link t
  5355. 'face 'bold
  5356. 'action (lambda (b)
  5357. (let ((target (button-get b 'target-buffer))
  5358. (loc (button-get b 'target-char)))
  5359. (kill-buffer-and-window)
  5360. (switch-to-buffer target)
  5361. (goto-char loc))))
  5362. (defun markdown-insert-undefined-reference-button (reference oldbuf)
  5363. "Insert a button for creating REFERENCE in buffer OLDBUF.
  5364. REFERENCE should be a list of the form (reference . occurrences),
  5365. as returned by `markdown-get-undefined-refs'."
  5366. (let ((label (car reference)))
  5367. ;; Create a reference button
  5368. (insert-button label
  5369. :type 'markdown-undefined-reference-button
  5370. 'target-buffer oldbuf
  5371. 'target-line (cdr (car (cdr reference))))
  5372. (insert " (")
  5373. (dolist (occurrence (cdr reference))
  5374. (let ((line (cdr occurrence)))
  5375. ;; Create a line number button
  5376. (insert-button (number-to-string line)
  5377. :type 'markdown-goto-line-button
  5378. 'target-buffer oldbuf
  5379. 'target-line line)
  5380. (insert " ")))
  5381. (delete-char -1)
  5382. (insert ")")
  5383. (newline)))
  5384. (defun markdown-insert-unused-reference-button (reference oldbuf)
  5385. "Insert a button for creating REFERENCE in buffer OLDBUF.
  5386. REFERENCE must be a pair of (ref . line-number)."
  5387. (let ((label (car reference))
  5388. (line (cdr reference)))
  5389. ;; Create a reference button
  5390. (insert-button label
  5391. :type 'markdown-goto-line-button
  5392. 'face 'bold
  5393. 'target-buffer oldbuf
  5394. 'target-line line)
  5395. (insert (format " (%d) [" line))
  5396. (insert-button "X"
  5397. :type 'markdown-kill-line-button
  5398. 'face 'bold
  5399. 'target-buffer oldbuf
  5400. 'target-line line)
  5401. (insert "]")
  5402. (newline)))
  5403. (defun markdown-insert-link-button (link oldbuf)
  5404. "Insert a button for jumping to LINK in buffer OLDBUF.
  5405. LINK should be a list of the form (text char line) containing
  5406. the link text, location, and line number."
  5407. (let ((label (cl-first link))
  5408. (char (cl-second link))
  5409. (line (cl-third link)))
  5410. ;; Create a reference button
  5411. (insert-button label
  5412. :type 'markdown-location-button
  5413. 'target-buffer oldbuf
  5414. 'target-char char)
  5415. (insert (format " (line %d)\n" line))))
  5416. (defun markdown-reference-goto-link (&optional reference)
  5417. "Jump to the location of the first use of REFERENCE."
  5418. (interactive)
  5419. (unless reference
  5420. (if (thing-at-point-looking-at markdown-regex-reference-definition)
  5421. (setq reference (match-string-no-properties 2))
  5422. (user-error "No reference definition at point")))
  5423. (let ((links (markdown-reference-find-links reference)))
  5424. (cond ((= (length links) 1)
  5425. (goto-char (cadr (car links))))
  5426. ((> (length links) 1)
  5427. (let ((oldbuf (current-buffer))
  5428. (linkbuf (markdown-reference-links-buffer)))
  5429. (with-current-buffer linkbuf
  5430. (insert "Links using reference " reference ":\n\n")
  5431. (dolist (link (reverse links))
  5432. (markdown-insert-link-button link oldbuf)))
  5433. (view-buffer-other-window linkbuf)
  5434. (goto-char (point-min))
  5435. (forward-line 2)))
  5436. (t
  5437. (error "No links for reference %s" reference)))))
  5438. (defmacro defun-markdown-ref-checker
  5439. (name docstring checker-function buffer-function none-message buffer-header insert-reference)
  5440. "Define a function NAME acting on result of CHECKER-FUNCTION.
  5441. DOCSTRING is used as a docstring for the defined function.
  5442. BUFFER-FUNCTION should name and return an auxiliary buffer to put
  5443. results in.
  5444. NONE-MESSAGE is used when CHECKER-FUNCTION returns no results.
  5445. BUFFER-HEADER is put into the auxiliary buffer first, followed by
  5446. calling INSERT-REFERENCE for each element in the list returned by
  5447. CHECKER-FUNCTION."
  5448. `(defun ,name (&optional silent)
  5449. ,(concat
  5450. docstring
  5451. "\n\nIf SILENT is non-nil, do not message anything when no
  5452. such references found.")
  5453. (interactive "P")
  5454. (unless (derived-mode-p 'markdown-mode)
  5455. (user-error "Not available in current mode"))
  5456. (let ((oldbuf (current-buffer))
  5457. (refs (,checker-function))
  5458. (refbuf (,buffer-function)))
  5459. (if (null refs)
  5460. (progn
  5461. (when (not silent)
  5462. (message ,none-message))
  5463. (kill-buffer refbuf))
  5464. (with-current-buffer refbuf
  5465. (insert ,buffer-header)
  5466. (dolist (ref refs)
  5467. (,insert-reference ref oldbuf))
  5468. (view-buffer-other-window refbuf)
  5469. (goto-char (point-min))
  5470. (forward-line 2))))))
  5471. (defun-markdown-ref-checker
  5472. markdown-check-refs
  5473. "Show all undefined Markdown references in current `markdown-mode' buffer.
  5474. Links which have empty reference definitions are considered to be
  5475. defined."
  5476. markdown-get-undefined-refs
  5477. markdown-reference-check-buffer
  5478. "No undefined references found"
  5479. "The following references are undefined:\n\n"
  5480. markdown-insert-undefined-reference-button)
  5481. (defun-markdown-ref-checker
  5482. markdown-unused-refs
  5483. "Show all unused Markdown references in current `markdown-mode' buffer."
  5484. markdown-get-unused-refs
  5485. markdown-unused-references-buffer
  5486. "No unused references found"
  5487. "The following references are unused:\n\n"
  5488. markdown-insert-unused-reference-button)
  5489. ;;; Lists =====================================================================
  5490. (defun markdown-insert-list-item (&optional arg)
  5491. "Insert a new list item.
  5492. If the point is inside unordered list, insert a bullet mark. If
  5493. the point is inside ordered list, insert the next number followed
  5494. by a period. Use the previous list item to determine the amount
  5495. of whitespace to place before and after list markers.
  5496. With a \\[universal-argument] prefix (i.e., when ARG is (4)),
  5497. decrease the indentation by one level.
  5498. With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
  5499. increase the indentation by one level."
  5500. (interactive "p")
  5501. (let (bounds cur-indent marker indent new-indent new-loc)
  5502. (save-match-data
  5503. ;; Look for a list item on current or previous non-blank line
  5504. (save-excursion
  5505. (while (and (not (setq bounds (markdown-cur-list-item-bounds)))
  5506. (not (bobp))
  5507. (markdown-cur-line-blank-p))
  5508. (forward-line -1)))
  5509. (when bounds
  5510. (cond ((save-excursion
  5511. (skip-chars-backward " \t")
  5512. (looking-at-p markdown-regex-list))
  5513. (beginning-of-line)
  5514. (insert "\n")
  5515. (forward-line -1))
  5516. ((not (markdown-cur-line-blank-p))
  5517. (newline)))
  5518. (setq new-loc (point)))
  5519. ;; Look ahead for a list item on next non-blank line
  5520. (unless bounds
  5521. (save-excursion
  5522. (while (and (null bounds)
  5523. (not (eobp))
  5524. (markdown-cur-line-blank-p))
  5525. (forward-line)
  5526. (setq bounds (markdown-cur-list-item-bounds))))
  5527. (when bounds
  5528. (setq new-loc (point))
  5529. (unless (markdown-cur-line-blank-p)
  5530. (newline))))
  5531. (if (not bounds)
  5532. ;; When not in a list, start a new unordered one
  5533. (progn
  5534. (unless (markdown-cur-line-blank-p)
  5535. (insert "\n"))
  5536. (insert markdown-unordered-list-item-prefix))
  5537. ;; Compute indentation and marker for new list item
  5538. (setq cur-indent (nth 2 bounds))
  5539. (setq marker (nth 4 bounds))
  5540. ;; If current item is a GFM checkbox, insert new unchecked checkbox.
  5541. (when (nth 5 bounds)
  5542. (setq marker
  5543. (concat marker
  5544. (replace-regexp-in-string "[Xx]" " " (nth 5 bounds)))))
  5545. (cond
  5546. ;; Dedent: decrement indentation, find previous marker.
  5547. ((= arg 4)
  5548. (setq indent (max (- cur-indent markdown-list-indent-width) 0))
  5549. (let ((prev-bounds
  5550. (save-excursion
  5551. (goto-char (nth 0 bounds))
  5552. (when (markdown-up-list)
  5553. (markdown-cur-list-item-bounds)))))
  5554. (when prev-bounds
  5555. (setq marker (nth 4 prev-bounds)))))
  5556. ;; Indent: increment indentation by 4, use same marker.
  5557. ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width)))
  5558. ;; Same level: keep current indentation and marker.
  5559. (t (setq indent cur-indent)))
  5560. (setq new-indent (make-string indent 32))
  5561. (goto-char new-loc)
  5562. (cond
  5563. ;; Ordered list
  5564. ((string-match-p "[0-9]" marker)
  5565. (if (= arg 16) ;; starting a new column indented one more level
  5566. (insert (concat new-indent "1. "))
  5567. ;; Don't use previous match-data
  5568. (set-match-data nil)
  5569. ;; travel up to the last item and pick the correct number. If
  5570. ;; the argument was nil, "new-indent = cur-indent" is the same,
  5571. ;; so we don't need special treatment. Neat.
  5572. (save-excursion
  5573. (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)")))
  5574. (>= (forward-line -1) 0))))
  5575. (let* ((old-prefix (match-string 1))
  5576. (old-spacing (match-string 2))
  5577. (new-prefix (if (and old-prefix markdown-ordered-list-enumeration)
  5578. (int-to-string (1+ (string-to-number old-prefix)))
  5579. "1"))
  5580. (space-adjust (- (length old-prefix) (length new-prefix)))
  5581. (new-spacing (if (and (match-string 2)
  5582. (not (string-match-p "\t" old-spacing))
  5583. (< space-adjust 0)
  5584. (> space-adjust (- 1 (length (match-string 2)))))
  5585. (substring (match-string 2) 0 space-adjust)
  5586. (or old-spacing ". "))))
  5587. (insert (concat new-indent new-prefix new-spacing)))))
  5588. ;; Unordered list, GFM task list, or ordered list with hash mark
  5589. ((string-match-p "[\\*\\+-]\\|#\\." marker)
  5590. (insert new-indent marker))))
  5591. ;; Propertize the newly inserted list item now
  5592. (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol)))))
  5593. (defun markdown-move-list-item-up ()
  5594. "Move the current list item up in the list when possible.
  5595. In nested lists, move child items with the parent item."
  5596. (interactive)
  5597. (let (cur prev old)
  5598. (when (setq cur (markdown-cur-list-item-bounds))
  5599. (setq old (point))
  5600. (goto-char (nth 0 cur))
  5601. (if (markdown-prev-list-item (nth 3 cur))
  5602. (progn
  5603. (setq prev (markdown-cur-list-item-bounds))
  5604. (condition-case nil
  5605. (progn
  5606. (transpose-regions (nth 0 prev) (nth 1 prev)
  5607. (nth 0 cur) (nth 1 cur) t)
  5608. (goto-char (+ (nth 0 prev) (- old (nth 0 cur)))))
  5609. ;; Catch error in case regions overlap.
  5610. (error (goto-char old))))
  5611. (goto-char old)))))
  5612. (defun markdown-move-list-item-down ()
  5613. "Move the current list item down in the list when possible.
  5614. In nested lists, move child items with the parent item."
  5615. (interactive)
  5616. (let (cur next old)
  5617. (when (setq cur (markdown-cur-list-item-bounds))
  5618. (setq old (point))
  5619. (if (markdown-next-list-item (nth 3 cur))
  5620. (progn
  5621. (setq next (markdown-cur-list-item-bounds))
  5622. (condition-case nil
  5623. (progn
  5624. (transpose-regions (nth 0 cur) (nth 1 cur)
  5625. (nth 0 next) (nth 1 next) nil)
  5626. (goto-char (+ old (- (nth 1 next) (nth 1 cur)))))
  5627. ;; Catch error in case regions overlap.
  5628. (error (goto-char old))))
  5629. (goto-char old)))))
  5630. (defun markdown-demote-list-item (&optional bounds)
  5631. "Indent (or demote) the current list item.
  5632. Optionally, BOUNDS of the current list item may be provided if available.
  5633. In nested lists, demote child items as well."
  5634. (interactive)
  5635. (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
  5636. (save-excursion
  5637. (let* ((item-start (set-marker (make-marker) (nth 0 bounds)))
  5638. (item-end (set-marker (make-marker) (nth 1 bounds)))
  5639. (list-start (progn (markdown-beginning-of-list)
  5640. (set-marker (make-marker) (point))))
  5641. (list-end (progn (markdown-end-of-list)
  5642. (set-marker (make-marker) (point)))))
  5643. (goto-char item-start)
  5644. (while (< (point) item-end)
  5645. (unless (markdown-cur-line-blank-p)
  5646. (insert (make-string markdown-list-indent-width ? )))
  5647. (forward-line))
  5648. (markdown-syntax-propertize-list-items list-start list-end)))))
  5649. (defun markdown-promote-list-item (&optional bounds)
  5650. "Unindent (or promote) the current list item.
  5651. Optionally, BOUNDS of the current list item may be provided if available.
  5652. In nested lists, demote child items as well."
  5653. (interactive)
  5654. (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
  5655. (save-excursion
  5656. (save-match-data
  5657. (let ((item-start (set-marker (make-marker) (nth 0 bounds)))
  5658. (item-end (set-marker (make-marker) (nth 1 bounds)))
  5659. (list-start (progn (markdown-beginning-of-list)
  5660. (set-marker (make-marker) (point))))
  5661. (list-end (progn (markdown-end-of-list)
  5662. (set-marker (make-marker) (point))))
  5663. num regexp)
  5664. (goto-char item-start)
  5665. (when (looking-at (format "^[ ]\\{1,%d\\}"
  5666. markdown-list-indent-width))
  5667. (setq num (- (match-end 0) (match-beginning 0)))
  5668. (setq regexp (format "^[ ]\\{1,%d\\}" num))
  5669. (while (and (< (point) item-end)
  5670. (re-search-forward regexp item-end t))
  5671. (replace-match "" nil nil)
  5672. (forward-line))
  5673. (markdown-syntax-propertize-list-items list-start list-end)))))))
  5674. (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item)
  5675. "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM.
  5676. PREV-ITEM is width of previous-indentation and list number
  5677. Assume that the previously found match was for a numbered item in
  5678. a list."
  5679. (let ((cpfx pfx)
  5680. (cur-item nil)
  5681. (idx 0)
  5682. (continue t)
  5683. (step t)
  5684. (sep nil))
  5685. (while (and continue (not (eobp)))
  5686. (setq step t)
  5687. (cond
  5688. ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ")
  5689. (setq cpfx (match-string-no-properties 2))
  5690. (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker
  5691. (cond
  5692. ((or (= (length cpfx) (length pfx))
  5693. (= (length cur-item) (length prev-item)))
  5694. (save-excursion
  5695. (replace-match
  5696. (if (not markdown-ordered-list-enumeration)
  5697. (concat pfx "1. ")
  5698. (cl-incf idx)
  5699. (concat pfx (number-to-string idx) ". "))))
  5700. (setq sep nil))
  5701. ;; indented a level
  5702. ((< (length pfx) (length cpfx))
  5703. (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item))
  5704. (setq step nil))
  5705. ;; exit the loop
  5706. (t
  5707. (setq step nil)
  5708. (setq continue nil))))
  5709. ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
  5710. (setq cpfx (match-string-no-properties 1))
  5711. (cond
  5712. ;; reset if separated before
  5713. ((string= cpfx pfx) (when sep (setq idx 0)))
  5714. ((string< cpfx pfx)
  5715. (setq step nil)
  5716. (setq continue nil))))
  5717. (t (setq sep t)))
  5718. (when step
  5719. (beginning-of-line)
  5720. (setq continue (= (forward-line) 0))))
  5721. sep))
  5722. (defun markdown-cleanup-list-numbers ()
  5723. "Update the numbering of ordered lists."
  5724. (interactive)
  5725. (save-excursion
  5726. (goto-char (point-min))
  5727. (markdown-cleanup-list-numbers-level "")))
  5728. ;;; Movement ==================================================================
  5729. (defun markdown-beginning-of-defun (&optional arg)
  5730. "`beginning-of-defun-function' for Markdown.
  5731. This is used to find the beginning of the defun and should behave
  5732. like beginning-of-defun, returning non-nil if it found the
  5733. beginning of a defun. It moves the point backward, right before a
  5734. heading which defines a defun. When ARG is non-nil, repeat that
  5735. many times. When ARG is negative, move forward to the ARG-th
  5736. following section."
  5737. (or arg (setq arg 1))
  5738. (when (< arg 0) (end-of-line))
  5739. ;; Adjust position for setext headings.
  5740. (when (and (thing-at-point-looking-at markdown-regex-header-setext)
  5741. (not (= (point) (match-beginning 0)))
  5742. (not (markdown-code-block-at-point-p)))
  5743. (goto-char (match-end 0)))
  5744. (let (found)
  5745. ;; Move backward with positive argument.
  5746. (while (and (not (bobp)) (> arg 0))
  5747. (setq found nil)
  5748. (while (and (not found)
  5749. (not (bobp))
  5750. (re-search-backward markdown-regex-header nil 'move))
  5751. (when (not (markdown-code-block-at-pos (match-beginning 0))))
  5752. (setq found (match-beginning 0)))
  5753. (setq arg (1- arg)))
  5754. ;; Move forward with negative argument.
  5755. (while (and (not (eobp)) (< arg 0))
  5756. (setq found nil)
  5757. (while (and (not found)
  5758. (not (eobp))
  5759. (re-search-forward markdown-regex-header nil 'move))
  5760. (when (not (markdown-code-block-at-pos (match-beginning 0))))
  5761. (setq found (match-beginning 0)))
  5762. (setq arg (1+ arg)))
  5763. (when found
  5764. (beginning-of-line)
  5765. t)))
  5766. (defun markdown-end-of-defun ()
  5767. "`end-of-defun-function’ for Markdown.
  5768. This is used to find the end of the defun at point.
  5769. It is called with no argument, right after calling beginning-of-defun-raw,
  5770. so it can assume that point is at the beginning of the defun body.
  5771. It should move point to the first position after the defun."
  5772. (or (eobp) (forward-char 1))
  5773. (let (found)
  5774. (while (and (not found)
  5775. (not (eobp))
  5776. (re-search-forward markdown-regex-header nil 'move))
  5777. (when (not (markdown-code-block-at-pos (match-beginning 0)))
  5778. (setq found (match-beginning 0))))
  5779. (when found
  5780. (goto-char found)
  5781. (skip-syntax-backward "-"))))
  5782. (defun markdown-beginning-of-text-block ()
  5783. "Move backward to previous beginning of a plain text block.
  5784. This function simply looks for blank lines without considering
  5785. the surrounding context in light of Markdown syntax. For that, see
  5786. `markdown-backward-block'."
  5787. (interactive)
  5788. (let ((start (point)))
  5789. (if (re-search-backward markdown-regex-block-separator nil t)
  5790. (goto-char (match-end 0))
  5791. (goto-char (point-min)))
  5792. (when (and (= start (point)) (not (bobp)))
  5793. (forward-line -1)
  5794. (if (re-search-backward markdown-regex-block-separator nil t)
  5795. (goto-char (match-end 0))
  5796. (goto-char (point-min))))))
  5797. (defun markdown-end-of-text-block ()
  5798. "Move forward to next beginning of a plain text block.
  5799. This function simply looks for blank lines without considering
  5800. the surrounding context in light of Markdown syntax. For that, see
  5801. `markdown-forward-block'."
  5802. (interactive)
  5803. (beginning-of-line)
  5804. (skip-chars-forward " \t\n")
  5805. (when (= (point) (point-min))
  5806. (forward-char))
  5807. (if (re-search-forward markdown-regex-block-separator nil t)
  5808. (goto-char (match-end 0))
  5809. (goto-char (point-max)))
  5810. (skip-chars-backward " \t\n")
  5811. (forward-line))
  5812. (defun markdown-backward-paragraph (&optional arg)
  5813. "Move the point to the start of the current paragraph.
  5814. With argument ARG, do it ARG times; a negative argument ARG = -N
  5815. means move forward N blocks."
  5816. (interactive "^p")
  5817. (or arg (setq arg 1))
  5818. (if (< arg 0)
  5819. (markdown-forward-paragraph (- arg))
  5820. (dotimes (_ arg)
  5821. ;; Skip over whitespace in between paragraphs when moving backward.
  5822. (skip-chars-backward " \t\n")
  5823. (beginning-of-line)
  5824. ;; Skip over code block endings.
  5825. (when (markdown-range-properties-exist
  5826. (point-at-bol) (point-at-eol)
  5827. '(markdown-gfm-block-end
  5828. markdown-tilde-fence-end))
  5829. (forward-line -1))
  5830. ;; Skip over blank lines inside blockquotes.
  5831. (while (and (not (eobp))
  5832. (looking-at markdown-regex-blockquote)
  5833. (= (length (match-string 3)) 0))
  5834. (forward-line -1))
  5835. ;; Proceed forward based on the type of block of paragraph.
  5836. (let (bounds skip)
  5837. (cond
  5838. ;; Blockquotes
  5839. ((looking-at markdown-regex-blockquote)
  5840. (while (and (not (bobp))
  5841. (looking-at markdown-regex-blockquote)
  5842. (> (length (match-string 3)) 0)) ;; not blank
  5843. (forward-line -1))
  5844. (forward-line))
  5845. ;; List items
  5846. ((setq bounds (markdown-cur-list-item-bounds))
  5847. (goto-char (nth 0 bounds)))
  5848. ;; Other
  5849. (t
  5850. (while (and (not (bobp))
  5851. (not skip)
  5852. (not (markdown-cur-line-blank-p))
  5853. (not (looking-at markdown-regex-blockquote))
  5854. (not (markdown-range-properties-exist
  5855. (point-at-bol) (point-at-eol)
  5856. '(markdown-gfm-block-end
  5857. markdown-tilde-fence-end))))
  5858. (setq skip (markdown-range-properties-exist
  5859. (point-at-bol) (point-at-eol)
  5860. '(markdown-gfm-block-begin
  5861. markdown-tilde-fence-begin)))
  5862. (forward-line -1))
  5863. (unless (bobp)
  5864. (forward-line 1))))))))
  5865. (defun markdown-forward-paragraph (&optional arg)
  5866. "Move forward to the next end of a paragraph.
  5867. With argument ARG, do it ARG times; a negative argument ARG = -N
  5868. means move backward N blocks."
  5869. (interactive "^p")
  5870. (or arg (setq arg 1))
  5871. (if (< arg 0)
  5872. (markdown-backward-paragraph (- arg))
  5873. (dotimes (_ arg)
  5874. ;; Skip whitespace in between paragraphs.
  5875. (when (markdown-cur-line-blank-p)
  5876. (skip-syntax-forward "-")
  5877. (beginning-of-line))
  5878. ;; Proceed forward based on the type of block.
  5879. (let (bounds skip)
  5880. (cond
  5881. ;; Blockquotes
  5882. ((looking-at markdown-regex-blockquote)
  5883. ;; Skip over blank lines inside blockquotes.
  5884. (while (and (not (eobp))
  5885. (looking-at markdown-regex-blockquote)
  5886. (= (length (match-string 3)) 0))
  5887. (forward-line))
  5888. ;; Move to end of quoted text block
  5889. (while (and (not (eobp))
  5890. (looking-at markdown-regex-blockquote)
  5891. (> (length (match-string 3)) 0)) ;; not blank
  5892. (forward-line)))
  5893. ;; List items
  5894. ((and (markdown-cur-list-item-bounds)
  5895. (setq bounds (markdown-next-list-item-bounds)))
  5896. (goto-char (nth 0 bounds)))
  5897. ;; Other
  5898. (t
  5899. (forward-line)
  5900. (while (and (not (eobp))
  5901. (not skip)
  5902. (not (markdown-cur-line-blank-p))
  5903. (not (looking-at markdown-regex-blockquote))
  5904. (not (markdown-range-properties-exist
  5905. (point-at-bol) (point-at-eol)
  5906. '(markdown-gfm-block-begin
  5907. markdown-tilde-fence-begin))))
  5908. (setq skip (markdown-range-properties-exist
  5909. (point-at-bol) (point-at-eol)
  5910. '(markdown-gfm-block-end
  5911. markdown-tilde-fence-end)))
  5912. (forward-line))))))))
  5913. (defun markdown-backward-block (&optional arg)
  5914. "Move the point to the start of the current Markdown block.
  5915. Moves across complete code blocks, list items, and blockquotes,
  5916. but otherwise stops at blank lines, headers, and horizontal
  5917. rules. With argument ARG, do it ARG times; a negative argument
  5918. ARG = -N means move forward N blocks."
  5919. (interactive "^p")
  5920. (or arg (setq arg 1))
  5921. (if (< arg 0)
  5922. (markdown-forward-block (- arg))
  5923. (dotimes (_ arg)
  5924. ;; Skip over whitespace in between blocks when moving backward,
  5925. ;; unless at a block boundary with no whitespace.
  5926. (skip-syntax-backward "-")
  5927. (beginning-of-line)
  5928. ;; Proceed forward based on the type of block.
  5929. (cond
  5930. ;; Code blocks
  5931. ((and (markdown-code-block-at-pos (point)) ;; this line
  5932. (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line
  5933. (forward-line -1)
  5934. (while (and (markdown-code-block-at-point-p) (not (bobp)))
  5935. (forward-line -1))
  5936. (forward-line))
  5937. ;; Headings
  5938. ((markdown-heading-at-point)
  5939. (goto-char (match-beginning 0)))
  5940. ;; Horizontal rules
  5941. ((looking-at markdown-regex-hr))
  5942. ;; Blockquotes
  5943. ((looking-at markdown-regex-blockquote)
  5944. (forward-line -1)
  5945. (while (and (looking-at markdown-regex-blockquote)
  5946. (not (bobp)))
  5947. (forward-line -1))
  5948. (forward-line))
  5949. ;; List items
  5950. ((markdown-cur-list-item-bounds)
  5951. (markdown-beginning-of-list))
  5952. ;; Other
  5953. (t
  5954. ;; Move forward in case it is a one line regular paragraph.
  5955. (unless (markdown-next-line-blank-p)
  5956. (forward-line))
  5957. (unless (markdown-prev-line-blank-p)
  5958. (markdown-backward-paragraph)))))))
  5959. (defun markdown-forward-block (&optional arg)
  5960. "Move forward to the next end of a Markdown block.
  5961. Moves across complete code blocks, list items, and blockquotes,
  5962. but otherwise stops at blank lines, headers, and horizontal
  5963. rules. With argument ARG, do it ARG times; a negative argument
  5964. ARG = -N means move backward N blocks."
  5965. (interactive "^p")
  5966. (or arg (setq arg 1))
  5967. (if (< arg 0)
  5968. (markdown-backward-block (- arg))
  5969. (dotimes (_ arg)
  5970. ;; Skip over whitespace in between blocks when moving forward.
  5971. (if (markdown-cur-line-blank-p)
  5972. (skip-syntax-forward "-")
  5973. (beginning-of-line))
  5974. ;; Proceed forward based on the type of block.
  5975. (cond
  5976. ;; Code blocks
  5977. ((markdown-code-block-at-point-p)
  5978. (forward-line)
  5979. (while (and (markdown-code-block-at-point-p) (not (eobp)))
  5980. (forward-line)))
  5981. ;; Headings
  5982. ((looking-at markdown-regex-header)
  5983. (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
  5984. (forward-line))
  5985. ;; Horizontal rules
  5986. ((looking-at markdown-regex-hr)
  5987. (forward-line))
  5988. ;; Blockquotes
  5989. ((looking-at markdown-regex-blockquote)
  5990. (forward-line)
  5991. (while (and (looking-at markdown-regex-blockquote) (not (eobp)))
  5992. (forward-line)))
  5993. ;; List items
  5994. ((markdown-cur-list-item-bounds)
  5995. (markdown-end-of-list)
  5996. (forward-line))
  5997. ;; Other
  5998. (t (markdown-forward-paragraph))))
  5999. (skip-syntax-backward "-")
  6000. (unless (eobp)
  6001. (forward-char 1))))
  6002. (defun markdown-backward-page (&optional count)
  6003. "Move backward to boundary of the current toplevel section.
  6004. With COUNT, repeat, or go forward if negative."
  6005. (interactive "p")
  6006. (or count (setq count 1))
  6007. (if (< count 0)
  6008. (markdown-forward-page (- count))
  6009. (skip-syntax-backward "-")
  6010. (or (markdown-back-to-heading-over-code-block t t)
  6011. (goto-char (point-min)))
  6012. (when (looking-at markdown-regex-header)
  6013. (let ((level (markdown-outline-level)))
  6014. (when (> level 1) (markdown-up-heading level))
  6015. (when (> count 1)
  6016. (condition-case nil
  6017. (markdown-backward-same-level (1- count))
  6018. (error (goto-char (point-min)))))))))
  6019. (defun markdown-forward-page (&optional count)
  6020. "Move forward to boundary of the current toplevel section.
  6021. With COUNT, repeat, or go backward if negative."
  6022. (interactive "p")
  6023. (or count (setq count 1))
  6024. (if (< count 0)
  6025. (markdown-backward-page (- count))
  6026. (if (markdown-back-to-heading-over-code-block t t)
  6027. (let ((level (markdown-outline-level)))
  6028. (when (> level 1) (markdown-up-heading level))
  6029. (condition-case nil
  6030. (markdown-forward-same-level count)
  6031. (error (goto-char (point-max)))))
  6032. (markdown-next-visible-heading 1))))
  6033. (defun markdown-next-link ()
  6034. "Jump to next inline, reference, or wiki link.
  6035. If successful, return point. Otherwise, return nil.
  6036. See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
  6037. (interactive)
  6038. (let ((opoint (point)))
  6039. (when (or (markdown-link-p) (markdown-wiki-link-p))
  6040. ;; At a link already, move past it.
  6041. (goto-char (+ (match-end 0) 1)))
  6042. ;; Search for the next wiki link and move to the beginning.
  6043. (while (and (re-search-forward (markdown-make-regex-link-generic) nil t)
  6044. (markdown-code-block-at-point-p)
  6045. (< (point) (point-max))))
  6046. (if (and (not (eq (point) opoint))
  6047. (or (markdown-link-p) (markdown-wiki-link-p)))
  6048. ;; Group 1 will move past non-escape character in wiki link regexp.
  6049. ;; Go to beginning of group zero for all other link types.
  6050. (goto-char (or (match-beginning 1) (match-beginning 0)))
  6051. (goto-char opoint)
  6052. nil)))
  6053. (defun markdown-previous-link ()
  6054. "Jump to previous wiki link.
  6055. If successful, return point. Otherwise, return nil.
  6056. See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
  6057. (interactive)
  6058. (let ((opoint (point)))
  6059. (while (and (re-search-backward (markdown-make-regex-link-generic) nil t)
  6060. (markdown-code-block-at-point-p)
  6061. (> (point) (point-min))))
  6062. (if (and (not (eq (point) opoint))
  6063. (or (markdown-link-p) (markdown-wiki-link-p)))
  6064. (goto-char (or (match-beginning 1) (match-beginning 0)))
  6065. (goto-char opoint)
  6066. nil)))
  6067. ;;; Outline ===================================================================
  6068. (defun markdown-move-heading-common (move-fn &optional arg adjust)
  6069. "Wrapper for `outline-mode' functions to skip false positives.
  6070. MOVE-FN is a function and ARG is its argument. For example,
  6071. headings inside preformatted code blocks may match
  6072. `outline-regexp' but should not be considered as headings.
  6073. When ADJUST is non-nil, adjust the point for interactive calls
  6074. to avoid leaving the point at invisible markup. This adjustment
  6075. generally should only be done for interactive calls, since other
  6076. functions may expect the point to be at the beginning of the
  6077. regular expression."
  6078. (let ((prev -1) (start (point)))
  6079. (if arg (funcall move-fn arg) (funcall move-fn))
  6080. (while (and (/= prev (point)) (markdown-code-block-at-point-p))
  6081. (setq prev (point))
  6082. (if arg (funcall move-fn arg) (funcall move-fn)))
  6083. ;; Adjust point for setext headings and invisible text.
  6084. (save-match-data
  6085. (when (and adjust (thing-at-point-looking-at markdown-regex-header))
  6086. (if markdown-hide-markup
  6087. ;; Move to beginning of heading text if markup is hidden.
  6088. (goto-char (or (match-beginning 1) (match-beginning 5)))
  6089. ;; Move to beginning of markup otherwise.
  6090. (goto-char (or (match-beginning 1) (match-beginning 4))))))
  6091. (if (= (point) start) nil (point))))
  6092. (defun markdown-next-visible-heading (arg)
  6093. "Move to the next visible heading line of any level.
  6094. With argument, repeats or can move backward if negative. ARG is
  6095. passed to `outline-next-visible-heading'."
  6096. (interactive "p")
  6097. (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust))
  6098. (defun markdown-previous-visible-heading (arg)
  6099. "Move to the previous visible heading line of any level.
  6100. With argument, repeats or can move backward if negative. ARG is
  6101. passed to `outline-previous-visible-heading'."
  6102. (interactive "p")
  6103. (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust))
  6104. (defun markdown-next-heading ()
  6105. "Move to the next heading line of any level."
  6106. (markdown-move-heading-common #'outline-next-heading))
  6107. (defun markdown-previous-heading ()
  6108. "Move to the previous heading line of any level."
  6109. (markdown-move-heading-common #'outline-previous-heading))
  6110. (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error)
  6111. "Move back to the beginning of the previous heading.
  6112. Returns t if the point is at a heading, the location if a heading
  6113. was found, and nil otherwise.
  6114. Only visible heading lines are considered, unless INVISIBLE-OK is
  6115. non-nil. Throw an error if there is no previous heading unless
  6116. NO-ERROR is non-nil.
  6117. Leaves match data intact for `markdown-regex-header'."
  6118. (beginning-of-line)
  6119. (or (and (markdown-heading-at-point)
  6120. (not (markdown-code-block-at-point-p)))
  6121. (let (found)
  6122. (save-excursion
  6123. (while (and (not found)
  6124. (re-search-backward markdown-regex-header nil t))
  6125. (when (and (or invisible-ok (not (outline-invisible-p)))
  6126. (not (markdown-code-block-at-point-p)))
  6127. (setq found (point))))
  6128. (if (not found)
  6129. (unless no-error (user-error "Before first heading"))
  6130. (setq found (point))))
  6131. (when found (goto-char found)))))
  6132. (defun markdown-forward-same-level (arg)
  6133. "Move forward to the ARG'th heading at same level as this one.
  6134. Stop at the first and last headings of a superior heading."
  6135. (interactive "p")
  6136. (markdown-back-to-heading-over-code-block)
  6137. (markdown-move-heading-common #'outline-forward-same-level arg 'adjust))
  6138. (defun markdown-backward-same-level (arg)
  6139. "Move backward to the ARG'th heading at same level as this one.
  6140. Stop at the first and last headings of a superior heading."
  6141. (interactive "p")
  6142. (markdown-back-to-heading-over-code-block)
  6143. (while (> arg 0)
  6144. (let ((point-to-move-to
  6145. (save-excursion
  6146. (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust))))
  6147. (if point-to-move-to
  6148. (progn
  6149. (goto-char point-to-move-to)
  6150. (setq arg (1- arg)))
  6151. (user-error "No previous same-level heading")))))
  6152. (defun markdown-up-heading (arg &optional interactive)
  6153. "Move to the visible heading line of which the present line is a subheading.
  6154. With argument, move up ARG levels. When called interactively (or
  6155. INTERACTIVE is non-nil), also push the mark."
  6156. (interactive "p\np")
  6157. (and interactive (not (eq last-command 'markdown-up-heading))
  6158. (push-mark))
  6159. (markdown-move-heading-common #'outline-up-heading arg 'adjust))
  6160. (defun markdown-back-to-heading (&optional invisible-ok)
  6161. "Move to previous heading line, or beg of this line if it's a heading.
  6162. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
  6163. (interactive)
  6164. (markdown-move-heading-common #'outline-back-to-heading invisible-ok))
  6165. (defalias 'markdown-end-of-heading 'outline-end-of-heading)
  6166. (defun markdown-on-heading-p ()
  6167. "Return non-nil if point is on a heading line."
  6168. (get-text-property (point-at-bol) 'markdown-heading))
  6169. (defun markdown-end-of-subtree (&optional invisible-OK)
  6170. "Move to the end of the current subtree.
  6171. Only visible heading lines are considered, unless INVISIBLE-OK is
  6172. non-nil.
  6173. Derived from `org-end-of-subtree'."
  6174. (markdown-back-to-heading invisible-OK)
  6175. (let ((first t)
  6176. (level (markdown-outline-level)))
  6177. (while (and (not (eobp))
  6178. (or first (> (markdown-outline-level) level)))
  6179. (setq first nil)
  6180. (markdown-next-heading))
  6181. (if (memq (preceding-char) '(?\n ?\^M))
  6182. (progn
  6183. ;; Go to end of line before heading
  6184. (forward-char -1)
  6185. (if (memq (preceding-char) '(?\n ?\^M))
  6186. ;; leave blank line before heading
  6187. (forward-char -1)))))
  6188. (point))
  6189. (defun markdown-outline-fix-visibility ()
  6190. "Hide any false positive headings that should not be shown.
  6191. For example, headings inside preformatted code blocks may match
  6192. `outline-regexp' but should not be shown as headings when cycling.
  6193. Also, the ending --- line in metadata blocks appears to be a
  6194. setext header, but should not be folded."
  6195. (save-excursion
  6196. (goto-char (point-min))
  6197. ;; Unhide any false positives in metadata blocks
  6198. (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin)
  6199. (let ((body (progn (forward-line)
  6200. (markdown-text-property-at-point
  6201. 'markdown-yaml-metadata-section))))
  6202. (when body
  6203. (let ((end (progn (goto-char (cl-second body))
  6204. (markdown-text-property-at-point
  6205. 'markdown-yaml-metadata-end))))
  6206. (outline-flag-region (point-min) (1+ (cl-second end)) nil)))))
  6207. ;; Hide any false positives in code blocks
  6208. (unless (outline-on-heading-p)
  6209. (outline-next-visible-heading 1))
  6210. (while (< (point) (point-max))
  6211. (when (markdown-code-block-at-point-p)
  6212. (outline-flag-region (1- (point-at-bol)) (point-at-eol) t))
  6213. (outline-next-visible-heading 1))))
  6214. (defvar markdown-cycle-global-status 1)
  6215. (defvar markdown-cycle-subtree-status nil)
  6216. (defun markdown-next-preface ()
  6217. (let (finish)
  6218. (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
  6219. nil 'move))
  6220. (unless (markdown-code-block-at-point-p)
  6221. (goto-char (match-beginning 0))
  6222. (setq finish t))))
  6223. (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
  6224. (forward-char -1)))
  6225. (defun markdown-show-entry ()
  6226. (save-excursion
  6227. (outline-back-to-heading t)
  6228. (outline-flag-region (1- (point))
  6229. (progn
  6230. (markdown-next-preface)
  6231. (if (= 1 (- (point-max) (point)))
  6232. (point-max)
  6233. (point)))
  6234. nil)))
  6235. ;; This function was originally derived from `org-cycle' from org.el.
  6236. (defun markdown-cycle (&optional arg)
  6237. "Visibility cycling for Markdown mode.
  6238. This function is called with a `\\[universal-argument]' or if ARG is t, perform
  6239. global visibility cycling. If the point is at an atx-style header, cycle
  6240. visibility of the corresponding subtree. Otherwise, indent the current line
  6241. or insert a tab, as appropriate, by calling `indent-for-tab-command'."
  6242. (interactive "P")
  6243. (cond
  6244. ;; Global cycling
  6245. (arg
  6246. (cond
  6247. ;; Move from overview to contents
  6248. ((and (eq last-command this-command)
  6249. (eq markdown-cycle-global-status 2))
  6250. (outline-hide-sublevels 1)
  6251. (message "CONTENTS")
  6252. (setq markdown-cycle-global-status 3)
  6253. (markdown-outline-fix-visibility))
  6254. ;; Move from contents to all
  6255. ((and (eq last-command this-command)
  6256. (eq markdown-cycle-global-status 3))
  6257. (outline-show-all)
  6258. (message "SHOW ALL")
  6259. (setq markdown-cycle-global-status 1))
  6260. ;; Defaults to overview
  6261. (t
  6262. (outline-hide-body)
  6263. (message "OVERVIEW")
  6264. (setq markdown-cycle-global-status 2)
  6265. (markdown-outline-fix-visibility))))
  6266. ;; At a heading: rotate between three different views
  6267. ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
  6268. (markdown-back-to-heading)
  6269. (let ((goal-column 0) eoh eol eos)
  6270. ;; Determine boundaries
  6271. (save-excursion
  6272. (markdown-back-to-heading)
  6273. (save-excursion
  6274. (beginning-of-line 2)
  6275. (while (and (not (eobp)) ;; this is like `next-line'
  6276. (get-char-property (1- (point)) 'invisible))
  6277. (beginning-of-line 2)) (setq eol (point)))
  6278. (markdown-end-of-heading) (setq eoh (point))
  6279. (markdown-end-of-subtree t)
  6280. (skip-chars-forward " \t\n")
  6281. (beginning-of-line 1) ; in case this is an item
  6282. (setq eos (1- (point))))
  6283. ;; Find out what to do next and set `this-command'
  6284. (cond
  6285. ;; Nothing is hidden behind this heading
  6286. ((= eos eoh)
  6287. (message "EMPTY ENTRY")
  6288. (setq markdown-cycle-subtree-status nil))
  6289. ;; Entire subtree is hidden in one line: open it
  6290. ((>= eol eos)
  6291. (markdown-show-entry)
  6292. (outline-show-children)
  6293. (message "CHILDREN")
  6294. (setq markdown-cycle-subtree-status 'children))
  6295. ;; We just showed the children, now show everything.
  6296. ((and (eq last-command this-command)
  6297. (eq markdown-cycle-subtree-status 'children))
  6298. (outline-show-subtree)
  6299. (message "SUBTREE")
  6300. (setq markdown-cycle-subtree-status 'subtree))
  6301. ;; Default action: hide the subtree.
  6302. (t
  6303. (outline-hide-subtree)
  6304. (message "FOLDED")
  6305. (setq markdown-cycle-subtree-status 'folded)))))
  6306. ;; In a table, move forward by one cell
  6307. ((markdown-table-at-point-p)
  6308. (call-interactively #'markdown-table-forward-cell))
  6309. ;; Otherwise, indent as appropriate
  6310. (t
  6311. (indent-for-tab-command))))
  6312. (defun markdown-shifttab ()
  6313. "Handle S-TAB keybinding based on context.
  6314. When in a table, move backward one cell.
  6315. Otherwise, cycle global heading visibility by calling
  6316. `markdown-cycle' with argument t."
  6317. (interactive)
  6318. (cond ((markdown-table-at-point-p)
  6319. (call-interactively #'markdown-table-backward-cell))
  6320. (t (markdown-cycle t))))
  6321. (defun markdown-outline-level ()
  6322. "Return the depth to which a statement is nested in the outline."
  6323. (cond
  6324. ((and (match-beginning 0)
  6325. (markdown-code-block-at-pos (match-beginning 0)))
  6326. 7) ;; Only 6 header levels are defined.
  6327. ((match-end 2) 1)
  6328. ((match-end 3) 2)
  6329. ((match-end 4)
  6330. (length (markdown-trim-whitespace (match-string-no-properties 4))))))
  6331. (defun markdown-promote-subtree (&optional arg)
  6332. "Promote the current subtree of ATX headings.
  6333. Note that Markdown does not support heading levels higher than
  6334. six and therefore level-six headings will not be promoted
  6335. further. If ARG is non-nil promote the heading, otherwise
  6336. demote."
  6337. (interactive "*P")
  6338. (save-excursion
  6339. (when (and (or (thing-at-point-looking-at markdown-regex-header-atx)
  6340. (re-search-backward markdown-regex-header-atx nil t))
  6341. (not (markdown-code-block-at-point-p)))
  6342. (let ((level (length (match-string 1)))
  6343. (promote-or-demote (if arg 1 -1))
  6344. (remove 't))
  6345. (markdown-cycle-atx promote-or-demote remove)
  6346. (catch 'end-of-subtree
  6347. (while (and (markdown-next-heading)
  6348. (looking-at markdown-regex-header-atx))
  6349. ;; Exit if this not a higher level heading; promote otherwise.
  6350. (if (and (looking-at markdown-regex-header-atx)
  6351. (<= (length (match-string-no-properties 1)) level))
  6352. (throw 'end-of-subtree nil)
  6353. (markdown-cycle-atx promote-or-demote remove))))))))
  6354. (defun markdown-demote-subtree ()
  6355. "Demote the current subtree of ATX headings."
  6356. (interactive)
  6357. (markdown-promote-subtree t))
  6358. (defun markdown-move-subtree-up ()
  6359. "Move the current subtree of ATX headings up."
  6360. (interactive)
  6361. (outline-move-subtree-up 1))
  6362. (defun markdown-move-subtree-down ()
  6363. "Move the current subtree of ATX headings down."
  6364. (interactive)
  6365. (outline-move-subtree-down 1))
  6366. (defun markdown-outline-next ()
  6367. "Move to next list item, when in a list, or next visible heading."
  6368. (interactive)
  6369. (let ((bounds (markdown-next-list-item-bounds)))
  6370. (if bounds
  6371. (goto-char (nth 0 bounds))
  6372. (markdown-next-visible-heading 1))))
  6373. (defun markdown-outline-previous ()
  6374. "Move to previous list item, when in a list, or previous visible heading."
  6375. (interactive)
  6376. (let ((bounds (markdown-prev-list-item-bounds)))
  6377. (if bounds
  6378. (goto-char (nth 0 bounds))
  6379. (markdown-previous-visible-heading 1))))
  6380. (defun markdown-outline-next-same-level ()
  6381. "Move to next list item or heading of same level."
  6382. (interactive)
  6383. (let ((bounds (markdown-cur-list-item-bounds)))
  6384. (if bounds
  6385. (markdown-next-list-item (nth 3 bounds))
  6386. (markdown-forward-same-level 1))))
  6387. (defun markdown-outline-previous-same-level ()
  6388. "Move to previous list item or heading of same level."
  6389. (interactive)
  6390. (let ((bounds (markdown-cur-list-item-bounds)))
  6391. (if bounds
  6392. (markdown-prev-list-item (nth 3 bounds))
  6393. (markdown-backward-same-level 1))))
  6394. (defun markdown-outline-up ()
  6395. "Move to previous list item, when in a list, or previous heading."
  6396. (interactive)
  6397. (unless (markdown-up-list)
  6398. (markdown-up-heading 1)))
  6399. ;;; Marking and Narrowing =====================================================
  6400. (defun markdown-mark-paragraph ()
  6401. "Put mark at end of this block, point at beginning.
  6402. The block marked is the one that contains point or follows point.
  6403. Interactively, if this command is repeated or (in Transient Mark
  6404. mode) if the mark is active, it marks the next block after the
  6405. ones already marked."
  6406. (interactive)
  6407. (if (or (and (eq last-command this-command) (mark t))
  6408. (and transient-mark-mode mark-active))
  6409. (set-mark
  6410. (save-excursion
  6411. (goto-char (mark))
  6412. (markdown-forward-paragraph)
  6413. (point)))
  6414. (let ((beginning-of-defun-function 'markdown-backward-paragraph)
  6415. (end-of-defun-function 'markdown-forward-paragraph))
  6416. (mark-defun))))
  6417. (defun markdown-mark-block ()
  6418. "Put mark at end of this block, point at beginning.
  6419. The block marked is the one that contains point or follows point.
  6420. Interactively, if this command is repeated or (in Transient Mark
  6421. mode) if the mark is active, it marks the next block after the
  6422. ones already marked."
  6423. (interactive)
  6424. (if (or (and (eq last-command this-command) (mark t))
  6425. (and transient-mark-mode mark-active))
  6426. (set-mark
  6427. (save-excursion
  6428. (goto-char (mark))
  6429. (markdown-forward-block)
  6430. (point)))
  6431. (let ((beginning-of-defun-function 'markdown-backward-block)
  6432. (end-of-defun-function 'markdown-forward-block))
  6433. (mark-defun))))
  6434. (defun markdown-narrow-to-block ()
  6435. "Make text outside current block invisible.
  6436. The current block is the one that contains point or follows point."
  6437. (interactive)
  6438. (let ((beginning-of-defun-function 'markdown-backward-block)
  6439. (end-of-defun-function 'markdown-forward-block))
  6440. (narrow-to-defun)))
  6441. (defun markdown-mark-text-block ()
  6442. "Put mark at end of this plain text block, point at beginning.
  6443. The block marked is the one that contains point or follows point.
  6444. Interactively, if this command is repeated or (in Transient Mark
  6445. mode) if the mark is active, it marks the next block after the
  6446. ones already marked."
  6447. (interactive)
  6448. (if (or (and (eq last-command this-command) (mark t))
  6449. (and transient-mark-mode mark-active))
  6450. (set-mark
  6451. (save-excursion
  6452. (goto-char (mark))
  6453. (markdown-end-of-text-block)
  6454. (point)))
  6455. (let ((beginning-of-defun-function 'markdown-beginning-of-text-block)
  6456. (end-of-defun-function 'markdown-end-of-text-block))
  6457. (mark-defun))))
  6458. (defun markdown-mark-page ()
  6459. "Put mark at end of this top level section, point at beginning.
  6460. The top level section marked is the one that contains point or
  6461. follows point.
  6462. Interactively, if this command is repeated or (in Transient Mark
  6463. mode) if the mark is active, it marks the next page after the
  6464. ones already marked."
  6465. (interactive)
  6466. (if (or (and (eq last-command this-command) (mark t))
  6467. (and transient-mark-mode mark-active))
  6468. (set-mark
  6469. (save-excursion
  6470. (goto-char (mark))
  6471. (markdown-forward-page)
  6472. (point)))
  6473. (let ((beginning-of-defun-function 'markdown-backward-page)
  6474. (end-of-defun-function 'markdown-forward-page))
  6475. (mark-defun))))
  6476. (defun markdown-narrow-to-page ()
  6477. "Make text outside current top level section invisible.
  6478. The current section is the one that contains point or follows point."
  6479. (interactive)
  6480. (let ((beginning-of-defun-function 'markdown-backward-page)
  6481. (end-of-defun-function 'markdown-forward-page))
  6482. (narrow-to-defun)))
  6483. (defun markdown-mark-subtree ()
  6484. "Mark the current subtree.
  6485. This puts point at the start of the current subtree, and mark at the end."
  6486. (interactive)
  6487. (let ((beg))
  6488. (if (markdown-heading-at-point)
  6489. (beginning-of-line)
  6490. (markdown-previous-visible-heading 1))
  6491. (setq beg (point))
  6492. (markdown-end-of-subtree)
  6493. (push-mark (point) nil t)
  6494. (goto-char beg)))
  6495. (defun markdown-narrow-to-subtree ()
  6496. "Narrow buffer to the current subtree."
  6497. (interactive)
  6498. (save-excursion
  6499. (save-match-data
  6500. (narrow-to-region
  6501. (progn (markdown-back-to-heading-over-code-block t) (point))
  6502. (progn (markdown-end-of-subtree)
  6503. (if (and (markdown-heading-at-point) (not (eobp)))
  6504. (backward-char 1))
  6505. (point))))))
  6506. ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
  6507. (defun markdown-move-up ()
  6508. "Move thing at point up.
  6509. When in a list item, call `markdown-move-list-item-up'.
  6510. When in a table, call `markdown-table-move-row-up'.
  6511. Otherwise, move the current heading subtree up with
  6512. `markdown-move-subtree-up'."
  6513. (interactive)
  6514. (cond
  6515. ((markdown-list-item-at-point-p)
  6516. (call-interactively #'markdown-move-list-item-up))
  6517. ((markdown-table-at-point-p)
  6518. (call-interactively #'markdown-table-move-row-up))
  6519. (t
  6520. (call-interactively #'markdown-move-subtree-up))))
  6521. (defun markdown-move-down ()
  6522. "Move thing at point down.
  6523. When in a list item, call `markdown-move-list-item-down'.
  6524. Otherwise, move the current heading subtree up with
  6525. `markdown-move-subtree-down'."
  6526. (interactive)
  6527. (cond
  6528. ((markdown-list-item-at-point-p)
  6529. (call-interactively #'markdown-move-list-item-down))
  6530. ((markdown-table-at-point-p)
  6531. (call-interactively #'markdown-table-move-row-down))
  6532. (t
  6533. (call-interactively #'markdown-move-subtree-down))))
  6534. (defun markdown-promote ()
  6535. "Promote or move element at point to the left.
  6536. Depending on the context, this function will promote a heading or
  6537. list item at the point, move a table column to the left, or cycle
  6538. markup."
  6539. (interactive)
  6540. (let (bounds)
  6541. (cond
  6542. ;; Promote atx heading subtree
  6543. ((thing-at-point-looking-at markdown-regex-header-atx)
  6544. (markdown-promote-subtree))
  6545. ;; Promote setext heading
  6546. ((thing-at-point-looking-at markdown-regex-header-setext)
  6547. (markdown-cycle-setext -1))
  6548. ;; Promote horizontal rule
  6549. ((thing-at-point-looking-at markdown-regex-hr)
  6550. (markdown-cycle-hr -1))
  6551. ;; Promote list item
  6552. ((setq bounds (markdown-cur-list-item-bounds))
  6553. (markdown-promote-list-item bounds))
  6554. ;; Move table column to the left
  6555. ((markdown-table-at-point-p)
  6556. (call-interactively #'markdown-table-move-column-left))
  6557. ;; Promote bold
  6558. ((thing-at-point-looking-at markdown-regex-bold)
  6559. (markdown-cycle-bold))
  6560. ;; Promote italic
  6561. ((thing-at-point-looking-at markdown-regex-italic)
  6562. (markdown-cycle-italic))
  6563. (t
  6564. (user-error "Nothing to promote at point")))))
  6565. (defun markdown-demote ()
  6566. "Demote or move element at point to the right.
  6567. Depending on the context, this function will demote a heading or
  6568. list item at the point, move a table column to the right, or cycle
  6569. or remove markup."
  6570. (interactive)
  6571. (let (bounds)
  6572. (cond
  6573. ;; Demote atx heading subtree
  6574. ((thing-at-point-looking-at markdown-regex-header-atx)
  6575. (markdown-demote-subtree))
  6576. ;; Demote setext heading
  6577. ((thing-at-point-looking-at markdown-regex-header-setext)
  6578. (markdown-cycle-setext 1))
  6579. ;; Demote horizontal rule
  6580. ((thing-at-point-looking-at markdown-regex-hr)
  6581. (markdown-cycle-hr 1))
  6582. ;; Demote list item
  6583. ((setq bounds (markdown-cur-list-item-bounds))
  6584. (markdown-demote-list-item bounds))
  6585. ;; Move table column to the right
  6586. ((markdown-table-at-point-p)
  6587. (call-interactively #'markdown-table-move-column-right))
  6588. ;; Demote bold
  6589. ((thing-at-point-looking-at markdown-regex-bold)
  6590. (markdown-cycle-bold))
  6591. ;; Demote italic
  6592. ((thing-at-point-looking-at markdown-regex-italic)
  6593. (markdown-cycle-italic))
  6594. (t
  6595. (user-error "Nothing to demote at point")))))
  6596. ;;; Commands ==================================================================
  6597. (defun markdown (&optional output-buffer-name)
  6598. "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
  6599. The output buffer name defaults to `markdown-output-buffer-name'.
  6600. Return the name of the output buffer used."
  6601. (interactive)
  6602. (save-window-excursion
  6603. (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command))
  6604. ((listp markdown-command) markdown-command)))
  6605. (command (car-safe commands))
  6606. (command-args (cdr-safe commands))
  6607. begin-region end-region)
  6608. (if (use-region-p)
  6609. (setq begin-region (region-beginning)
  6610. end-region (region-end))
  6611. (setq begin-region (point-min)
  6612. end-region (point-max)))
  6613. (unless output-buffer-name
  6614. (setq output-buffer-name markdown-output-buffer-name))
  6615. (when (and (stringp command) (not (executable-find command)))
  6616. (user-error "Markdown command %s is not found" command))
  6617. (let ((exit-code
  6618. (cond
  6619. ;; Handle case when `markdown-command' does not read from stdin
  6620. ((and (stringp command) markdown-command-needs-filename)
  6621. (if (not buffer-file-name)
  6622. (user-error "Must be visiting a file")
  6623. ;; Don’t use ‘shell-command’ because it’s not guaranteed to
  6624. ;; return the exit code of the process.
  6625. (let ((command (if (listp markdown-command)
  6626. (string-join markdown-command " ")
  6627. markdown-command)))
  6628. (shell-command-on-region
  6629. ;; Pass an empty region so that stdin is empty.
  6630. (point) (point)
  6631. (concat command " "
  6632. (shell-quote-argument buffer-file-name))
  6633. output-buffer-name))))
  6634. ;; Pass region to `markdown-command' via stdin
  6635. (t
  6636. (let ((buf (get-buffer-create output-buffer-name)))
  6637. (with-current-buffer buf
  6638. (setq buffer-read-only nil)
  6639. (erase-buffer))
  6640. (if (stringp command)
  6641. (if (not (null command-args))
  6642. (apply #'call-process-region begin-region end-region command nil buf nil command-args)
  6643. (call-process-region begin-region end-region command nil buf))
  6644. (funcall markdown-command begin-region end-region buf)
  6645. ;; If the ‘markdown-command’ function didn’t signal an
  6646. ;; error, assume it succeeded by binding ‘exit-code’ to 0.
  6647. 0))))))
  6648. ;; The exit code can be a signal description string, so don’t use ‘=’
  6649. ;; or ‘zerop’.
  6650. (unless (eq exit-code 0)
  6651. (user-error "%s failed with exit code %s"
  6652. markdown-command exit-code))))
  6653. output-buffer-name))
  6654. (defun markdown-standalone (&optional output-buffer-name)
  6655. "Special function to provide standalone HTML output.
  6656. Insert the output in the buffer named OUTPUT-BUFFER-NAME."
  6657. (interactive)
  6658. (setq output-buffer-name (markdown output-buffer-name))
  6659. (with-current-buffer output-buffer-name
  6660. (set-buffer output-buffer-name)
  6661. (unless (markdown-output-standalone-p)
  6662. (markdown-add-xhtml-header-and-footer output-buffer-name))
  6663. (goto-char (point-min))
  6664. (html-mode))
  6665. output-buffer-name)
  6666. (defun markdown-other-window (&optional output-buffer-name)
  6667. "Run `markdown-command' on current buffer and display in other window.
  6668. When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
  6669. that name."
  6670. (interactive)
  6671. (markdown-display-buffer-other-window
  6672. (markdown-standalone output-buffer-name)))
  6673. (defun markdown-output-standalone-p ()
  6674. "Determine whether `markdown-command' output is standalone XHTML.
  6675. Standalone XHTML output is identified by an occurrence of
  6676. `markdown-xhtml-standalone-regexp' in the first five lines of output."
  6677. (save-excursion
  6678. (goto-char (point-min))
  6679. (save-match-data
  6680. (re-search-forward
  6681. markdown-xhtml-standalone-regexp
  6682. (save-excursion (goto-char (point-min)) (forward-line 4) (point))
  6683. t))))
  6684. (defun markdown-stylesheet-link-string (stylesheet-path)
  6685. (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
  6686. (or (and (string-prefix-p "~" stylesheet-path)
  6687. (expand-file-name stylesheet-path))
  6688. stylesheet-path)
  6689. "\" />"))
  6690. (defun markdown-add-xhtml-header-and-footer (title)
  6691. "Wrap XHTML header and footer with given TITLE around current buffer."
  6692. (goto-char (point-min))
  6693. (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
  6694. "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
  6695. "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
  6696. "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
  6697. "<head>\n<title>")
  6698. (insert title)
  6699. (insert "</title>\n")
  6700. (unless (= (length markdown-content-type) 0)
  6701. (insert
  6702. (format
  6703. "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
  6704. markdown-content-type
  6705. (or (and markdown-coding-system
  6706. (coding-system-get markdown-coding-system
  6707. 'mime-charset))
  6708. (coding-system-get buffer-file-coding-system
  6709. 'mime-charset)
  6710. "utf-8"))))
  6711. (if (> (length markdown-css-paths) 0)
  6712. (insert (mapconcat #'markdown-stylesheet-link-string
  6713. markdown-css-paths "\n")))
  6714. (when (> (length markdown-xhtml-header-content) 0)
  6715. (insert markdown-xhtml-header-content))
  6716. (insert "\n</head>\n\n"
  6717. "<body>\n\n")
  6718. (when (> (length markdown-xhtml-body-preamble) 0)
  6719. (insert markdown-xhtml-body-preamble "\n"))
  6720. (goto-char (point-max))
  6721. (when (> (length markdown-xhtml-body-epilogue) 0)
  6722. (insert "\n" markdown-xhtml-body-epilogue))
  6723. (insert "\n"
  6724. "</body>\n"
  6725. "</html>\n"))
  6726. (defun markdown-preview (&optional output-buffer-name)
  6727. "Run `markdown-command' on the current buffer and view output in browser.
  6728. When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
  6729. that name."
  6730. (interactive)
  6731. (browse-url-of-buffer
  6732. (markdown-standalone (or output-buffer-name markdown-output-buffer-name))))
  6733. (defun markdown-export-file-name (&optional extension)
  6734. "Attempt to generate a filename for Markdown output.
  6735. The file extension will be EXTENSION if given, or .html by default.
  6736. If the current buffer is visiting a file, we construct a new
  6737. output filename based on that filename. Otherwise, return nil."
  6738. (when (buffer-file-name)
  6739. (unless extension
  6740. (setq extension ".html"))
  6741. (let ((candidate
  6742. (concat
  6743. (cond
  6744. ((buffer-file-name)
  6745. (file-name-sans-extension (buffer-file-name)))
  6746. (t (buffer-name)))
  6747. extension)))
  6748. (cond
  6749. ((equal candidate (buffer-file-name))
  6750. (concat candidate extension))
  6751. (t
  6752. candidate)))))
  6753. (defun markdown-export (&optional output-file)
  6754. "Run Markdown on the current buffer, save to file, and return the filename.
  6755. If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
  6756. generated by `markdown-export-file-name', which will be constructed using the
  6757. current filename, but with the extension removed and replaced with .html."
  6758. (interactive)
  6759. (unless output-file
  6760. (setq output-file (markdown-export-file-name ".html")))
  6761. (when output-file
  6762. (let* ((init-buf (current-buffer))
  6763. (init-point (point))
  6764. (init-buf-string (buffer-string))
  6765. (output-buffer (find-file-noselect output-file))
  6766. (output-buffer-name (buffer-name output-buffer)))
  6767. (run-hooks 'markdown-before-export-hook)
  6768. (markdown-standalone output-buffer-name)
  6769. (with-current-buffer output-buffer
  6770. (run-hooks 'markdown-after-export-hook)
  6771. (save-buffer)
  6772. (when markdown-export-kill-buffer (kill-buffer)))
  6773. ;; if modified, restore initial buffer
  6774. (when (buffer-modified-p init-buf)
  6775. (erase-buffer)
  6776. (insert init-buf-string)
  6777. (save-buffer)
  6778. (goto-char init-point))
  6779. output-file)))
  6780. (defun markdown-export-and-preview ()
  6781. "Export to XHTML using `markdown-export' and browse the resulting file."
  6782. (interactive)
  6783. (browse-url-of-file (markdown-export)))
  6784. (defvar-local markdown-live-preview-buffer nil
  6785. "Buffer used to preview markdown output in `markdown-live-preview-export'.")
  6786. (defvar-local markdown-live-preview-source-buffer nil
  6787. "Source buffer from which current buffer was generated.
  6788. This is the inverse of `markdown-live-preview-buffer'.")
  6789. (defvar markdown-live-preview-currently-exporting nil)
  6790. (defun markdown-live-preview-get-filename ()
  6791. "Standardize the filename exported by `markdown-live-preview-export'."
  6792. (markdown-export-file-name ".html"))
  6793. (defun markdown-live-preview-window-eww (file)
  6794. "Preview FILE with eww.
  6795. To be used with `markdown-live-preview-window-function'."
  6796. (eww-open-file file)
  6797. (get-buffer "*eww*"))
  6798. (defun markdown-visual-lines-between-points (beg end)
  6799. (save-excursion
  6800. (goto-char beg)
  6801. (cl-loop with count = 0
  6802. while (progn (end-of-visual-line)
  6803. (and (< (point) end) (line-move-visual 1 t)))
  6804. do (cl-incf count)
  6805. finally return count)))
  6806. (defun markdown-live-preview-window-serialize (buf)
  6807. "Get window point and scroll data for all windows displaying BUF."
  6808. (when (buffer-live-p buf)
  6809. (with-current-buffer buf
  6810. (mapcar
  6811. (lambda (win)
  6812. (with-selected-window win
  6813. (let* ((start (window-start))
  6814. (pt (window-point))
  6815. (pt-or-sym (cond ((= pt (point-min)) 'min)
  6816. ((= pt (point-max)) 'max)
  6817. (t pt)))
  6818. (diff (markdown-visual-lines-between-points
  6819. start pt)))
  6820. (list win pt-or-sym diff))))
  6821. (get-buffer-window-list buf)))))
  6822. (defun markdown-get-point-back-lines (pt num-lines)
  6823. (save-excursion
  6824. (goto-char pt)
  6825. (line-move-visual (- num-lines) t)
  6826. ;; in testing, can occasionally overshoot the number of lines to traverse
  6827. (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt)))
  6828. (when (> actual-num-lines num-lines)
  6829. (line-move-visual (- actual-num-lines num-lines) t)))
  6830. (point)))
  6831. (defun markdown-live-preview-window-deserialize (window-posns)
  6832. "Apply window point and scroll data from WINDOW-POSNS.
  6833. WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
  6834. (cl-destructuring-bind (win pt-or-sym diff) window-posns
  6835. (when (window-live-p win)
  6836. (with-current-buffer markdown-live-preview-buffer
  6837. (set-window-buffer win (current-buffer))
  6838. (cl-destructuring-bind (actual-pt actual-diff)
  6839. (cl-case pt-or-sym
  6840. (min (list (point-min) 0))
  6841. (max (list (point-max) diff))
  6842. (t (list pt-or-sym diff)))
  6843. (set-window-start
  6844. win (markdown-get-point-back-lines actual-pt actual-diff))
  6845. (set-window-point win actual-pt))))))
  6846. (defun markdown-live-preview-export ()
  6847. "Export to XHTML using `markdown-export'.
  6848. Browse the resulting file within Emacs using
  6849. `markdown-live-preview-window-function' Return the buffer
  6850. displaying the rendered output."
  6851. (interactive)
  6852. (let ((filename (markdown-live-preview-get-filename)))
  6853. (when filename
  6854. (let* ((markdown-live-preview-currently-exporting t)
  6855. (cur-buf (current-buffer))
  6856. (export-file (markdown-export filename))
  6857. ;; get positions in all windows currently displaying output buffer
  6858. (window-data
  6859. (markdown-live-preview-window-serialize
  6860. markdown-live-preview-buffer)))
  6861. (save-window-excursion
  6862. (let ((output-buffer
  6863. (funcall markdown-live-preview-window-function export-file)))
  6864. (with-current-buffer output-buffer
  6865. (setq markdown-live-preview-source-buffer cur-buf)
  6866. (add-hook 'kill-buffer-hook
  6867. #'markdown-live-preview-remove-on-kill t t))
  6868. (with-current-buffer cur-buf
  6869. (setq markdown-live-preview-buffer output-buffer))))
  6870. (with-current-buffer cur-buf
  6871. ;; reset all windows displaying output buffer to where they were,
  6872. ;; now with the new output
  6873. (mapc #'markdown-live-preview-window-deserialize window-data)
  6874. ;; delete html editing buffer
  6875. (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf)))
  6876. (when (and export-file (file-exists-p export-file)
  6877. (eq markdown-live-preview-delete-export
  6878. 'delete-on-export))
  6879. (delete-file export-file))
  6880. markdown-live-preview-buffer)))))
  6881. (defun markdown-live-preview-remove ()
  6882. (when (buffer-live-p markdown-live-preview-buffer)
  6883. (kill-buffer markdown-live-preview-buffer))
  6884. (setq markdown-live-preview-buffer nil)
  6885. ;; if set to 'delete-on-export, the output has already been deleted
  6886. (when (eq markdown-live-preview-delete-export 'delete-on-destroy)
  6887. (let ((outfile-name (markdown-live-preview-get-filename)))
  6888. (when (and outfile-name (file-exists-p outfile-name))
  6889. (delete-file outfile-name)))))
  6890. (defun markdown-get-other-window ()
  6891. "Find another window to display preview or output content."
  6892. (cond
  6893. ((memq markdown-split-window-direction '(vertical below))
  6894. (or (window-in-direction 'below) (split-window-vertically)))
  6895. ((memq markdown-split-window-direction '(horizontal right))
  6896. (or (window-in-direction 'right) (split-window-horizontally)))
  6897. (t (split-window-sensibly (get-buffer-window)))))
  6898. (defun markdown-display-buffer-other-window (buf)
  6899. "Display preview or output buffer BUF in another window."
  6900. (if (and display-buffer-alist (eq markdown-split-window-direction 'any))
  6901. (display-buffer buf)
  6902. (let ((cur-buf (current-buffer))
  6903. (window (markdown-get-other-window)))
  6904. (set-window-buffer window buf)
  6905. (set-buffer cur-buf))))
  6906. (defun markdown-live-preview-if-markdown ()
  6907. (when (and (derived-mode-p 'markdown-mode)
  6908. markdown-live-preview-mode)
  6909. (unless markdown-live-preview-currently-exporting
  6910. (if (buffer-live-p markdown-live-preview-buffer)
  6911. (markdown-live-preview-export)
  6912. (markdown-display-buffer-other-window
  6913. (markdown-live-preview-export))))))
  6914. (defun markdown-live-preview-remove-on-kill ()
  6915. (cond ((and (derived-mode-p 'markdown-mode)
  6916. markdown-live-preview-mode)
  6917. (markdown-live-preview-remove))
  6918. (markdown-live-preview-source-buffer
  6919. (with-current-buffer markdown-live-preview-source-buffer
  6920. (setq markdown-live-preview-buffer nil))
  6921. (setq markdown-live-preview-source-buffer nil))))
  6922. (defun markdown-live-preview-switch-to-output ()
  6923. "Switch to output buffer."
  6924. (interactive)
  6925. "Turn on `markdown-live-preview-mode' if not already on, and switch to its
  6926. output buffer in another window."
  6927. (if markdown-live-preview-mode
  6928. (markdown-display-buffer-other-window (markdown-live-preview-export)))
  6929. (markdown-live-preview-mode))
  6930. (defun markdown-live-preview-re-export ()
  6931. "Re export source buffer."
  6932. (interactive)
  6933. "If the current buffer is a buffer displaying the exported version of a
  6934. `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
  6935. update this buffer's contents."
  6936. (when markdown-live-preview-source-buffer
  6937. (with-current-buffer markdown-live-preview-source-buffer
  6938. (markdown-live-preview-export))))
  6939. (defun markdown-open ()
  6940. "Open file for the current buffer with `markdown-open-command'."
  6941. (interactive)
  6942. (unless markdown-open-command
  6943. (user-error "Variable `markdown-open-command' must be set"))
  6944. (if (stringp markdown-open-command)
  6945. (if (not buffer-file-name)
  6946. (user-error "Must be visiting a file")
  6947. (save-buffer)
  6948. (let ((exit-code (call-process markdown-open-command nil nil nil
  6949. buffer-file-name)))
  6950. ;; The exit code can be a signal description string, so don’t use ‘=’
  6951. ;; or ‘zerop’.
  6952. (unless (eq exit-code 0)
  6953. (user-error "%s failed with exit code %s"
  6954. markdown-open-command exit-code))))
  6955. (funcall markdown-open-command))
  6956. nil)
  6957. (defun markdown-kill-ring-save ()
  6958. "Run Markdown on file and store output in the kill ring."
  6959. (interactive)
  6960. (save-window-excursion
  6961. (markdown)
  6962. (with-current-buffer markdown-output-buffer-name
  6963. (kill-ring-save (point-min) (point-max)))))
  6964. ;;; Links =====================================================================
  6965. (defun markdown-backward-to-link-start ()
  6966. "Backward link start position if current position is in link title."
  6967. ;; Issue #305
  6968. (when (eq (get-text-property (point) 'face) 'markdown-link-face)
  6969. (skip-chars-backward "^[")
  6970. (forward-char -1)))
  6971. (defun markdown-link-p ()
  6972. "Return non-nil when `point' is at a non-wiki link.
  6973. See `markdown-wiki-link-p' for more information."
  6974. (save-excursion
  6975. (let ((case-fold-search nil))
  6976. (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p)))
  6977. (markdown-backward-to-link-start)
  6978. (or (thing-at-point-looking-at markdown-regex-link-inline)
  6979. (thing-at-point-looking-at markdown-regex-link-reference)
  6980. (thing-at-point-looking-at markdown-regex-uri)
  6981. (thing-at-point-looking-at markdown-regex-angle-uri))))))
  6982. (defun markdown-link-at-pos (pos)
  6983. "Return properties of link or image at position POS.
  6984. Value is a list of elements describing the link:
  6985. 0. beginning position
  6986. 1. end position
  6987. 2. link text
  6988. 3. URL
  6989. 4. reference label
  6990. 5. title text
  6991. 6. bang (nil or \"!\")"
  6992. (save-excursion
  6993. (goto-char pos)
  6994. (markdown-backward-to-link-start)
  6995. (let (begin end text url reference title bang)
  6996. (cond
  6997. ;; Inline image or link at point.
  6998. ((thing-at-point-looking-at markdown-regex-link-inline)
  6999. (setq bang (match-string-no-properties 1)
  7000. begin (match-beginning 0)
  7001. end (match-end 0)
  7002. text (match-string-no-properties 3)
  7003. url (match-string-no-properties 6))
  7004. (if (match-end 7)
  7005. (setq title (substring (match-string-no-properties 7) 1 -1))
  7006. ;; #408 URL contains close parenthesis case
  7007. (goto-char (match-beginning 5))
  7008. (let ((paren-end (scan-sexps (point) 1)))
  7009. (when (and paren-end (< end paren-end))
  7010. (setq url (buffer-substring (match-beginning 6) (1- paren-end)))))))
  7011. ;; Reference link at point.
  7012. ((or (thing-at-point-looking-at markdown-regex-link-inline)
  7013. (thing-at-point-looking-at markdown-regex-link-reference))
  7014. (setq bang (match-string-no-properties 1)
  7015. begin (match-beginning 0)
  7016. end (match-end 0)
  7017. text (match-string-no-properties 3))
  7018. (when (char-equal (char-after (match-beginning 5)) ?\[)
  7019. (setq reference (match-string-no-properties 6))))
  7020. ;; Angle bracket URI at point.
  7021. ((thing-at-point-looking-at markdown-regex-angle-uri)
  7022. (setq begin (match-beginning 0)
  7023. end (match-end 0)
  7024. url (match-string-no-properties 2)))
  7025. ;; Plain URI at point.
  7026. ((thing-at-point-looking-at markdown-regex-uri)
  7027. (setq begin (match-beginning 0)
  7028. end (match-end 0)
  7029. url (match-string-no-properties 1))))
  7030. (list begin end text url reference title bang))))
  7031. (defun markdown-link-url ()
  7032. "Return the URL part of the regular (non-wiki) link at point.
  7033. Works with both inline and reference style links, and with images.
  7034. If point is not at a link or the link reference is not defined
  7035. returns nil."
  7036. (let* ((values (markdown-link-at-pos (point)))
  7037. (text (nth 2 values))
  7038. (url (nth 3 values))
  7039. (ref (nth 4 values)))
  7040. (or url (and ref (car (markdown-reference-definition
  7041. (downcase (if (string= ref "") text ref))))))))
  7042. (defun markdown--browse-url (url)
  7043. (let* ((struct (url-generic-parse-url url))
  7044. (full (url-fullness struct))
  7045. (file url))
  7046. ;; Parse URL, determine fullness, strip query string
  7047. (setq file (car (url-path-and-query struct)))
  7048. ;; Open full URLs in browser, files in Emacs
  7049. (if full
  7050. (browse-url url)
  7051. (when (and file (> (length file) 0))
  7052. (let ((link-file (funcall markdown-translate-filename-function file)))
  7053. (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file))
  7054. (if (functionp markdown-open-image-command)
  7055. (funcall markdown-open-image-command link-file)
  7056. (process-file markdown-open-image-command nil nil nil link-file))
  7057. (find-file link-file)))))))
  7058. (defun markdown-follow-link-at-point ()
  7059. "Open the current non-wiki link.
  7060. If the link is a complete URL, open in browser with `browse-url'.
  7061. Otherwise, open with `find-file' after stripping anchor and/or query string.
  7062. Translate filenames using `markdown-filename-translate-function'."
  7063. (interactive)
  7064. (if (markdown-link-p)
  7065. (markdown--browse-url (markdown-link-url))
  7066. (user-error "Point is not at a Markdown link or URL")))
  7067. (defun markdown-fontify-inline-links (last)
  7068. "Add text properties to next inline link from point to LAST."
  7069. (when (markdown-match-generic-links last nil)
  7070. (let* ((link-start (match-beginning 3))
  7071. (link-end (match-end 3))
  7072. (url-start (match-beginning 6))
  7073. (url-end (match-end 6))
  7074. (url (match-string-no-properties 6))
  7075. (title-start (match-beginning 7))
  7076. (title-end (match-end 7))
  7077. (title (match-string-no-properties 7))
  7078. ;; Markup part
  7079. (mp (list 'face 'markdown-markup-face
  7080. 'invisible 'markdown-markup
  7081. 'rear-nonsticky t
  7082. 'font-lock-multiline t))
  7083. ;; Link part (without face)
  7084. (lp (list 'keymap markdown-mode-mouse-map
  7085. 'mouse-face 'markdown-highlight-face
  7086. 'font-lock-multiline t
  7087. 'help-echo (if title (concat title "\n" url) url)))
  7088. ;; URL part
  7089. (up (list 'keymap markdown-mode-mouse-map
  7090. 'face 'markdown-url-face
  7091. 'invisible 'markdown-markup
  7092. 'mouse-face 'markdown-highlight-face
  7093. 'font-lock-multiline t))
  7094. ;; URL composition character
  7095. (url-char (markdown--first-displayable markdown-url-compose-char))
  7096. ;; Title part
  7097. (tp (list 'face 'markdown-link-title-face
  7098. 'invisible 'markdown-markup
  7099. 'font-lock-multiline t)))
  7100. (dolist (g '(1 2 4 5 8))
  7101. (when (match-end g)
  7102. (add-text-properties (match-beginning g) (match-end g) mp)))
  7103. ;; Preserve existing faces applied to link part (e.g., inline code)
  7104. (when link-start
  7105. (add-text-properties link-start link-end lp)
  7106. (add-face-text-property link-start link-end
  7107. 'markdown-link-face 'append))
  7108. (when url-start (add-text-properties url-start url-end up))
  7109. (when title-start (add-text-properties url-end title-end tp))
  7110. (when (and markdown-hide-urls url-start)
  7111. (compose-region url-start (or title-end url-end) url-char))
  7112. t)))
  7113. (defun markdown-fontify-reference-links (last)
  7114. "Add text properties to next reference link from point to LAST."
  7115. (when (markdown-match-generic-links last t)
  7116. (let* ((link-start (match-beginning 3))
  7117. (link-end (match-end 3))
  7118. (ref-start (match-beginning 6))
  7119. (ref-end (match-end 6))
  7120. ;; Markup part
  7121. (mp (list 'face 'markdown-markup-face
  7122. 'invisible 'markdown-markup
  7123. 'rear-nonsticky t
  7124. 'font-lock-multiline t))
  7125. ;; Link part
  7126. (lp (list 'keymap markdown-mode-mouse-map
  7127. 'face 'markdown-link-face
  7128. 'mouse-face 'markdown-highlight-face
  7129. 'font-lock-multiline t
  7130. 'help-echo (lambda (_ __ pos)
  7131. (save-match-data
  7132. (save-excursion
  7133. (goto-char pos)
  7134. (or (markdown-link-url)
  7135. "Undefined reference"))))))
  7136. ;; URL composition character
  7137. (url-char (markdown--first-displayable markdown-url-compose-char))
  7138. ;; Reference part
  7139. (rp (list 'face 'markdown-reference-face
  7140. 'invisible 'markdown-markup
  7141. 'font-lock-multiline t)))
  7142. (dolist (g '(1 2 4 5 8))
  7143. (when (match-end g)
  7144. (add-text-properties (match-beginning g) (match-end g) mp)))
  7145. (when link-start (add-text-properties link-start link-end lp))
  7146. (when ref-start (add-text-properties ref-start ref-end rp)
  7147. (when (and markdown-hide-urls (> (- ref-end ref-start) 2))
  7148. (compose-region ref-start ref-end url-char)))
  7149. t)))
  7150. (defun markdown-fontify-angle-uris (last)
  7151. "Add text properties to angle URIs from point to LAST."
  7152. (when (markdown-match-angle-uris last)
  7153. (let* ((url-start (match-beginning 2))
  7154. (url-end (match-end 2))
  7155. ;; Markup part
  7156. (mp (list 'face 'markdown-markup-face
  7157. 'invisible 'markdown-markup
  7158. 'rear-nonsticky t
  7159. 'font-lock-multiline t))
  7160. ;; URI part
  7161. (up (list 'keymap markdown-mode-mouse-map
  7162. 'face 'markdown-plain-url-face
  7163. 'mouse-face 'markdown-highlight-face
  7164. 'font-lock-multiline t)))
  7165. (dolist (g '(1 3))
  7166. (add-text-properties (match-beginning g) (match-end g) mp))
  7167. (add-text-properties url-start url-end up)
  7168. t)))
  7169. (defun markdown-fontify-plain-uris (last)
  7170. "Add text properties to plain URLs from point to LAST."
  7171. (when (markdown-match-plain-uris last)
  7172. (let* ((start (match-beginning 0))
  7173. (end (match-end 0))
  7174. (props (list 'keymap markdown-mode-mouse-map
  7175. 'face 'markdown-plain-url-face
  7176. 'mouse-face 'markdown-highlight-face
  7177. 'rear-nonsticky t
  7178. 'font-lock-multiline t)))
  7179. (add-text-properties start end props)
  7180. t)))
  7181. (defun markdown-toggle-url-hiding (&optional arg)
  7182. "Toggle the display or hiding of URLs.
  7183. With a prefix argument ARG, enable URL hiding if ARG is positive,
  7184. and disable it otherwise."
  7185. (interactive (list (or current-prefix-arg 'toggle)))
  7186. (setq markdown-hide-urls
  7187. (if (eq arg 'toggle)
  7188. (not markdown-hide-urls)
  7189. (> (prefix-numeric-value arg) 0)))
  7190. (if markdown-hide-urls
  7191. (message "markdown-mode URL hiding enabled")
  7192. (message "markdown-mode URL hiding disabled"))
  7193. (markdown-reload-extensions))
  7194. ;;; Wiki Links ================================================================
  7195. (defun markdown-wiki-link-p ()
  7196. "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
  7197. A true wiki link name matches `markdown-regex-wiki-link' but does
  7198. not match the current file name after conversion. This modifies
  7199. the data returned by `match-data'. Note that the potential wiki
  7200. link name must be available via `match-string'."
  7201. (when markdown-enable-wiki-links
  7202. (let ((case-fold-search nil))
  7203. (and (thing-at-point-looking-at markdown-regex-wiki-link)
  7204. (not (markdown-code-block-at-point-p))
  7205. (or (not buffer-file-name)
  7206. (not (string-equal (buffer-file-name)
  7207. (markdown-convert-wiki-link-to-filename
  7208. (markdown-wiki-link-link)))))))))
  7209. (defun markdown-wiki-link-link ()
  7210. "Return the link part of the wiki link using current match data.
  7211. The location of the link component depends on the value of
  7212. `markdown-wiki-link-alias-first'."
  7213. (if markdown-wiki-link-alias-first
  7214. (or (match-string-no-properties 5) (match-string-no-properties 3))
  7215. (match-string-no-properties 3)))
  7216. (defun markdown-wiki-link-alias ()
  7217. "Return the alias or text part of the wiki link using current match data.
  7218. The location of the alias component depends on the value of
  7219. `markdown-wiki-link-alias-first'."
  7220. (if markdown-wiki-link-alias-first
  7221. (match-string-no-properties 3)
  7222. (or (match-string-no-properties 5) (match-string-no-properties 3))))
  7223. (defun markdown--wiki-link-search-types ()
  7224. (let ((ret (and markdown-wiki-link-search-type
  7225. (cl-copy-list markdown-wiki-link-search-type))))
  7226. (when (and markdown-wiki-link-search-subdirectories
  7227. (not (memq 'sub-directories markdown-wiki-link-search-type)))
  7228. (push 'sub-directories ret))
  7229. (when (and markdown-wiki-link-search-parent-directories
  7230. (not (memq 'parent-directories markdown-wiki-link-search-type)))
  7231. (push 'parent-directories ret))
  7232. ret))
  7233. (defun markdown--project-root ()
  7234. (or (cl-loop for dir in '(".git" ".hg" ".svn")
  7235. when (locate-dominating-file default-directory dir)
  7236. return it)
  7237. (progn
  7238. (require 'project)
  7239. (let ((project (project-current t)))
  7240. (with-no-warnings
  7241. (if (fboundp 'project-root)
  7242. (project-root project)
  7243. (car (project-roots project))))))))
  7244. (defun markdown-convert-wiki-link-to-filename (name)
  7245. "Generate a filename from the wiki link NAME.
  7246. Spaces in NAME are replaced with `markdown-link-space-sub-char'.
  7247. When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
  7248. and [[test test]] both map to Test-test.ext. Look in the current
  7249. directory first, then in subdirectories if
  7250. `markdown-wiki-link-search-subdirectories' is non-nil, and then
  7251. in parent directories if
  7252. `markdown-wiki-link-search-parent-directories' is non-nil."
  7253. (save-match-data
  7254. ;; This function must not overwrite match data(PR #590)
  7255. (let* ((basename (replace-regexp-in-string
  7256. "[[:space:]\n]" markdown-link-space-sub-char name))
  7257. (basename (if (derived-mode-p 'gfm-mode)
  7258. (concat (upcase (substring basename 0 1))
  7259. (downcase (substring basename 1 nil)))
  7260. basename))
  7261. (search-types (markdown--wiki-link-search-types))
  7262. directory extension default candidates dir)
  7263. (when buffer-file-name
  7264. (setq directory (file-name-directory buffer-file-name)
  7265. extension (file-name-extension buffer-file-name)))
  7266. (setq default (concat basename
  7267. (when extension (concat "." extension))))
  7268. (cond
  7269. ;; Look in current directory first.
  7270. ((or (null buffer-file-name)
  7271. (file-exists-p default))
  7272. default)
  7273. ;; Possibly search in subdirectories, next.
  7274. ((and (memq 'sub-directories search-types)
  7275. (setq candidates
  7276. (directory-files-recursively
  7277. directory (concat "^" default "$"))))
  7278. (car candidates))
  7279. ;; Possibly search in parent directories as a last resort.
  7280. ((and (memq 'parent-directories search-types)
  7281. (setq dir (locate-dominating-file directory default)))
  7282. (concat dir default))
  7283. ((and (memq 'project search-types)
  7284. (setq candidates
  7285. (directory-files-recursively
  7286. (markdown--project-root) (concat "^" default "$"))))
  7287. (car candidates))
  7288. ;; If nothing is found, return default in current directory.
  7289. (t default)))))
  7290. (defun markdown-follow-wiki-link (name &optional other)
  7291. "Follow the wiki link NAME.
  7292. Convert the name to a file name and call `find-file'. Ensure that
  7293. the new buffer remains in `markdown-mode'. Open the link in another
  7294. window when OTHER is non-nil."
  7295. (let ((filename (markdown-convert-wiki-link-to-filename name))
  7296. (wp (when buffer-file-name
  7297. (file-name-directory buffer-file-name))))
  7298. (if (not wp)
  7299. (user-error "Must be visiting a file")
  7300. (when other (other-window 1))
  7301. (let ((default-directory wp))
  7302. (find-file filename)))
  7303. (unless (derived-mode-p 'markdown-mode)
  7304. (markdown-mode))))
  7305. (defun markdown-follow-wiki-link-at-point (&optional arg)
  7306. "Find Wiki Link at point.
  7307. With prefix argument ARG, open the file in other window.
  7308. See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
  7309. (interactive "P")
  7310. (if (markdown-wiki-link-p)
  7311. (markdown-follow-wiki-link (markdown-wiki-link-link) arg)
  7312. (user-error "Point is not at a Wiki Link")))
  7313. (defun markdown-highlight-wiki-link (from to face)
  7314. "Highlight the wiki link in the region between FROM and TO using FACE."
  7315. (put-text-property from to 'font-lock-face face))
  7316. (defun markdown-unfontify-region-wiki-links (from to)
  7317. "Remove wiki link faces from the region specified by FROM and TO."
  7318. (interactive "*r")
  7319. (let ((modified (buffer-modified-p)))
  7320. (remove-text-properties from to '(font-lock-face markdown-link-face))
  7321. (remove-text-properties from to '(font-lock-face markdown-missing-link-face))
  7322. ;; remove-text-properties marks the buffer modified in emacs 24.3,
  7323. ;; undo that if it wasn't originally marked modified
  7324. (set-buffer-modified-p modified)))
  7325. (defun markdown-fontify-region-wiki-links (from to)
  7326. "Search region given by FROM and TO for wiki links and fontify them.
  7327. If a wiki link is found check to see if the backing file exists
  7328. and highlight accordingly."
  7329. (goto-char from)
  7330. (save-match-data
  7331. (while (re-search-forward markdown-regex-wiki-link to t)
  7332. (when (not (markdown-code-block-at-point-p))
  7333. (let ((highlight-beginning (match-beginning 1))
  7334. (highlight-end (match-end 1))
  7335. (file-name
  7336. (markdown-convert-wiki-link-to-filename
  7337. (markdown-wiki-link-link))))
  7338. (if (condition-case nil (file-exists-p file-name) (error nil))
  7339. (markdown-highlight-wiki-link
  7340. highlight-beginning highlight-end 'markdown-link-face)
  7341. (markdown-highlight-wiki-link
  7342. highlight-beginning highlight-end 'markdown-missing-link-face)))))))
  7343. (defun markdown-extend-changed-region (from to)
  7344. "Extend region given by FROM and TO so that we can fontify all links.
  7345. The region is extended to the first newline before and the first
  7346. newline after."
  7347. ;; start looking for the first new line before 'from
  7348. (goto-char from)
  7349. (re-search-backward "\n" nil t)
  7350. (let ((new-from (point-min))
  7351. (new-to (point-max)))
  7352. (if (not (= (point) from))
  7353. (setq new-from (point)))
  7354. ;; do the same thing for the first new line after 'to
  7355. (goto-char to)
  7356. (re-search-forward "\n" nil t)
  7357. (if (not (= (point) to))
  7358. (setq new-to (point)))
  7359. (cl-values new-from new-to)))
  7360. (defun markdown-check-change-for-wiki-link (from to)
  7361. "Check region between FROM and TO for wiki links and re-fontify as needed."
  7362. (interactive "*r")
  7363. (let* ((modified (buffer-modified-p))
  7364. (buffer-undo-list t)
  7365. (inhibit-read-only t)
  7366. (inhibit-point-motion-hooks t)
  7367. deactivate-mark
  7368. buffer-file-truename)
  7369. (unwind-protect
  7370. (save-excursion
  7371. (save-match-data
  7372. (save-restriction
  7373. ;; Extend the region to fontify so that it starts
  7374. ;; and ends at safe places.
  7375. (cl-multiple-value-bind (new-from new-to)
  7376. (markdown-extend-changed-region from to)
  7377. (goto-char new-from)
  7378. ;; Only refontify when the range contains text with a
  7379. ;; wiki link face or if the wiki link regexp matches.
  7380. (when (or (markdown-range-property-any
  7381. new-from new-to 'font-lock-face
  7382. '(markdown-link-face markdown-missing-link-face))
  7383. (re-search-forward
  7384. markdown-regex-wiki-link new-to t))
  7385. ;; Unfontify existing fontification (start from scratch)
  7386. (markdown-unfontify-region-wiki-links new-from new-to)
  7387. ;; Now do the fontification.
  7388. (markdown-fontify-region-wiki-links new-from new-to))))))
  7389. (and (not modified)
  7390. (buffer-modified-p)
  7391. (set-buffer-modified-p nil)))))
  7392. (defun markdown-check-change-for-wiki-link-after-change (from to _)
  7393. "Check region between FROM and TO for wiki links and re-fontify as needed.
  7394. Designed to be used with the `after-change-functions' hook."
  7395. (markdown-check-change-for-wiki-link from to))
  7396. (defun markdown-fontify-buffer-wiki-links ()
  7397. "Refontify all wiki links in the buffer."
  7398. (interactive)
  7399. (markdown-check-change-for-wiki-link (point-min) (point-max)))
  7400. (defun markdown-toggle-wiki-links (&optional arg)
  7401. "Toggle support for wiki links.
  7402. With a prefix argument ARG, enable wiki link support if ARG is positive,
  7403. and disable it otherwise."
  7404. (interactive (list (or current-prefix-arg 'toggle)))
  7405. (setq markdown-enable-wiki-links
  7406. (if (eq arg 'toggle)
  7407. (not markdown-enable-wiki-links)
  7408. (> (prefix-numeric-value arg) 0)))
  7409. (if markdown-enable-wiki-links
  7410. (message "markdown-mode wiki link support enabled")
  7411. (message "markdown-mode wiki link support disabled"))
  7412. (markdown-reload-extensions))
  7413. (defun markdown-setup-wiki-link-hooks ()
  7414. "Add or remove hooks for fontifying wiki links.
  7415. These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
  7416. ;; Anytime text changes make sure it gets fontified correctly
  7417. (if (and markdown-enable-wiki-links
  7418. markdown-wiki-link-fontify-missing)
  7419. (add-hook 'after-change-functions
  7420. 'markdown-check-change-for-wiki-link-after-change t t)
  7421. (remove-hook 'after-change-functions
  7422. 'markdown-check-change-for-wiki-link-after-change t))
  7423. ;; If we left the buffer there is a really good chance we were
  7424. ;; creating one of the wiki link documents. Make sure we get
  7425. ;; refontified when we come back.
  7426. (if (and markdown-enable-wiki-links
  7427. markdown-wiki-link-fontify-missing)
  7428. (progn
  7429. (add-hook 'window-configuration-change-hook
  7430. 'markdown-fontify-buffer-wiki-links t t)
  7431. (markdown-fontify-buffer-wiki-links))
  7432. (remove-hook 'window-configuration-change-hook
  7433. 'markdown-fontify-buffer-wiki-links t)
  7434. (markdown-unfontify-region-wiki-links (point-min) (point-max))))
  7435. ;;; Following & Doing =========================================================
  7436. (defun markdown-follow-thing-at-point (arg)
  7437. "Follow thing at point if possible, such as a reference link or wiki link.
  7438. Opens inline and reference links in a browser. Opens wiki links
  7439. to other files in the current window, or the another window if
  7440. ARG is non-nil.
  7441. See `markdown-follow-link-at-point' and
  7442. `markdown-follow-wiki-link-at-point'."
  7443. (interactive "P")
  7444. (cond ((markdown-link-p)
  7445. (markdown--browse-url (markdown-link-url)))
  7446. ((markdown-wiki-link-p)
  7447. (markdown-follow-wiki-link-at-point arg))
  7448. (t
  7449. (let* ((values (markdown-link-at-pos (point)))
  7450. (url (nth 3 values)))
  7451. (unless url
  7452. (user-error "Nothing to follow at point"))
  7453. (markdown--browse-url url)))))
  7454. (defun markdown-do ()
  7455. "Do something sensible based on context at point.
  7456. Jumps between reference links and definitions; between footnote
  7457. markers and footnote text."
  7458. (interactive)
  7459. (cond
  7460. ;; Footnote definition
  7461. ((markdown-footnote-text-positions)
  7462. (markdown-footnote-return))
  7463. ;; Footnote marker
  7464. ((markdown-footnote-marker-positions)
  7465. (markdown-footnote-goto-text))
  7466. ;; Reference link
  7467. ((thing-at-point-looking-at markdown-regex-link-reference)
  7468. (markdown-reference-goto-definition))
  7469. ;; Reference definition
  7470. ((thing-at-point-looking-at markdown-regex-reference-definition)
  7471. (markdown-reference-goto-link (match-string-no-properties 2)))
  7472. ;; GFM task list item
  7473. ((markdown-gfm-task-list-item-at-point)
  7474. (markdown-toggle-gfm-checkbox))
  7475. ;; Align table
  7476. ((markdown-table-at-point-p)
  7477. (call-interactively #'markdown-table-align))
  7478. ;; Otherwise
  7479. (t
  7480. (markdown-insert-gfm-checkbox))))
  7481. ;;; Miscellaneous =============================================================
  7482. (defun markdown-compress-whitespace-string (str)
  7483. "Compress whitespace in STR and return result.
  7484. Leading and trailing whitespace is removed. Sequences of multiple
  7485. spaces, tabs, and newlines are replaced with single spaces."
  7486. (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
  7487. (replace-regexp-in-string "[ \t\n]+" " " str)))
  7488. (defun markdown--substitute-command-keys (string)
  7489. "Like `substitute-command-keys' but, but prefers control characters.
  7490. First pass STRING to `substitute-command-keys' and then
  7491. substitute `C-i` for `TAB` and `C-m` for `RET`."
  7492. (replace-regexp-in-string
  7493. "\\<TAB\\>" "C-i"
  7494. (replace-regexp-in-string
  7495. "\\<RET\\>" "C-m" (substitute-command-keys string) t) t))
  7496. (defun markdown-line-number-at-pos (&optional pos)
  7497. "Return (narrowed) buffer line number at position POS.
  7498. If POS is nil, use current buffer location.
  7499. This is an exact copy of `line-number-at-pos' for use in emacs21."
  7500. (let ((opoint (or pos (point))) start)
  7501. (save-excursion
  7502. (goto-char (point-min))
  7503. (setq start (point))
  7504. (goto-char opoint)
  7505. (forward-line 0)
  7506. (1+ (count-lines start (point))))))
  7507. (defun markdown-inside-link-p ()
  7508. "Return t if point is within a link."
  7509. (save-match-data
  7510. (thing-at-point-looking-at (markdown-make-regex-link-generic))))
  7511. (defun markdown-line-is-reference-definition-p ()
  7512. "Return whether the current line is a (non-footnote) reference definition."
  7513. (save-excursion
  7514. (move-beginning-of-line 1)
  7515. (and (looking-at-p markdown-regex-reference-definition)
  7516. (not (looking-at-p "[ \t]*\\[^")))))
  7517. (defun markdown-adaptive-fill-function ()
  7518. "Return prefix for filling paragraph or nil if not determined."
  7519. (cond
  7520. ;; List item inside blockquote
  7521. ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
  7522. (replace-regexp-in-string
  7523. "[0-9\\.*+-]" " " (match-string-no-properties 0)))
  7524. ;; Blockquote
  7525. ((looking-at markdown-regex-blockquote)
  7526. (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
  7527. ;; List items
  7528. ((looking-at markdown-regex-list)
  7529. (match-string-no-properties 0))
  7530. ;; Footnote definition
  7531. ((looking-at-p markdown-regex-footnote-definition)
  7532. " ") ; four spaces
  7533. ;; No match
  7534. (t nil)))
  7535. (defun markdown-fill-paragraph (&optional justify)
  7536. "Fill paragraph at or after point.
  7537. This function is like \\[fill-paragraph], but it skips Markdown
  7538. code blocks. If the point is in a code block, or just before one,
  7539. do not fill. Otherwise, call `fill-paragraph' as usual. If
  7540. JUSTIFY is non-nil, justify text as well. Since this function
  7541. handles filling itself, it always returns t so that
  7542. `fill-paragraph' doesn't run."
  7543. (interactive "P")
  7544. (unless (or (markdown-code-block-at-point-p)
  7545. (save-excursion
  7546. (back-to-indentation)
  7547. (skip-syntax-forward "-")
  7548. (markdown-code-block-at-point-p)))
  7549. (let ((fill-prefix (save-excursion
  7550. (goto-char (line-beginning-position))
  7551. (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)")
  7552. (match-string-no-properties 1)))))
  7553. (fill-paragraph justify)))
  7554. t)
  7555. (defun markdown-fill-forward-paragraph (&optional arg)
  7556. "Function used by `fill-paragraph' to move over ARG paragraphs.
  7557. This is a `fill-forward-paragraph-function' for `markdown-mode'.
  7558. It is called with a single argument specifying the number of
  7559. paragraphs to move. Just like `forward-paragraph', it should
  7560. return the number of paragraphs left to move."
  7561. (or arg (setq arg 1))
  7562. (if (> arg 0)
  7563. ;; With positive ARG, move across ARG non-code-block paragraphs,
  7564. ;; one at a time. When passing a code block, don't decrement ARG.
  7565. (while (and (not (eobp))
  7566. (> arg 0)
  7567. (= (forward-paragraph 1) 0)
  7568. (or (markdown-code-block-at-pos (point-at-bol 0))
  7569. (setq arg (1- arg)))))
  7570. ;; Move backward by one paragraph with negative ARG (always -1).
  7571. (let ((start (point)))
  7572. (setq arg (forward-paragraph arg))
  7573. (while (and (not (eobp))
  7574. (progn (move-to-left-margin) (not (eobp)))
  7575. (looking-at-p paragraph-separate))
  7576. (forward-line 1))
  7577. (cond
  7578. ;; Move point past whitespace following list marker.
  7579. ((looking-at markdown-regex-list)
  7580. (goto-char (match-end 0)))
  7581. ;; Move point past whitespace following pipe at beginning of line
  7582. ;; to handle Pandoc line blocks.
  7583. ((looking-at "^|\\s-*")
  7584. (goto-char (match-end 0)))
  7585. ;; Return point if the paragraph passed was a code block.
  7586. ((markdown-code-block-at-pos (point-at-bol 2))
  7587. (goto-char start)))))
  7588. arg)
  7589. (defun markdown--inhibit-electric-quote ()
  7590. "Function added to `electric-quote-inhibit-functions'.
  7591. Return non-nil if the quote has been inserted inside a code block
  7592. or span."
  7593. (let ((pos (1- (point))))
  7594. (or (markdown-inline-code-at-pos pos)
  7595. (markdown-code-block-at-pos pos))))
  7596. ;;; Extension Framework =======================================================
  7597. (defun markdown-reload-extensions ()
  7598. "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
  7599. (interactive)
  7600. (when (derived-mode-p 'markdown-mode)
  7601. ;; Refontify buffer
  7602. (font-lock-flush)
  7603. ;; Add or remove hooks related to extensions
  7604. (markdown-setup-wiki-link-hooks)))
  7605. (defun markdown-handle-local-variables ()
  7606. "Run in `hack-local-variables-hook' to update font lock rules.
  7607. Checks to see if there is actually a markdown-mode file local variable
  7608. before regenerating font-lock rules for extensions."
  7609. (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist)
  7610. (assoc 'markdown-enable-math file-local-variables-alist))
  7611. (when (assoc 'markdown-enable-math file-local-variables-alist)
  7612. (markdown-toggle-math markdown-enable-math))
  7613. (markdown-reload-extensions)))
  7614. ;;; Math Support ==============================================================
  7615. (defconst markdown-mode-font-lock-keywords-math
  7616. (list
  7617. ;; Equation reference (eq:foo)
  7618. '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face)
  7619. (2 markdown-reference-face)
  7620. (3 markdown-markup-face)))
  7621. ;; Equation reference \eqref{foo}
  7622. '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face)
  7623. (2 markdown-reference-face)
  7624. (3 markdown-markup-face))))
  7625. "Font lock keywords to add and remove when toggling math support.")
  7626. (defun markdown-toggle-math (&optional arg)
  7627. "Toggle support for inline and display LaTeX math expressions.
  7628. With a prefix argument ARG, enable math mode if ARG is positive,
  7629. and disable it otherwise. If called from Lisp, enable the mode
  7630. if ARG is omitted or nil."
  7631. (interactive (list (or current-prefix-arg 'toggle)))
  7632. (setq markdown-enable-math
  7633. (if (eq arg 'toggle)
  7634. (not markdown-enable-math)
  7635. (> (prefix-numeric-value arg) 0)))
  7636. (if markdown-enable-math
  7637. (progn
  7638. (font-lock-add-keywords
  7639. 'markdown-mode markdown-mode-font-lock-keywords-math)
  7640. (message "markdown-mode math support enabled"))
  7641. (font-lock-remove-keywords
  7642. 'markdown-mode markdown-mode-font-lock-keywords-math)
  7643. (message "markdown-mode math support disabled"))
  7644. (markdown-reload-extensions))
  7645. ;;; GFM Checkboxes ============================================================
  7646. (define-button-type 'markdown-gfm-checkbox-button
  7647. 'follow-link t
  7648. 'face 'markdown-gfm-checkbox-face
  7649. 'mouse-face 'markdown-highlight-face
  7650. 'action #'markdown-toggle-gfm-checkbox-button)
  7651. (defun markdown-gfm-task-list-item-at-point (&optional bounds)
  7652. "Return non-nil if there is a GFM task list item at the point.
  7653. Optionally, the list item BOUNDS may be given if available, as
  7654. returned by `markdown-cur-list-item-bounds'. When a task list item
  7655. is found, the return value is the same value returned by
  7656. `markdown-cur-list-item-bounds'."
  7657. (unless bounds
  7658. (setq bounds (markdown-cur-list-item-bounds)))
  7659. (> (length (nth 5 bounds)) 0))
  7660. (defun markdown-insert-gfm-checkbox ()
  7661. "Add GFM checkbox at point.
  7662. Returns t if added.
  7663. Returns nil if non-applicable."
  7664. (interactive)
  7665. (let ((bounds (markdown-cur-list-item-bounds)))
  7666. (if bounds
  7667. (unless (cl-sixth bounds)
  7668. (let ((pos (+ (cl-first bounds) (cl-fourth bounds)))
  7669. (markup "[ ] "))
  7670. (if (< pos (point))
  7671. (save-excursion
  7672. (goto-char pos)
  7673. (insert markup))
  7674. (goto-char pos)
  7675. (insert markup))
  7676. (syntax-propertize (+ (cl-second bounds) 4))
  7677. t))
  7678. (unless (save-excursion
  7679. (back-to-indentation)
  7680. (or (markdown-list-item-at-point-p)
  7681. (markdown-heading-at-point)
  7682. (markdown-in-comment-p)
  7683. (markdown-code-block-at-point-p)))
  7684. (let ((pos (save-excursion
  7685. (back-to-indentation)
  7686. (point)))
  7687. (markup (concat (or (save-excursion
  7688. (beginning-of-line 0)
  7689. (cl-fifth (markdown-cur-list-item-bounds)))
  7690. markdown-unordered-list-item-prefix)
  7691. "[ ] ")))
  7692. (if (< pos (point))
  7693. (save-excursion
  7694. (goto-char pos)
  7695. (insert markup))
  7696. (goto-char pos)
  7697. (insert markup))
  7698. (syntax-propertize (point-at-eol))
  7699. t)))))
  7700. (defun markdown-toggle-gfm-checkbox ()
  7701. "Toggle GFM checkbox at point.
  7702. Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
  7703. Returns nil if there is no task list item at the point."
  7704. (interactive)
  7705. (save-match-data
  7706. (save-excursion
  7707. (let ((bounds (markdown-cur-list-item-bounds)))
  7708. (when bounds
  7709. ;; Move to beginning of task list item
  7710. (goto-char (cl-first bounds))
  7711. ;; Advance to column of first non-whitespace after marker
  7712. (forward-char (cl-fourth bounds))
  7713. (cond ((looking-at "\\[ \\]")
  7714. (replace-match
  7715. (if markdown-gfm-uppercase-checkbox "[X]" "[x]")
  7716. nil t)
  7717. (match-string-no-properties 0))
  7718. ((looking-at "\\[[xX]\\]")
  7719. (replace-match "[ ]" nil t)
  7720. (match-string-no-properties 0))))))))
  7721. (defun markdown-toggle-gfm-checkbox-button (button)
  7722. "Toggle GFM checkbox BUTTON on click."
  7723. (save-match-data
  7724. (save-excursion
  7725. (goto-char (button-start button))
  7726. (markdown-toggle-gfm-checkbox))))
  7727. (defun markdown-make-gfm-checkboxes-buttons (start end)
  7728. "Make GFM checkboxes buttons in region between START and END."
  7729. (save-excursion
  7730. (goto-char start)
  7731. (let ((case-fold-search t))
  7732. (save-excursion
  7733. (while (re-search-forward markdown-regex-gfm-checkbox end t)
  7734. (make-button (match-beginning 1) (match-end 1)
  7735. :type 'markdown-gfm-checkbox-button))))))
  7736. ;; Called when any modification is made to buffer text.
  7737. (defun markdown-gfm-checkbox-after-change-function (beg end _)
  7738. "Add to `after-change-functions' to setup GFM checkboxes as buttons.
  7739. BEG and END are the limits of scanned region."
  7740. (save-excursion
  7741. (save-match-data
  7742. ;; Rescan between start of line from `beg' and start of line after `end'.
  7743. (markdown-make-gfm-checkboxes-buttons
  7744. (progn (goto-char beg) (beginning-of-line) (point))
  7745. (progn (goto-char end) (forward-line 1) (point))))))
  7746. (defun markdown-remove-gfm-checkbox-overlays ()
  7747. "Remove all GFM checkbox overlays in buffer."
  7748. (save-excursion
  7749. (save-restriction
  7750. (widen)
  7751. (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face))))
  7752. ;;; Display inline image ======================================================
  7753. (defvar-local markdown-inline-image-overlays nil)
  7754. (defun markdown-remove-inline-images ()
  7755. "Remove inline image overlays from image links in the buffer.
  7756. This can be toggled with `markdown-toggle-inline-images'
  7757. or \\[markdown-toggle-inline-images]."
  7758. (interactive)
  7759. (mapc #'delete-overlay markdown-inline-image-overlays)
  7760. (setq markdown-inline-image-overlays nil))
  7761. (defcustom markdown-display-remote-images nil
  7762. "If non-nil, download and display remote images.
  7763. See also `markdown-inline-image-overlays'.
  7764. Only image URLs specified with a protocol listed in
  7765. `markdown-remote-image-protocols' are displayed."
  7766. :group 'markdown
  7767. :type 'boolean)
  7768. (defcustom markdown-remote-image-protocols '("https")
  7769. "List of protocols to use to download remote images.
  7770. See also `markdown-display-remote-images'."
  7771. :group 'markdown
  7772. :type '(repeat string))
  7773. (defvar markdown--remote-image-cache
  7774. (make-hash-table :test 'equal)
  7775. "A map from URLs to image paths.")
  7776. (defun markdown--get-remote-image (url)
  7777. "Retrieve the image path for a given URL."
  7778. (or (gethash url markdown--remote-image-cache)
  7779. (let ((dl-path (make-temp-file "markdown-mode--image")))
  7780. (require 'url)
  7781. (url-copy-file url dl-path t)
  7782. (puthash url dl-path markdown--remote-image-cache))))
  7783. (defun markdown-display-inline-images ()
  7784. "Add inline image overlays to image links in the buffer.
  7785. This can be toggled with `markdown-toggle-inline-images'
  7786. or \\[markdown-toggle-inline-images]."
  7787. (interactive)
  7788. (unless (display-images-p)
  7789. (error "Cannot show images"))
  7790. (save-excursion
  7791. (save-restriction
  7792. (widen)
  7793. (goto-char (point-min))
  7794. (while (re-search-forward markdown-regex-link-inline nil t)
  7795. (let* ((start (match-beginning 0))
  7796. (imagep (match-beginning 1))
  7797. (end (match-end 0))
  7798. (file (match-string-no-properties 6)))
  7799. (when (and imagep
  7800. (not (zerop (length file))))
  7801. (unless (file-exists-p file)
  7802. (let* ((download-file (funcall markdown-translate-filename-function file))
  7803. (valid-url (ignore-errors
  7804. (member (downcase (url-type (url-generic-parse-url download-file)))
  7805. markdown-remote-image-protocols))))
  7806. (if (and markdown-display-remote-images valid-url)
  7807. (setq file (markdown--get-remote-image download-file))
  7808. (when (not valid-url)
  7809. ;; strip query parameter
  7810. (setq file (replace-regexp-in-string "?.+\\'" "" file))
  7811. (unless (file-exists-p file)
  7812. (setq file (url-unhex-string file)))))))
  7813. (when (file-exists-p file)
  7814. (let* ((abspath (if (file-name-absolute-p file)
  7815. file
  7816. (concat default-directory file)))
  7817. (image
  7818. (cond ((and markdown-max-image-size
  7819. (image-type-available-p 'imagemagick))
  7820. (create-image
  7821. abspath 'imagemagick nil
  7822. :max-width (car markdown-max-image-size)
  7823. :max-height (cdr markdown-max-image-size)))
  7824. (markdown-max-image-size
  7825. (create-image abspath nil nil
  7826. :max-width (car markdown-max-image-size)
  7827. :max-height (cdr markdown-max-image-size)))
  7828. (t (create-image abspath)))))
  7829. (when image
  7830. (let ((ov (make-overlay start end)))
  7831. (overlay-put ov 'display image)
  7832. (overlay-put ov 'face 'default)
  7833. (push ov markdown-inline-image-overlays)))))))))))
  7834. (defun markdown-toggle-inline-images ()
  7835. "Toggle inline image overlays in the buffer."
  7836. (interactive)
  7837. (if markdown-inline-image-overlays
  7838. (markdown-remove-inline-images)
  7839. (markdown-display-inline-images)))
  7840. ;;; GFM Code Block Fontification ==============================================
  7841. (defcustom markdown-fontify-code-blocks-natively nil
  7842. "When non-nil, fontify code in code blocks using the native major mode.
  7843. This only works for fenced code blocks where the language is
  7844. specified where we can automatically determine the appropriate
  7845. mode to use. The language to mode mapping may be customized by
  7846. setting the variable `markdown-code-lang-modes'."
  7847. :group 'markdown
  7848. :type 'boolean
  7849. :safe 'booleanp
  7850. :package-version '(markdown-mode . "2.3"))
  7851. (defcustom markdown-fontify-code-block-default-mode nil
  7852. "Default mode to use to fontify code blocks.
  7853. This mode is used when automatic detection fails, such as for GFM
  7854. code blocks with no language specified."
  7855. :group 'markdown
  7856. :type '(choice function (const :tag "None" nil))
  7857. :package-version '(markdown-mode . "2.4"))
  7858. (defun markdown-toggle-fontify-code-blocks-natively (&optional arg)
  7859. "Toggle the native fontification of code blocks.
  7860. With a prefix argument ARG, enable if ARG is positive,
  7861. and disable otherwise."
  7862. (interactive (list (or current-prefix-arg 'toggle)))
  7863. (setq markdown-fontify-code-blocks-natively
  7864. (if (eq arg 'toggle)
  7865. (not markdown-fontify-code-blocks-natively)
  7866. (> (prefix-numeric-value arg) 0)))
  7867. (if markdown-fontify-code-blocks-natively
  7868. (message "markdown-mode native code block fontification enabled")
  7869. (message "markdown-mode native code block fontification disabled"))
  7870. (markdown-reload-extensions))
  7871. ;; This is based on `org-src-lang-modes' from org-src.el
  7872. (defcustom markdown-code-lang-modes
  7873. '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
  7874. ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
  7875. ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
  7876. ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
  7877. ("bash" . sh-mode))
  7878. "Alist mapping languages to their major mode.
  7879. The key is the language name, the value is the major mode. For
  7880. many languages this is simple, but for language where this is not
  7881. the case, this variable provides a way to simplify things on the
  7882. user side. For example, there is no ocaml-mode in Emacs, but the
  7883. mode to use is `tuareg-mode'."
  7884. :group 'markdown
  7885. :type '(repeat
  7886. (cons
  7887. (string "Language name")
  7888. (symbol "Major mode")))
  7889. :package-version '(markdown-mode . "2.3"))
  7890. (defun markdown-get-lang-mode (lang)
  7891. "Return major mode that should be used for LANG.
  7892. LANG is a string, and the returned major mode is a symbol."
  7893. (cl-find-if
  7894. 'fboundp
  7895. (list (cdr (assoc lang markdown-code-lang-modes))
  7896. (cdr (assoc (downcase lang) markdown-code-lang-modes))
  7897. (intern (concat lang "-mode"))
  7898. (intern (concat (downcase lang) "-mode")))))
  7899. (defun markdown-fontify-code-blocks-generic (matcher last)
  7900. "Add text properties to next code block from point to LAST.
  7901. Use matching function MATCHER."
  7902. (when (funcall matcher last)
  7903. (save-excursion
  7904. (save-match-data
  7905. (let* ((start (match-beginning 0))
  7906. (end (match-end 0))
  7907. ;; Find positions outside opening and closing backquotes.
  7908. (bol-prev (progn (goto-char start)
  7909. (if (bolp) (point-at-bol 0) (point-at-bol))))
  7910. (eol-next (progn (goto-char end)
  7911. (if (bolp) (point-at-bol 2) (point-at-bol 3))))
  7912. lang)
  7913. (if (and markdown-fontify-code-blocks-natively
  7914. (or (setq lang (markdown-code-block-lang))
  7915. markdown-fontify-code-block-default-mode))
  7916. (markdown-fontify-code-block-natively lang start end)
  7917. (add-text-properties start end '(face markdown-pre-face)))
  7918. ;; Set background for block as well as opening and closing lines.
  7919. (font-lock-append-text-property
  7920. bol-prev eol-next 'face 'markdown-code-face)
  7921. ;; Set invisible property for lines before and after, including newline.
  7922. (add-text-properties bol-prev start '(invisible markdown-markup))
  7923. (add-text-properties end eol-next '(invisible markdown-markup)))))
  7924. t))
  7925. (defun markdown-fontify-gfm-code-blocks (last)
  7926. "Add text properties to next GFM code block from point to LAST."
  7927. (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last))
  7928. (defun markdown-fontify-fenced-code-blocks (last)
  7929. "Add text properties to next tilde fenced code block from point to LAST."
  7930. (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last))
  7931. ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
  7932. (defun markdown-fontify-code-block-natively (lang start end)
  7933. "Fontify given GFM or fenced code block.
  7934. This function is called by Emacs for automatic fontification when
  7935. `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
  7936. language used in the block. START and END specify the block
  7937. position."
  7938. (let ((lang-mode (if lang (markdown-get-lang-mode lang)
  7939. markdown-fontify-code-block-default-mode)))
  7940. (when (fboundp lang-mode)
  7941. (let ((string (buffer-substring-no-properties start end))
  7942. (modified (buffer-modified-p))
  7943. (markdown-buffer (current-buffer)) pos next)
  7944. (remove-text-properties start end '(face nil))
  7945. (with-current-buffer
  7946. (get-buffer-create
  7947. (concat " markdown-code-fontification:" (symbol-name lang-mode)))
  7948. ;; Make sure that modification hooks are not inhibited in
  7949. ;; the org-src-fontification buffer in case we're called
  7950. ;; from `jit-lock-function' (Bug#25132).
  7951. (let ((inhibit-modification-hooks nil))
  7952. (delete-region (point-min) (point-max))
  7953. (insert string " ")) ;; so there's a final property change
  7954. (unless (eq major-mode lang-mode) (funcall lang-mode))
  7955. (font-lock-ensure)
  7956. (setq pos (point-min))
  7957. (while (setq next (next-single-property-change pos 'face))
  7958. (let ((val (get-text-property pos 'face)))
  7959. (when val
  7960. (put-text-property
  7961. (+ start (1- pos)) (1- (+ start next)) 'face
  7962. val markdown-buffer)))
  7963. (setq pos next)))
  7964. (add-text-properties
  7965. start end
  7966. '(font-lock-fontified t fontified t font-lock-multiline t))
  7967. (set-buffer-modified-p modified)))))
  7968. (require 'edit-indirect nil t)
  7969. (defvar edit-indirect-guess-mode-function)
  7970. (defvar edit-indirect-after-commit-functions)
  7971. (defun markdown--edit-indirect-after-commit-function (beg end)
  7972. "Corrective logic run on code block content from lines BEG to END.
  7973. Restores code block indentation from BEG to END, and ensures trailing newlines
  7974. at the END of code blocks."
  7975. ;; ensure trailing newlines
  7976. (goto-char end)
  7977. (unless (eq (char-before) ?\n)
  7978. (insert "\n"))
  7979. ;; restore code block indentation
  7980. (goto-char (- beg 1))
  7981. (let ((block-indentation (current-indentation)))
  7982. (when (> block-indentation 0)
  7983. (indent-rigidly beg end block-indentation))))
  7984. (defun markdown-edit-code-block ()
  7985. "Edit Markdown code block in an indirect buffer."
  7986. (interactive)
  7987. (save-excursion
  7988. (if (fboundp 'edit-indirect-region)
  7989. (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
  7990. (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2)))
  7991. (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1))))
  7992. (if (and begin end)
  7993. (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation)))
  7994. (lang (markdown-code-block-lang))
  7995. (mode (or (and lang (markdown-get-lang-mode lang))
  7996. markdown-edit-code-block-default-mode))
  7997. (edit-indirect-guess-mode-function
  7998. (lambda (_parent-buffer _beg _end)
  7999. (funcall mode)))
  8000. (indirect-buf (edit-indirect-region begin end 'display-buffer)))
  8001. (when (> indentation 0) ;; un-indent in edit-indirect buffer
  8002. (with-current-buffer indirect-buf
  8003. (indent-rigidly (point-min) (point-max) (- indentation)))))
  8004. (user-error "Not inside a GFM or tilde fenced code block")))
  8005. (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
  8006. (progn (package-refresh-contents)
  8007. (package-install 'edit-indirect)
  8008. (markdown-edit-code-block))))))
  8009. ;;; Table Editing =============================================================
  8010. ;; These functions were originally adapted from `org-table.el'.
  8011. ;; General helper functions
  8012. (defmacro markdown--with-gensyms (symbols &rest body)
  8013. (declare (debug (sexp body)) (indent 1))
  8014. `(let ,(mapcar (lambda (s)
  8015. `(,s (make-symbol (concat "--" (symbol-name ',s)))))
  8016. symbols)
  8017. ,@body))
  8018. (defun markdown--split-string (string &optional separators)
  8019. "Splits STRING into substrings at SEPARATORS.
  8020. SEPARATORS is a regular expression. If nil it defaults to
  8021. `split-string-default-separators'. This version returns no empty
  8022. strings if there are matches at the beginning and end of string."
  8023. (let ((start 0) notfirst list)
  8024. (while (and (string-match
  8025. (or separators split-string-default-separators)
  8026. string
  8027. (if (and notfirst
  8028. (= start (match-beginning 0))
  8029. (< start (length string)))
  8030. (1+ start) start))
  8031. (< (match-beginning 0) (length string)))
  8032. (setq notfirst t)
  8033. (or (eq (match-beginning 0) 0)
  8034. (and (eq (match-beginning 0) (match-end 0))
  8035. (eq (match-beginning 0) start))
  8036. (push (substring string start (match-beginning 0)) list))
  8037. (setq start (match-end 0)))
  8038. (or (eq start (length string))
  8039. (push (substring string start) list))
  8040. (nreverse list)))
  8041. (defun markdown--string-width (s)
  8042. "Return width of string S.
  8043. This version ignores characters with invisibility property
  8044. `markdown-markup'."
  8045. (let (b)
  8046. (when (or (eq t buffer-invisibility-spec)
  8047. (member 'markdown-markup buffer-invisibility-spec))
  8048. (while (setq b (text-property-any
  8049. 0 (length s)
  8050. 'invisible 'markdown-markup s))
  8051. (setq s (concat
  8052. (substring s 0 b)
  8053. (substring s (or (next-single-property-change
  8054. b 'invisible s)
  8055. (length s))))))))
  8056. (string-width s))
  8057. (defun markdown--remove-invisible-markup (s)
  8058. "Remove Markdown markup from string S.
  8059. This version removes characters with invisibility property
  8060. `markdown-markup'."
  8061. (let (b)
  8062. (while (setq b (text-property-any
  8063. 0 (length s)
  8064. 'invisible 'markdown-markup s))
  8065. (setq s (concat
  8066. (substring s 0 b)
  8067. (substring s (or (next-single-property-change
  8068. b 'invisible s)
  8069. (length s)))))))
  8070. s)
  8071. ;; Functions for maintaining tables
  8072. (defvar markdown-table-at-point-p-function nil
  8073. "Function to decide if point is inside a table.
  8074. The indirection serves to differentiate between standard markdown
  8075. tables and gfm tables which are less strict about the markup.")
  8076. (defconst markdown-table-line-regexp "^[ \t]*|"
  8077. "Regexp matching any line inside a table.")
  8078. (defconst markdown-table-hline-regexp "^[ \t]*|[-:]"
  8079. "Regexp matching hline inside a table.")
  8080. (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]"
  8081. "Regexp matching dline inside a table.")
  8082. (defun markdown-table-at-point-p ()
  8083. "Return non-nil when point is inside a table."
  8084. (if (functionp markdown-table-at-point-p-function)
  8085. (funcall markdown-table-at-point-p-function)
  8086. (markdown--table-at-point-p)))
  8087. (defun markdown--table-at-point-p ()
  8088. "Return non-nil when point is inside a table."
  8089. (save-excursion
  8090. (beginning-of-line)
  8091. (and (looking-at-p markdown-table-line-regexp)
  8092. (not (markdown-code-block-at-point-p)))))
  8093. (defconst gfm-table-line-regexp "^.?*|"
  8094. "Regexp matching any line inside a table.")
  8095. (defconst gfm-table-hline-regexp "^-+\\(|-\\)+"
  8096. "Regexp matching hline inside a table.")
  8097. ;; GFM simplified tables syntax is as follows:
  8098. ;; - A header line for the column names, this is any text
  8099. ;; separated by `|'.
  8100. ;; - Followed by a string -|-|- ..., the number of dashes is optional
  8101. ;; but must be higher than 1. The number of separators should match
  8102. ;; the number of columns.
  8103. ;; - Followed by the rows of data, which has the same format as the
  8104. ;; header line.
  8105. ;; Example:
  8106. ;;
  8107. ;; foo | bar
  8108. ;; ------|---------
  8109. ;; bar | baz
  8110. ;; bar | baz
  8111. (defun gfm--table-at-point-p ()
  8112. "Return non-nil when point is inside a gfm-compatible table."
  8113. (or (markdown--table-at-point-p)
  8114. (save-excursion
  8115. (beginning-of-line)
  8116. (when (looking-at-p gfm-table-line-regexp)
  8117. ;; we might be at the first line of the table, check if the
  8118. ;; line below is the hline
  8119. (or (save-excursion
  8120. (forward-line 1)
  8121. (looking-at-p gfm-table-hline-regexp))
  8122. ;; go up to find the header
  8123. (catch 'done
  8124. (while (looking-at-p gfm-table-line-regexp)
  8125. (cond
  8126. ((looking-at-p gfm-table-hline-regexp)
  8127. (throw 'done t))
  8128. ((bobp)
  8129. (throw 'done nil)))
  8130. (forward-line -1))
  8131. nil))))))
  8132. (defun markdown-table-hline-at-point-p ()
  8133. "Return non-nil when point is on a hline in a table.
  8134. This function assumes point is on a table."
  8135. (save-excursion
  8136. (beginning-of-line)
  8137. (looking-at-p markdown-table-hline-regexp)))
  8138. (defun markdown-table-begin ()
  8139. "Find the beginning of the table and return its position.
  8140. This function assumes point is on a table."
  8141. (save-excursion
  8142. (while (and (not (bobp))
  8143. (markdown-table-at-point-p))
  8144. (forward-line -1))
  8145. (unless (or (eobp)
  8146. (markdown-table-at-point-p))
  8147. (forward-line 1))
  8148. (point)))
  8149. (defun markdown-table-end ()
  8150. "Find the end of the table and return its position.
  8151. This function assumes point is on a table."
  8152. (save-excursion
  8153. (while (and (not (eobp))
  8154. (markdown-table-at-point-p))
  8155. (forward-line 1))
  8156. (point)))
  8157. (defun markdown-table-get-dline ()
  8158. "Return index of the table data line at point.
  8159. This function assumes point is on a table."
  8160. (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
  8161. (save-excursion
  8162. (goto-char (markdown-table-begin))
  8163. (while (and (re-search-forward
  8164. markdown-table-dline-regexp end t)
  8165. (setq cnt (1+ cnt))
  8166. (< (point-at-eol) pos))))
  8167. cnt))
  8168. (defun markdown--thing-at-wiki-link (pos)
  8169. (when markdown-enable-wiki-links
  8170. (save-excursion
  8171. (save-match-data
  8172. (goto-char pos)
  8173. (thing-at-point-looking-at markdown-regex-wiki-link)))))
  8174. (defun markdown-table-get-column ()
  8175. "Return table column at point.
  8176. This function assumes point is on a table."
  8177. (let ((pos (point)) (cnt 0))
  8178. (save-excursion
  8179. (beginning-of-line)
  8180. (while (search-forward "|" pos t)
  8181. (unless (markdown--thing-at-wiki-link (match-beginning 0))
  8182. (setq cnt (1+ cnt)))))
  8183. cnt))
  8184. (defun markdown-table-get-cell (&optional n)
  8185. "Return the content of the cell in column N of current row.
  8186. N defaults to column at point. This function assumes point is on
  8187. a table."
  8188. (and n (markdown-table-goto-column n))
  8189. (skip-chars-backward "^|\n") (backward-char 1)
  8190. (if (looking-at "|[^|\r\n]*")
  8191. (let* ((pos (match-beginning 0))
  8192. (val (buffer-substring (1+ pos) (match-end 0))))
  8193. (goto-char (min (point-at-eol) (+ 2 pos)))
  8194. ;; Trim whitespaces
  8195. (setq val (replace-regexp-in-string "\\`[ \t]+" "" val)
  8196. val (replace-regexp-in-string "[ \t]+\\'" "" val)))
  8197. (forward-char 1) ""))
  8198. (defun markdown-table-goto-dline (n)
  8199. "Go to the Nth data line in the table at point.
  8200. Return t when the line exists, nil otherwise. This function
  8201. assumes point is on a table."
  8202. (goto-char (markdown-table-begin))
  8203. (let ((end (markdown-table-end)) (cnt 0))
  8204. (while (and (re-search-forward
  8205. markdown-table-dline-regexp end t)
  8206. (< (setq cnt (1+ cnt)) n)))
  8207. (= cnt n)))
  8208. (defun markdown-table-goto-column (n &optional on-delim)
  8209. "Go to the Nth column in the table line at point.
  8210. With optional argument ON-DELIM, stop with point before the left
  8211. delimiter of the cell. If there are less than N cells, just go
  8212. beyond the last delimiter. This function assumes point is on a
  8213. table."
  8214. (beginning-of-line 1)
  8215. (when (> n 0)
  8216. (while (and (> n 0) (search-forward "|" (point-at-eol) t))
  8217. (unless (markdown--thing-at-wiki-link (match-beginning 0))
  8218. (cl-decf n)))
  8219. (if on-delim
  8220. (backward-char 1)
  8221. (when (looking-at " ") (forward-char 1)))))
  8222. (defmacro markdown-table-save-cell (&rest body)
  8223. "Save cell at point, execute BODY and restore cell.
  8224. This function assumes point is on a table."
  8225. (declare (debug (body)))
  8226. (markdown--with-gensyms (line column)
  8227. `(let ((,line (copy-marker (line-beginning-position)))
  8228. (,column (markdown-table-get-column)))
  8229. (unwind-protect
  8230. (progn ,@body)
  8231. (goto-char ,line)
  8232. (markdown-table-goto-column ,column)
  8233. (set-marker ,line nil)))))
  8234. (defun markdown-table-blank-line (s)
  8235. "Convert a table line S into a line with blank cells."
  8236. (if (string-match "^[ \t]*|-" s)
  8237. (setq s (mapconcat
  8238. (lambda (x) (if (member x '(?| ?+)) "|" " "))
  8239. s ""))
  8240. (with-temp-buffer
  8241. (insert s)
  8242. (goto-char (point-min))
  8243. (when (re-search-forward "|" nil t)
  8244. (let ((cur (point))
  8245. ret)
  8246. (while (re-search-forward "|" nil t)
  8247. (when (and (not (eql (char-before (match-beginning 0)) ?\\))
  8248. (not (markdown--thing-at-wiki-link (match-beginning 0))))
  8249. (push (make-string (- (match-beginning 0) cur) ? ) ret)
  8250. (setq cur (match-end 0))))
  8251. (format "|%s|" (string-join (nreverse ret) "|")))))))
  8252. (defun markdown-table-colfmt (fmtspec)
  8253. "Process column alignment specifier FMTSPEC for tables."
  8254. (when (stringp fmtspec)
  8255. (mapcar (lambda (x)
  8256. (cond ((string-match-p "^:.*:$" x) 'c)
  8257. ((string-match-p "^:" x) 'l)
  8258. ((string-match-p ":$" x) 'r)
  8259. (t 'd)))
  8260. (markdown--split-string fmtspec "\\s-*|\\s-*"))))
  8261. (defun markdown--first-column-p (bar-pos)
  8262. (save-excursion
  8263. (save-match-data
  8264. (goto-char bar-pos)
  8265. (looking-back "^\\s-*" (line-beginning-position)))))
  8266. (defun markdown--table-line-to-columns (line)
  8267. (with-temp-buffer
  8268. (insert line)
  8269. (goto-char (point-min))
  8270. (let ((cur (point))
  8271. ret)
  8272. (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)
  8273. (if (markdown--first-column-p (match-beginning 1))
  8274. (setq cur (match-end 0))
  8275. (cond ((eql (char-before (match-beginning 1)) ?\\)
  8276. ;; keep spaces
  8277. (goto-char (match-end 1)))
  8278. ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing
  8279. (t
  8280. (push (buffer-substring-no-properties cur (match-beginning 0)) ret)
  8281. (setq cur (match-end 0))))))
  8282. (when (< cur (length line))
  8283. (push (buffer-substring-no-properties cur (point-max)) ret))
  8284. (nreverse ret))))
  8285. (defun markdown-table-align ()
  8286. "Align table at point.
  8287. This function assumes point is on a table."
  8288. (interactive)
  8289. (let ((begin (markdown-table-begin))
  8290. (end (copy-marker (markdown-table-end))))
  8291. (markdown-table-save-cell
  8292. (goto-char begin)
  8293. (let* (fmtspec
  8294. ;; Store table indent
  8295. (indent (progn (looking-at "[ \t]*") (match-string 0)))
  8296. ;; Split table in lines and save column format specifier
  8297. (lines (mapcar (lambda (l)
  8298. (if (string-match-p "\\`[ \t]*|[ \t]*[-:]" l)
  8299. (progn (setq fmtspec (or fmtspec l)) nil) l))
  8300. (markdown--split-string (buffer-substring begin end) "\n")))
  8301. ;; Split lines in cells
  8302. (cells (mapcar (lambda (l) (markdown--table-line-to-columns l))
  8303. (remq nil lines)))
  8304. ;; Calculate maximum number of cells in a line
  8305. (maxcells (if cells
  8306. (apply #'max (mapcar #'length cells))
  8307. (user-error "Empty table")))
  8308. ;; Empty cells to fill short lines
  8309. (emptycells (make-list maxcells ""))
  8310. maxwidths)
  8311. ;; Calculate maximum width for each column
  8312. (dotimes (i maxcells)
  8313. (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells)))
  8314. (push (apply #'max 1 (mapcar #'markdown--string-width column))
  8315. maxwidths)))
  8316. (setq maxwidths (nreverse maxwidths))
  8317. ;; Process column format specifier
  8318. (setq fmtspec (markdown-table-colfmt fmtspec))
  8319. ;; Compute formats needed for output of table lines
  8320. (let ((hfmt (concat indent "|"))
  8321. (rfmt (concat indent "|"))
  8322. hfmt1 rfmt1 fmt)
  8323. (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|")))
  8324. (setq fmt (pop fmtspec))
  8325. (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |"))
  8326. ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |"))
  8327. ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |"))
  8328. (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |")))
  8329. (setq rfmt (concat rfmt (format rfmt1 width)))
  8330. (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-)))))
  8331. ;; Replace modified lines only
  8332. (dolist (line lines)
  8333. (let ((line (if line
  8334. (apply #'format rfmt (append (pop cells) emptycells))
  8335. hfmt))
  8336. (previous (buffer-substring (point) (line-end-position))))
  8337. (if (equal previous line)
  8338. (forward-line)
  8339. (insert line "\n")
  8340. (delete-region (point) (line-beginning-position 2))))))
  8341. (set-marker end nil)))))
  8342. (defun markdown-table-insert-row (&optional arg)
  8343. "Insert a new row above the row at point into the table.
  8344. With optional argument ARG, insert below the current row."
  8345. (interactive "P")
  8346. (unless (markdown-table-at-point-p)
  8347. (user-error "Not at a table"))
  8348. (let* ((line (buffer-substring
  8349. (line-beginning-position) (line-end-position)))
  8350. (new (markdown-table-blank-line line)))
  8351. (beginning-of-line (if arg 2 1))
  8352. (unless (bolp) (insert "\n"))
  8353. (insert-before-markers new "\n")
  8354. (beginning-of-line 0)
  8355. (re-search-forward "| ?" (line-end-position) t)))
  8356. (defun markdown-table-delete-row ()
  8357. "Delete row or horizontal line at point from the table."
  8358. (interactive)
  8359. (unless (markdown-table-at-point-p)
  8360. (user-error "Not at a table"))
  8361. (let ((col (current-column)))
  8362. (kill-region (point-at-bol)
  8363. (min (1+ (point-at-eol)) (point-max)))
  8364. (unless (markdown-table-at-point-p) (beginning-of-line 0))
  8365. (move-to-column col)))
  8366. (defun markdown-table-move-row (&optional up)
  8367. "Move table line at point down.
  8368. With optional argument UP, move it up."
  8369. (interactive "P")
  8370. (unless (markdown-table-at-point-p)
  8371. (user-error "Not at a table"))
  8372. (let* ((col (current-column)) (pos (point))
  8373. (tonew (if up 0 2)) txt)
  8374. (beginning-of-line tonew)
  8375. (unless (markdown-table-at-point-p)
  8376. (goto-char pos) (user-error "Cannot move row further"))
  8377. (goto-char pos) (beginning-of-line 1) (setq pos (point))
  8378. (setq txt (buffer-substring (point) (1+ (point-at-eol))))
  8379. (delete-region (point) (1+ (point-at-eol)))
  8380. (beginning-of-line tonew)
  8381. (insert txt) (beginning-of-line 0)
  8382. (move-to-column col)))
  8383. (defun markdown-table-move-row-up ()
  8384. "Move table row at point up."
  8385. (interactive)
  8386. (markdown-table-move-row 'up))
  8387. (defun markdown-table-move-row-down ()
  8388. "Move table row at point down."
  8389. (interactive)
  8390. (markdown-table-move-row nil))
  8391. (defun markdown-table-insert-column ()
  8392. "Insert a new table column."
  8393. (interactive)
  8394. (unless (markdown-table-at-point-p)
  8395. (user-error "Not at a table"))
  8396. (let* ((col (max 1 (markdown-table-get-column)))
  8397. (begin (markdown-table-begin))
  8398. (end (copy-marker (markdown-table-end))))
  8399. (markdown-table-save-cell
  8400. (goto-char begin)
  8401. (while (< (point) end)
  8402. (markdown-table-goto-column col t)
  8403. (if (markdown-table-hline-at-point-p)
  8404. (insert "|---")
  8405. (insert "| "))
  8406. (forward-line)))
  8407. (set-marker end nil)
  8408. (markdown-table-align)))
  8409. (defun markdown-table-delete-column ()
  8410. "Delete column at point from table."
  8411. (interactive)
  8412. (unless (markdown-table-at-point-p)
  8413. (user-error "Not at a table"))
  8414. (let ((col (markdown-table-get-column))
  8415. (begin (markdown-table-begin))
  8416. (end (copy-marker (markdown-table-end))))
  8417. (markdown-table-save-cell
  8418. (goto-char begin)
  8419. (while (< (point) end)
  8420. (markdown-table-goto-column col t)
  8421. (and (looking-at "|[^|\n]+|")
  8422. (replace-match "|"))
  8423. (forward-line)))
  8424. (set-marker end nil)
  8425. (markdown-table-goto-column (max 1 (1- col)))
  8426. (markdown-table-align)))
  8427. (defun markdown-table-move-column (&optional left)
  8428. "Move table column at point to the right.
  8429. With optional argument LEFT, move it to the left."
  8430. (interactive "P")
  8431. (unless (markdown-table-at-point-p)
  8432. (user-error "Not at a table"))
  8433. (let* ((col (markdown-table-get-column))
  8434. (col1 (if left (1- col) col))
  8435. (colpos (if left (1- col) (1+ col)))
  8436. (begin (markdown-table-begin))
  8437. (end (copy-marker (markdown-table-end))))
  8438. (when (and left (= col 1))
  8439. (user-error "Cannot move column further left"))
  8440. (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
  8441. (user-error "Cannot move column further right"))
  8442. (markdown-table-save-cell
  8443. (goto-char begin)
  8444. (while (< (point) end)
  8445. (markdown-table-goto-column col1 t)
  8446. (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
  8447. (replace-match "|\\2|\\1|"))
  8448. (forward-line)))
  8449. (set-marker end nil)
  8450. (markdown-table-goto-column colpos)
  8451. (markdown-table-align)))
  8452. (defun markdown-table-move-column-left ()
  8453. "Move table column at point to the left."
  8454. (interactive)
  8455. (markdown-table-move-column 'left))
  8456. (defun markdown-table-move-column-right ()
  8457. "Move table column at point to the right."
  8458. (interactive)
  8459. (markdown-table-move-column nil))
  8460. (defun markdown-table-next-row ()
  8461. "Go to the next row (same column) in the table.
  8462. Create new table lines if required."
  8463. (interactive)
  8464. (unless (markdown-table-at-point-p)
  8465. (user-error "Not at a table"))
  8466. (if (or (looking-at "[ \t]*$")
  8467. (save-excursion (skip-chars-backward " \t") (bolp)))
  8468. (newline)
  8469. (markdown-table-align)
  8470. (let ((col (markdown-table-get-column)))
  8471. (beginning-of-line 2)
  8472. (if (or (not (markdown-table-at-point-p))
  8473. (markdown-table-hline-at-point-p))
  8474. (progn
  8475. (beginning-of-line 0)
  8476. (markdown-table-insert-row 'below)))
  8477. (markdown-table-goto-column col)
  8478. (skip-chars-backward "^|\n\r")
  8479. (when (looking-at " ") (forward-char 1)))))
  8480. (defun markdown-table-forward-cell ()
  8481. "Go to the next cell in the table.
  8482. Create new table lines if required."
  8483. (interactive)
  8484. (unless (markdown-table-at-point-p)
  8485. (user-error "Not at a table"))
  8486. (markdown-table-align)
  8487. (let ((end (markdown-table-end)))
  8488. (when (markdown-table-hline-at-point-p) (end-of-line 1))
  8489. (condition-case nil
  8490. (progn
  8491. (re-search-forward "\\(?:^\\|[^\\]\\)|" end)
  8492. (when (looking-at "[ \t]*$")
  8493. (re-search-forward "\\(?:^\\|[^\\]:\\)|" end))
  8494. (when (and (looking-at "[-:]")
  8495. (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t))
  8496. (goto-char (match-beginning 1)))
  8497. (if (looking-at "[-:]")
  8498. (progn
  8499. (beginning-of-line 0)
  8500. (markdown-table-insert-row 'below))
  8501. (when (looking-at " ") (forward-char 1))))
  8502. (error (markdown-table-insert-row 'below)))))
  8503. (defun markdown-table-backward-cell ()
  8504. "Go to the previous cell in the table."
  8505. (interactive)
  8506. (unless (markdown-table-at-point-p)
  8507. (user-error "Not at a table"))
  8508. (markdown-table-align)
  8509. (when (markdown-table-hline-at-point-p) (beginning-of-line 1))
  8510. (condition-case nil
  8511. (progn
  8512. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))
  8513. ;; When this function is called while in the first cell in a
  8514. ;; table, the point will now be at the beginning of a line. In
  8515. ;; this case, we need to move past one additional table
  8516. ;; boundary, the end of the table on the previous line.
  8517. (when (= (point) (line-beginning-position))
  8518. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
  8519. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
  8520. (error (user-error "Cannot move to previous table cell")))
  8521. (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0)))
  8522. ;; This may have dropped point on the hline.
  8523. (when (markdown-table-hline-at-point-p)
  8524. (markdown-table-backward-cell)))
  8525. (defun markdown-table-transpose ()
  8526. "Transpose table at point.
  8527. Horizontal separator lines will be eliminated."
  8528. (interactive)
  8529. (unless (markdown-table-at-point-p)
  8530. (user-error "Not at a table"))
  8531. (let* ((table (buffer-substring-no-properties
  8532. (markdown-table-begin) (markdown-table-end)))
  8533. ;; Convert table to Lisp structure
  8534. (table (delq nil
  8535. (mapcar
  8536. (lambda (x)
  8537. (unless (string-match-p
  8538. markdown-table-hline-regexp x)
  8539. (markdown--table-line-to-columns x)))
  8540. (markdown--split-string table "[ \t]*\n[ \t]*"))))
  8541. (dline_old (markdown-table-get-dline))
  8542. (col_old (markdown-table-get-column))
  8543. (contents (mapcar (lambda (_)
  8544. (let ((tp table))
  8545. (mapcar
  8546. (lambda (_)
  8547. (prog1
  8548. (pop (car tp))
  8549. (setq tp (cdr tp))))
  8550. table)))
  8551. (car table))))
  8552. (goto-char (markdown-table-begin))
  8553. (save-excursion
  8554. (re-search-forward "|") (backward-char)
  8555. (delete-region (point) (markdown-table-end))
  8556. (insert (mapconcat
  8557. (lambda(x)
  8558. (concat "| " (mapconcat 'identity x " | " ) " |\n"))
  8559. contents "")))
  8560. (markdown-table-goto-dline col_old)
  8561. (markdown-table-goto-column dline_old))
  8562. (markdown-table-align))
  8563. (defun markdown-table-sort-lines (&optional sorting-type)
  8564. "Sort table lines according to the column at point.
  8565. The position of point indicates the column to be used for
  8566. sorting, and the range of lines is the range between the nearest
  8567. horizontal separator lines, or the entire table of no such lines
  8568. exist. If point is before the first column, user will be prompted
  8569. for the sorting column. If there is an active region, the mark
  8570. specifies the first line and the sorting column, while point
  8571. should be in the last line to be included into the sorting.
  8572. The command then prompts for the sorting type which can be
  8573. alphabetically or numerically. Sorting in reverse order is also
  8574. possible.
  8575. If SORTING-TYPE is specified when this function is called from a
  8576. Lisp program, no prompting will take place. SORTING-TYPE must be
  8577. a character, any of (?a ?A ?n ?N) where the capital letters
  8578. indicate that sorting should be done in reverse order."
  8579. (interactive)
  8580. (unless (markdown-table-at-point-p)
  8581. (user-error "Not at a table"))
  8582. ;; Set sorting type and column used for sorting
  8583. (let ((column (let ((c (markdown-table-get-column)))
  8584. (cond ((> c 0) c)
  8585. ((called-interactively-p 'any)
  8586. (read-number "Use column N for sorting: "))
  8587. (t 1))))
  8588. (sorting-type
  8589. (or sorting-type
  8590. (read-char-exclusive
  8591. "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))
  8592. (save-restriction
  8593. ;; Narrow buffer to appropriate sorting area
  8594. (if (region-active-p)
  8595. (narrow-to-region
  8596. (save-excursion
  8597. (progn
  8598. (goto-char (region-beginning)) (line-beginning-position)))
  8599. (save-excursion
  8600. (progn
  8601. (goto-char (region-end)) (line-end-position))))
  8602. (let ((start (markdown-table-begin))
  8603. (end (markdown-table-end)))
  8604. (narrow-to-region
  8605. (save-excursion
  8606. (if (re-search-backward
  8607. markdown-table-hline-regexp start t)
  8608. (line-beginning-position 2)
  8609. start))
  8610. (if (save-excursion (re-search-forward
  8611. markdown-table-hline-regexp end t))
  8612. (match-beginning 0)
  8613. end))))
  8614. ;; Determine arguments for `sort-subr'
  8615. (let* ((extract-key-from-cell
  8616. (cl-case sorting-type
  8617. ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity)
  8618. ((?n ?N) #'string-to-number)
  8619. (t (user-error "Invalid sorting type: %c" sorting-type))))
  8620. (predicate
  8621. (cl-case sorting-type
  8622. ((?n ?N) #'<)
  8623. ((?a ?A) #'string<))))
  8624. ;; Sort selected area
  8625. (goto-char (point-min))
  8626. (sort-subr (memq sorting-type '(?A ?N))
  8627. (lambda ()
  8628. (forward-line)
  8629. (while (and (not (eobp))
  8630. (not (looking-at
  8631. markdown-table-dline-regexp)))
  8632. (forward-line)))
  8633. #'end-of-line
  8634. (lambda ()
  8635. (funcall extract-key-from-cell
  8636. (markdown-table-get-cell column)))
  8637. nil
  8638. predicate)
  8639. (goto-char (point-min))))))
  8640. (defun markdown-table-convert-region (begin end &optional separator)
  8641. "Convert region from BEGIN to END to table with SEPARATOR.
  8642. If every line contains at least one TAB character, the function
  8643. assumes that the material is tab separated (TSV). If every line
  8644. contains a comma, comma-separated values (CSV) are assumed. If
  8645. not, lines are split at whitespace into cells.
  8646. You can use a prefix argument to force a specific separator:
  8647. \\[universal-argument] once forces CSV, \\[universal-argument]
  8648. twice forces TAB, and \\[universal-argument] three times will
  8649. prompt for a regular expression to match the separator, and a
  8650. numeric argument N indicates that at least N consecutive
  8651. spaces, or alternatively a TAB should be used as the separator."
  8652. (interactive "r\nP")
  8653. (let* ((begin (min begin end)) (end (max begin end)) re)
  8654. (goto-char begin) (beginning-of-line 1)
  8655. (setq begin (point-marker))
  8656. (goto-char end)
  8657. (if (bolp) (backward-char 1) (end-of-line 1))
  8658. (setq end (point-marker))
  8659. (when (equal separator '(64))
  8660. (setq separator (read-regexp "Regexp for cell separator: ")))
  8661. (unless separator
  8662. ;; Get the right cell separator
  8663. (goto-char begin)
  8664. (setq separator
  8665. (cond
  8666. ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
  8667. ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
  8668. (t 1))))
  8669. (goto-char begin)
  8670. (if (equal separator '(4))
  8671. ;; Parse CSV
  8672. (while (< (point) end)
  8673. (cond
  8674. ((looking-at "^") (insert "| "))
  8675. ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
  8676. ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
  8677. (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
  8678. ((looking-at "[^,\n]+") (goto-char (match-end 0)))
  8679. ((looking-at "[ \t]*,") (replace-match " | "))
  8680. (t (beginning-of-line 2))))
  8681. (setq re
  8682. (cond
  8683. ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
  8684. ((equal separator '(16)) "^\\|\t")
  8685. ((integerp separator)
  8686. (if (< separator 1)
  8687. (user-error "Cell separator must contain one or more spaces")
  8688. (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
  8689. ((stringp separator) (format "^ *\\|%s" separator))
  8690. (t (error "Invalid cell separator"))))
  8691. (while (re-search-forward re end t) (replace-match "| " t t)))
  8692. (goto-char begin)
  8693. (markdown-table-align)))
  8694. (defun markdown-insert-table (&optional rows columns align)
  8695. "Insert an empty pipe table.
  8696. Optional arguments ROWS, COLUMNS, and ALIGN specify number of
  8697. rows and columns and the column alignment."
  8698. (interactive)
  8699. (let* ((rows (or rows (string-to-number (read-string "Row size: "))))
  8700. (columns (or columns (string-to-number (read-string "Column size: "))))
  8701. (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): ")))
  8702. (align (cond ((equal align "l") ":--")
  8703. ((equal align "r") "--:")
  8704. ((equal align "c") ":-:")
  8705. (t "---")))
  8706. (pos (point))
  8707. (indent (make-string (current-column) ?\ ))
  8708. (line (concat
  8709. (apply 'concat indent "|"
  8710. (make-list columns " |")) "\n"))
  8711. (hline (apply 'concat indent "|"
  8712. (make-list columns (concat align "|")))))
  8713. (if (string-match
  8714. "^[ \t]*$" (buffer-substring-no-properties
  8715. (point-at-bol) (point)))
  8716. (beginning-of-line 1)
  8717. (newline))
  8718. (dotimes (_ rows) (insert line))
  8719. (goto-char pos)
  8720. (if (> rows 1)
  8721. (progn
  8722. (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos)))
  8723. (markdown-table-forward-cell)))
  8724. ;;; ElDoc Support =============================================================
  8725. (defun markdown-eldoc-function ()
  8726. "Return a helpful string when appropriate based on context.
  8727. * Report URL when point is at a hidden URL.
  8728. * Report language name when point is a code block with hidden markup."
  8729. (cond
  8730. ;; Hidden URL or reference for inline link
  8731. ((and (or (thing-at-point-looking-at markdown-regex-link-inline)
  8732. (thing-at-point-looking-at markdown-regex-link-reference))
  8733. (or markdown-hide-urls markdown-hide-markup))
  8734. (let* ((imagep (string-equal (match-string 1) "!"))
  8735. (edit-keys (markdown--substitute-command-keys
  8736. (if imagep
  8737. "\\[markdown-insert-image]"
  8738. "\\[markdown-insert-link]")))
  8739. (edit-str (propertize edit-keys 'face 'font-lock-constant-face))
  8740. (referencep (string-equal (match-string 5) "["))
  8741. (object (if referencep "reference" "URL")))
  8742. (format "Hidden %s (%s to edit): %s" object edit-str
  8743. (if referencep
  8744. (concat
  8745. (propertize "[" 'face 'markdown-markup-face)
  8746. (propertize (match-string-no-properties 6)
  8747. 'face 'markdown-reference-face)
  8748. (propertize "]" 'face 'markdown-markup-face))
  8749. (propertize (match-string-no-properties 6)
  8750. 'face 'markdown-url-face)))))
  8751. ;; Hidden language name for fenced code blocks
  8752. ((and (markdown-code-block-at-point-p)
  8753. (not (get-text-property (point) 'markdown-pre))
  8754. markdown-hide-markup)
  8755. (let ((lang (save-excursion (markdown-code-block-lang))))
  8756. (unless lang (setq lang "[unspecified]"))
  8757. (format "Hidden code block language: %s (%s to toggle markup)"
  8758. (propertize lang 'face 'markdown-language-keyword-face)
  8759. (markdown--substitute-command-keys
  8760. "\\[markdown-toggle-markup-hiding]"))))))
  8761. ;;; Mode Definition ==========================================================
  8762. (defun markdown-show-version ()
  8763. "Show the version number in the minibuffer."
  8764. (interactive)
  8765. (message "markdown-mode, version %s" markdown-mode-version))
  8766. (defun markdown-mode-info ()
  8767. "Open the `markdown-mode' homepage."
  8768. (interactive)
  8769. (browse-url "https://jblevins.org/projects/markdown-mode/"))
  8770. ;;;###autoload
  8771. (define-derived-mode markdown-mode text-mode "Markdown"
  8772. "Major mode for editing Markdown files."
  8773. ;; Natural Markdown tab width
  8774. (setq tab-width 4)
  8775. ;; Comments
  8776. (setq-local comment-start "<!-- ")
  8777. (setq-local comment-end " -->")
  8778. (setq-local comment-start-skip "<!--[ \t]*")
  8779. (setq-local comment-column 0)
  8780. (setq-local comment-auto-fill-only-comments nil)
  8781. (setq-local comment-use-syntax t)
  8782. ;; Sentence
  8783. (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*")
  8784. ;; Syntax
  8785. (add-hook 'syntax-propertize-extend-region-functions
  8786. #'markdown-syntax-propertize-extend-region)
  8787. (add-hook 'jit-lock-after-change-extend-region-functions
  8788. #'markdown-font-lock-extend-region-function t t)
  8789. (setq-local syntax-propertize-function #'markdown-syntax-propertize)
  8790. (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
  8791. ;; Font lock.
  8792. (setq font-lock-defaults
  8793. '(markdown-mode-font-lock-keywords
  8794. nil nil nil nil
  8795. (font-lock-multiline . t)
  8796. (font-lock-syntactic-face-function . markdown-syntactic-face)
  8797. (font-lock-extra-managed-props
  8798. . (composition display invisible rear-nonsticky
  8799. keymap help-echo mouse-face))))
  8800. (if markdown-hide-markup
  8801. (add-to-invisibility-spec 'markdown-markup)
  8802. (remove-from-invisibility-spec 'markdown-markup))
  8803. ;; Wiki links
  8804. (markdown-setup-wiki-link-hooks)
  8805. ;; Math mode
  8806. (when markdown-enable-math (markdown-toggle-math t))
  8807. ;; Add a buffer-local hook to reload after file-local variables are read
  8808. (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t)
  8809. ;; For imenu support
  8810. (setq imenu-create-index-function
  8811. (if markdown-nested-imenu-heading-index
  8812. #'markdown-imenu-create-nested-index
  8813. #'markdown-imenu-create-flat-index))
  8814. ;; Defun movement
  8815. (setq-local beginning-of-defun-function #'markdown-beginning-of-defun)
  8816. (setq-local end-of-defun-function #'markdown-end-of-defun)
  8817. ;; Paragraph filling
  8818. (setq-local fill-paragraph-function #'markdown-fill-paragraph)
  8819. (setq-local paragraph-start
  8820. ;; Should match start of lines that start or separate paragraphs
  8821. (mapconcat #'identity
  8822. '(
  8823. "\f" ; starts with a literal line-feed
  8824. "[ \t\f]*$" ; space-only line
  8825. "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
  8826. "[ \t]*[*+-][ \t]+" ; unordered list item
  8827. "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
  8828. "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
  8829. "[ \t]*:[ \t]+" ; definition
  8830. "^|" ; table or Pandoc line block
  8831. )
  8832. "\\|"))
  8833. (setq-local paragraph-separate
  8834. ;; Should match lines that separate paragraphs without being
  8835. ;; part of any paragraph:
  8836. (mapconcat #'identity
  8837. '("[ \t\f]*$" ; space-only line
  8838. "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
  8839. ;; The following is not ideal, but the Fill customization
  8840. ;; options really only handle paragraph-starting prefixes,
  8841. ;; not paragraph-ending suffixes:
  8842. ".* $" ; line ending in two spaces
  8843. "^#+"
  8844. "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
  8845. "\\|"))
  8846. (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'")
  8847. (setq-local adaptive-fill-regexp "\\s-*")
  8848. (setq-local adaptive-fill-function #'markdown-adaptive-fill-function)
  8849. (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph)
  8850. ;; Outline mode
  8851. (setq-local outline-regexp markdown-regex-header)
  8852. (setq-local outline-level #'markdown-outline-level)
  8853. ;; Cause use of ellipses for invisible text.
  8854. (add-to-invisibility-spec '(outline . t))
  8855. ;; ElDoc support
  8856. (add-function :before-until (local 'eldoc-documentation-function)
  8857. #'markdown-eldoc-function)
  8858. ;; Inhibiting line-breaking:
  8859. ;; Separating out each condition into a separate function so that users can
  8860. ;; override if desired (with remove-hook)
  8861. (add-hook 'fill-nobreak-predicate
  8862. #'markdown-line-is-reference-definition-p nil t)
  8863. (add-hook 'fill-nobreak-predicate
  8864. #'markdown-pipe-at-bol-p nil t)
  8865. ;; Indentation
  8866. (setq-local indent-line-function markdown-indent-function)
  8867. (setq-local indent-region-function #'markdown--indent-region)
  8868. ;; Flyspell
  8869. (setq-local flyspell-generic-check-word-predicate
  8870. #'markdown-flyspell-check-word-p)
  8871. ;; Electric quoting
  8872. (add-hook 'electric-quote-inhibit-functions
  8873. #'markdown--inhibit-electric-quote nil :local)
  8874. ;; Make checkboxes buttons
  8875. (when markdown-make-gfm-checkboxes-buttons
  8876. (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
  8877. (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t)
  8878. (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t))
  8879. ;; edit-indirect
  8880. (add-hook 'edit-indirect-after-commit-functions
  8881. #'markdown--edit-indirect-after-commit-function
  8882. nil 'local)
  8883. ;; Marginalized headings
  8884. (when markdown-marginalize-headers
  8885. (add-hook 'window-configuration-change-hook
  8886. #'markdown-marginalize-update-current nil t))
  8887. ;; add live preview export hook
  8888. (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t)
  8889. (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t))
  8890. ;;;###autoload
  8891. (add-to-list 'auto-mode-alist
  8892. '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode))
  8893. ;;; GitHub Flavored Markdown Mode ============================================
  8894. (defun gfm--electric-pair-fence-code-block ()
  8895. (when (and electric-pair-mode
  8896. (not markdown-gfm-use-electric-backquote)
  8897. (eql last-command-event ?`)
  8898. (let ((count 0))
  8899. (while (eql (char-before (- (point) count)) ?`)
  8900. (cl-incf count))
  8901. (= count 3))
  8902. (eql (char-after) ?`))
  8903. (save-excursion (insert (make-string 2 ?`)))))
  8904. (defvar gfm-mode-hook nil
  8905. "Hook run when entering GFM mode.")
  8906. ;;;###autoload
  8907. (define-derived-mode gfm-mode markdown-mode "GFM"
  8908. "Major mode for editing GitHub Flavored Markdown files."
  8909. (setq markdown-link-space-sub-char "-")
  8910. (setq markdown-wiki-link-search-subdirectories t)
  8911. (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p)
  8912. (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t)
  8913. (markdown-gfm-parse-buffer-for-languages))
  8914. ;;; Viewing modes =============================================================
  8915. (defcustom markdown-hide-markup-in-view-modes t
  8916. "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
  8917. :group 'markdown
  8918. :type 'boolean
  8919. :safe 'booleanp)
  8920. (defvar markdown-view-mode-map
  8921. (let ((map (make-sparse-keymap)))
  8922. (define-key map (kbd "p") #'markdown-outline-previous)
  8923. (define-key map (kbd "n") #'markdown-outline-next)
  8924. (define-key map (kbd "f") #'markdown-outline-next-same-level)
  8925. (define-key map (kbd "b") #'markdown-outline-previous-same-level)
  8926. (define-key map (kbd "u") #'markdown-outline-up)
  8927. (define-key map (kbd "DEL") #'scroll-down-command)
  8928. (define-key map (kbd "SPC") #'scroll-up-command)
  8929. (define-key map (kbd ">") #'end-of-buffer)
  8930. (define-key map (kbd "<") #'beginning-of-buffer)
  8931. (define-key map (kbd "q") #'kill-this-buffer)
  8932. (define-key map (kbd "?") #'describe-mode)
  8933. map)
  8934. "Keymap for `markdown-view-mode'.")
  8935. (defun markdown--filter-visible (beg end &optional delete)
  8936. (let ((result "")
  8937. (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face)))
  8938. (while (< beg end)
  8939. (when (markdown--face-p beg invisible-faces)
  8940. (cl-incf beg)
  8941. (while (and (markdown--face-p beg invisible-faces) (< beg end))
  8942. (cl-incf beg)))
  8943. (let ((next (next-single-char-property-change beg 'invisible)))
  8944. (unless (get-char-property beg 'invisible)
  8945. (setq result (concat result (buffer-substring beg (min end next)))))
  8946. (setq beg next)))
  8947. (prog1 result
  8948. (when delete
  8949. (let ((inhibit-read-only t))
  8950. (delete-region beg end))))))
  8951. ;;;###autoload
  8952. (define-derived-mode markdown-view-mode markdown-mode "Markdown-View"
  8953. "Major mode for viewing Markdown content."
  8954. (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
  8955. (add-to-invisibility-spec 'markdown-markup)
  8956. (setq-local filter-buffer-substring-function #'markdown--filter-visible)
  8957. (read-only-mode 1))
  8958. (defvar gfm-view-mode-map
  8959. markdown-view-mode-map
  8960. "Keymap for `gfm-view-mode'.")
  8961. ;;;###autoload
  8962. (define-derived-mode gfm-view-mode gfm-mode "GFM-View"
  8963. "Major mode for viewing GitHub Flavored Markdown content."
  8964. (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
  8965. (setq-local markdown-fontify-code-blocks-natively t)
  8966. (setq-local filter-buffer-substring-function #'markdown--filter-visible)
  8967. (add-to-invisibility-spec 'markdown-markup)
  8968. (read-only-mode 1))
  8969. ;;; Live Preview Mode ========================================================
  8970. ;;;###autoload
  8971. (define-minor-mode markdown-live-preview-mode
  8972. "Toggle native previewing on save for a specific markdown file."
  8973. :lighter " MD-Preview"
  8974. (if markdown-live-preview-mode
  8975. (if (markdown-live-preview-get-filename)
  8976. (markdown-display-buffer-other-window (markdown-live-preview-export))
  8977. (markdown-live-preview-mode -1)
  8978. (user-error "Buffer %s does not visit a file" (current-buffer)))
  8979. (markdown-live-preview-remove)))
  8980. (provide 'markdown-mode)
  8981. ;; Local Variables:
  8982. ;; indent-tabs-mode: nil
  8983. ;; coding: utf-8
  8984. ;; End:
  8985. ;;; markdown-mode.el ends here