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.

9683 lines
398 KiB

  1. ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2007-2020 Jason R. Blevins and markdown-mode
  3. ;; contributors (see the commit log for details).
  4. ;; Author: Jason R. Blevins <jblevins@xbeta.org>
  5. ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org>
  6. ;; Created: May 24, 2007
  7. ;; Version: 2.5-dev
  8. ;; Package-Version: 20201115.635
  9. ;; Package-Commit: dcad5572a30fce51b97963d3c869cce227c223a1
  10. ;; Package-Requires: ((emacs "25.1"))
  11. ;; Keywords: Markdown, GitHub Flavored Markdown, itex
  12. ;; URL: https://jblevins.org/projects/markdown-mode/
  13. ;; This file is not part of GNU Emacs.
  14. ;; This program is free software; you can redistribute it and/or modify
  15. ;; it under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation, either version 3 of the License, or
  17. ;; (at your option) any later version.
  18. ;; This program is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. ;; GNU General Public License for more details.
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  24. ;;; Commentary:
  25. ;; See the README.md file for details.
  26. ;;; Code:
  27. (require 'easymenu)
  28. (require 'outline)
  29. (require 'thingatpt)
  30. (require 'cl-lib)
  31. (require 'url-parse)
  32. (require 'button)
  33. (require 'color)
  34. (require 'rx)
  35. (require 'subr-x)
  36. (defvar jit-lock-start)
  37. (defvar jit-lock-end)
  38. (defvar flyspell-generic-check-word-predicate)
  39. (defvar electric-pair-pairs)
  40. ;;; Constants =================================================================
  41. (defconst markdown-mode-version "2.5-dev"
  42. "Markdown mode version number.")
  43. (defconst markdown-output-buffer-name "*markdown-output*"
  44. "Name of temporary buffer for markdown command output.")
  45. ;;; Global Variables ==========================================================
  46. (defvar markdown-reference-label-history nil
  47. "History of used reference labels.")
  48. (defvar markdown-live-preview-mode nil
  49. "Sentinel variable for command `markdown-live-preview-mode'.")
  50. (defvar markdown-gfm-language-history nil
  51. "History list of languages used in the current buffer in GFM code blocks.")
  52. ;;; Customizable Variables ====================================================
  53. (defvar markdown-mode-hook nil
  54. "Hook run when entering Markdown mode.")
  55. (defvar markdown-before-export-hook nil
  56. "Hook run before running Markdown to export XHTML output.
  57. The hook may modify the buffer, which will be restored to it's
  58. original state after exporting is complete.")
  59. (defvar markdown-after-export-hook nil
  60. "Hook run after XHTML output has been saved.
  61. Any changes to the output buffer made by this hook will be saved.")
  62. (defgroup markdown nil
  63. "Major mode for editing text files in Markdown format."
  64. :prefix "markdown-"
  65. :group 'text
  66. :link '(url-link "https://jblevins.org/projects/markdown-mode/"))
  67. (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc")
  68. when (executable-find cmd)
  69. return (file-name-nondirectory it))))
  70. (or command "markdown"))
  71. "Command to run markdown."
  72. :group 'markdown
  73. :type '(choice (string :tag "Shell command") (repeat (string)) function))
  74. (defcustom markdown-command-needs-filename nil
  75. "Set to non-nil if `markdown-command' does not accept input from stdin.
  76. Instead, it will be passed a filename as the final command line
  77. option. As a result, you will only be able to run Markdown from
  78. buffers which are visiting a file."
  79. :group 'markdown
  80. :type 'boolean)
  81. (defcustom markdown-open-command nil
  82. "Command used for opening Markdown files directly.
  83. For example, a standalone Markdown previewer. This command will
  84. be called with a single argument: the filename of the current
  85. buffer. It can also be a function, which will be called without
  86. arguments."
  87. :group 'markdown
  88. :type '(choice file function (const :tag "None" nil)))
  89. (defcustom markdown-open-image-command nil
  90. "Command used for opening image files directly at `markdown-follow-link-at-point'."
  91. :group 'markdown
  92. :type '(choice file function (const :tag "None" nil)))
  93. (defcustom markdown-hr-strings
  94. '("-------------------------------------------------------------------------------"
  95. "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
  96. "---------------------------------------"
  97. "* * * * * * * * * * * * * * * * * * * *"
  98. "---------"
  99. "* * * * *")
  100. "Strings to use when inserting horizontal rules.
  101. The first string in the list will be the default when inserting a
  102. horizontal rule. Strings should be listed in decreasing order of
  103. prominence (as in headings from level one to six) for use with
  104. promotion and demotion functions."
  105. :group 'markdown
  106. :type '(repeat string))
  107. (defcustom markdown-bold-underscore nil
  108. "Use two underscores when inserting bold text instead of two asterisks."
  109. :group 'markdown
  110. :type 'boolean)
  111. (defcustom markdown-italic-underscore nil
  112. "Use underscores when inserting italic text instead of asterisks."
  113. :group 'markdown
  114. :type 'boolean)
  115. (defcustom markdown-marginalize-headers nil
  116. "When non-nil, put opening atx header markup in a left margin.
  117. This setting goes well with `markdown-asymmetric-header'. But
  118. sadly it conflicts with `linum-mode' since they both use the
  119. same margin."
  120. :group 'markdown
  121. :type 'boolean
  122. :safe 'booleanp
  123. :package-version '(markdown-mode . "2.4"))
  124. (defcustom markdown-marginalize-headers-margin-width 6
  125. "Character width of margin used for marginalized headers.
  126. The default value is based on there being six heading levels
  127. defined by Markdown and HTML. Increasing this produces extra
  128. whitespace on the left. Decreasing it may be preferred when
  129. fewer than six nested heading levels are used."
  130. :group 'markdown
  131. :type 'natnump
  132. :safe 'natnump
  133. :package-version '(markdown-mode . "2.4"))
  134. (defcustom markdown-asymmetric-header nil
  135. "Determines if atx header style will be asymmetric.
  136. Set to a non-nil value to use asymmetric header styling, placing
  137. header markup only at the beginning of the line. By default,
  138. balanced markup will be inserted at the beginning and end of the
  139. line around the header title."
  140. :group 'markdown
  141. :type 'boolean)
  142. (defcustom markdown-indent-function 'markdown-indent-line
  143. "Function to use to indent."
  144. :group 'markdown
  145. :type 'function)
  146. (defcustom markdown-indent-on-enter t
  147. "Determines indentation behavior when pressing \\[newline].
  148. Possible settings are nil, t, and 'indent-and-new-item.
  149. When non-nil, pressing \\[newline] will call `newline-and-indent'
  150. to indent the following line according to the context using
  151. `markdown-indent-function'. In this case, note that
  152. \\[electric-newline-and-maybe-indent] can still be used to insert
  153. a newline without indentation.
  154. When set to 'indent-and-new-item and the point is in a list item
  155. when \\[newline] is pressed, the list will be continued on the next
  156. line, where a new item will be inserted.
  157. When set to nil, simply call `newline' as usual. In this case,
  158. you can still indent lines using \\[markdown-cycle] and continue
  159. lists with \\[markdown-insert-list-item].
  160. Note that this assumes the variable `electric-indent-mode' is
  161. non-nil (enabled). When it is *disabled*, the behavior of
  162. \\[newline] and `\\[electric-newline-and-maybe-indent]' are
  163. reversed."
  164. :group 'markdown
  165. :type '(choice (const :tag "Don't automatically indent" nil)
  166. (const :tag "Automatically indent" t)
  167. (const :tag "Automatically indent and insert new list items" indent-and-new-item)))
  168. (defcustom markdown-enable-wiki-links nil
  169. "Syntax highlighting for wiki links.
  170. Set this to a non-nil value to turn on wiki link support by default.
  171. Support can be toggled later using the `markdown-toggle-wiki-links'
  172. function or \\[markdown-toggle-wiki-links]."
  173. :group 'markdown
  174. :type 'boolean
  175. :safe 'booleanp
  176. :package-version '(markdown-mode . "2.2"))
  177. (defcustom markdown-wiki-link-alias-first t
  178. "When non-nil, treat aliased wiki links like [[alias text|PageName]].
  179. Otherwise, they will be treated as [[PageName|alias text]]."
  180. :group 'markdown
  181. :type 'boolean
  182. :safe 'booleanp)
  183. (defcustom markdown-wiki-link-search-subdirectories nil
  184. "When non-nil, search for wiki link targets in subdirectories.
  185. This is the default search behavior for GitHub and is
  186. automatically set to t in `gfm-mode'."
  187. :group 'markdown
  188. :type 'boolean
  189. :safe 'booleanp
  190. :package-version '(markdown-mode . "2.2"))
  191. (defcustom markdown-wiki-link-search-parent-directories nil
  192. "When non-nil, search for wiki link targets in parent directories.
  193. This is the default search behavior of Ikiwiki."
  194. :group 'markdown
  195. :type 'boolean
  196. :safe 'booleanp
  197. :package-version '(markdown-mode . "2.2"))
  198. (defcustom markdown-wiki-link-fontify-missing nil
  199. "When non-nil, change wiki link face according to existence of target files.
  200. This is expensive because it requires checking for the file each time the buffer
  201. changes or the user switches windows. It is disabled by default because it may
  202. cause lag when typing on slower machines."
  203. :group 'markdown
  204. :type 'boolean
  205. :safe 'booleanp
  206. :package-version '(markdown-mode . "2.2"))
  207. (defcustom markdown-uri-types
  208. '("acap" "cid" "data" "dav" "fax" "file" "ftp"
  209. "gopher" "http" "https" "imap" "ldap" "mailto"
  210. "mid" "message" "modem" "news" "nfs" "nntp"
  211. "pop" "prospero" "rtsp" "service" "sip" "tel"
  212. "telnet" "tip" "urn" "vemmi" "wais")
  213. "Link types for syntax highlighting of URIs."
  214. :group 'markdown
  215. :type '(repeat (string :tag "URI scheme")))
  216. (defcustom markdown-url-compose-char
  217. '(?∞ ?… ?⋯ ?# ?★ ?⚓)
  218. "Placeholder character for hidden URLs.
  219. This may be a single character or a list of characters. In case
  220. of a list, the first one that satisfies `char-displayable-p' will
  221. be used."
  222. :type '(choice
  223. (character :tag "Single URL replacement character")
  224. (repeat :tag "List of possible URL replacement characters"
  225. character))
  226. :package-version '(markdown-mode . "2.3"))
  227. (defcustom markdown-blockquote-display-char
  228. '("" "" ">")
  229. "String to display when hiding blockquote markup.
  230. This may be a single string or a list of string. In case of a
  231. list, the first one that satisfies `char-displayable-p' will be
  232. used."
  233. :type 'string
  234. :type '(choice
  235. (string :tag "Single blockquote display string")
  236. (repeat :tag "List of possible blockquote display strings" string))
  237. :package-version '(markdown-mode . "2.3"))
  238. (defcustom markdown-hr-display-char
  239. '(?─ ?━ ?-)
  240. "Character for hiding horizontal rule markup.
  241. This may be a single character or a list of characters. In case
  242. of a list, the first one that satisfies `char-displayable-p' will
  243. be used."
  244. :group 'markdown
  245. :type '(choice
  246. (character :tag "Single HR display character")
  247. (repeat :tag "List of possible HR display characters" character))
  248. :package-version '(markdown-mode . "2.3"))
  249. (defcustom markdown-definition-display-char
  250. '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:)
  251. "Character for replacing definition list markup.
  252. This may be a single character or a list of characters. In case
  253. of a list, the first one that satisfies `char-displayable-p' will
  254. be used."
  255. :type '(choice
  256. (character :tag "Single definition list character")
  257. (repeat :tag "List of possible definition list characters" character))
  258. :package-version '(markdown-mode . "2.3"))
  259. (defcustom markdown-enable-math nil
  260. "Syntax highlighting for inline LaTeX and itex expressions.
  261. Set this to a non-nil value to turn on math support by default.
  262. Math support can be enabled, disabled, or toggled later using
  263. `markdown-toggle-math' or \\[markdown-toggle-math]."
  264. :group 'markdown
  265. :type 'boolean
  266. :safe 'booleanp)
  267. (make-variable-buffer-local 'markdown-enable-math)
  268. (defcustom markdown-enable-html t
  269. "Enable font-lock support for HTML tags and attributes."
  270. :group 'markdown
  271. :type 'boolean
  272. :safe 'booleanp
  273. :package-version '(markdown-mode . "2.4"))
  274. (defcustom markdown-css-paths nil
  275. "List of URLs of CSS files to link to in the output XHTML."
  276. :group 'markdown
  277. :type '(repeat (string :tag "CSS File Path")))
  278. (defcustom markdown-content-type "text/html"
  279. "Content type string for the http-equiv header in XHTML output.
  280. When set to an empty string, this attribute is omitted. Defaults to
  281. `text/html'."
  282. :group 'markdown
  283. :type 'string)
  284. (defcustom markdown-coding-system nil
  285. "Character set string for the http-equiv header in XHTML output.
  286. Defaults to `buffer-file-coding-system' (and falling back to
  287. `utf-8' when not available). Common settings are `iso-8859-1'
  288. and `iso-latin-1'. Use `list-coding-systems' for more choices."
  289. :group 'markdown
  290. :type 'coding-system)
  291. (defcustom markdown-export-kill-buffer t
  292. "Kill output buffer after HTML export.
  293. When non-nil, kill the HTML output buffer after
  294. exporting with `markdown-export'."
  295. :group 'markdown
  296. :type 'boolean
  297. :safe 'booleanp
  298. :package-version '(markdown-mode . "2.4"))
  299. (defcustom markdown-xhtml-header-content ""
  300. "Additional content to include in the XHTML <head> block."
  301. :group 'markdown
  302. :type 'string)
  303. (defcustom markdown-xhtml-body-preamble ""
  304. "Content to include in the XHTML <body> block, before the output."
  305. :group 'markdown
  306. :type 'string
  307. :safe 'stringp
  308. :package-version '(markdown-mode . "2.4"))
  309. (defcustom markdown-xhtml-body-epilogue ""
  310. "Content to include in the XHTML <body> block, after the output."
  311. :group 'markdown
  312. :type 'string
  313. :safe 'stringp
  314. :package-version '(markdown-mode . "2.4"))
  315. (defcustom markdown-xhtml-standalone-regexp
  316. "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)"
  317. "Regexp indicating whether `markdown-command' output is standalone XHTML."
  318. :group 'markdown
  319. :type 'regexp)
  320. (defcustom markdown-link-space-sub-char "_"
  321. "Character to use instead of spaces when mapping wiki links to filenames."
  322. :group 'markdown
  323. :type 'string)
  324. (defcustom markdown-reference-location 'header
  325. "Position where new reference definitions are inserted in the document."
  326. :group 'markdown
  327. :type '(choice (const :tag "At the end of the document" end)
  328. (const :tag "Immediately after the current block" immediately)
  329. (const :tag "At the end of the subtree" subtree)
  330. (const :tag "Before next header" header)))
  331. (defcustom markdown-footnote-location 'end
  332. "Position where new footnotes are inserted in the document."
  333. :group 'markdown
  334. :type '(choice (const :tag "At the end of the document" end)
  335. (const :tag "Immediately after the current block" immediately)
  336. (const :tag "At the end of the subtree" subtree)
  337. (const :tag "Before next header" header)))
  338. (defcustom markdown-footnote-display '((raise 0.2) (height 0.8))
  339. "Display specification for footnote markers and inline footnotes.
  340. By default, footnote text is reduced in size and raised. Set to
  341. nil to disable this."
  342. :group 'markdown
  343. :type '(choice (sexp :tag "Display specification")
  344. (const :tag "Don't set display property" nil))
  345. :package-version '(markdown-mode . "2.4"))
  346. (defcustom markdown-sub-superscript-display
  347. '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7)))
  348. "Display specification for subscript and superscripts.
  349. The car is used for subscript, the cdr is used for superscripts."
  350. :group 'markdown
  351. :type '(cons (choice (sexp :tag "Subscript form")
  352. (const :tag "No lowering" nil))
  353. (choice (sexp :tag "Superscript form")
  354. (const :tag "No raising" nil)))
  355. :package-version '(markdown-mode . "2.4"))
  356. (defcustom markdown-unordered-list-item-prefix " * "
  357. "String inserted before unordered list items."
  358. :group 'markdown
  359. :type 'string)
  360. (defcustom markdown-nested-imenu-heading-index t
  361. "Use nested or flat imenu heading index.
  362. A nested index may provide more natural browsing from the menu,
  363. but a flat list may allow for faster keyboard navigation via tab
  364. completion."
  365. :group 'markdown
  366. :type 'boolean
  367. :safe 'booleanp
  368. :package-version '(markdown-mode . "2.2"))
  369. (defcustom markdown-add-footnotes-to-imenu t
  370. "Add footnotes to end of imenu heading index."
  371. :group 'markdown
  372. :type 'boolean
  373. :safe 'booleanp
  374. :package-version '(markdown-mode . "2.4"))
  375. (defcustom markdown-make-gfm-checkboxes-buttons t
  376. "When non-nil, make GFM checkboxes into buttons."
  377. :group 'markdown
  378. :type 'boolean)
  379. (defcustom markdown-use-pandoc-style-yaml-metadata nil
  380. "When non-nil, allow YAML metadata anywhere in the document."
  381. :group 'markdown
  382. :type 'boolean)
  383. (defcustom markdown-split-window-direction 'any
  384. "Preference for splitting windows for static and live preview.
  385. The default value is 'any, which instructs Emacs to use
  386. `split-window-sensibly' to automatically choose how to split
  387. windows based on the values of `split-width-threshold' and
  388. `split-height-threshold' and the available windows. To force
  389. vertically split (left and right) windows, set this to 'vertical
  390. or 'right. To force horizontally split (top and bottom) windows,
  391. set this to 'horizontal or 'below.
  392. If this value is 'any and `display-buffer-alist' is set then
  393. `display-buffer' is used for open buffer function"
  394. :group 'markdown
  395. :type '(choice (const :tag "Automatic" any)
  396. (const :tag "Right (vertical)" right)
  397. (const :tag "Below (horizontal)" below))
  398. :package-version '(markdown-mode . "2.2"))
  399. (defcustom markdown-live-preview-window-function
  400. 'markdown-live-preview-window-eww
  401. "Function to display preview of Markdown output within Emacs.
  402. Function must update the buffer containing the preview and return
  403. the buffer."
  404. :group 'markdown
  405. :type 'function)
  406. (defcustom markdown-live-preview-delete-export 'delete-on-destroy
  407. "Delete exported HTML file when using `markdown-live-preview-export'.
  408. If set to 'delete-on-export, delete on every export. When set to
  409. 'delete-on-destroy delete when quitting from command
  410. `markdown-live-preview-mode'. Never delete if set to nil."
  411. :group 'markdown
  412. :type '(choice
  413. (const :tag "Delete on every export" delete-on-export)
  414. (const :tag "Delete when quitting live preview" delete-on-destroy)
  415. (const :tag "Never delete" nil)))
  416. (defcustom markdown-list-indent-width 4
  417. "Depth of indentation for markdown lists.
  418. Used in `markdown-demote-list-item' and
  419. `markdown-promote-list-item'."
  420. :group 'markdown
  421. :type 'integer)
  422. (defcustom markdown-enable-prefix-prompts t
  423. "Display prompts for certain prefix commands.
  424. Set to nil to disable these prompts."
  425. :group 'markdown
  426. :type 'boolean
  427. :safe 'booleanp
  428. :package-version '(markdown-mode . "2.3"))
  429. (defcustom markdown-gfm-additional-languages nil
  430. "Extra languages made available when inserting GFM code blocks.
  431. Language strings must have be trimmed of whitespace and not
  432. contain any curly braces. They may be of arbitrary
  433. capitalization, though."
  434. :group 'markdown
  435. :type '(repeat (string :validate markdown-validate-language-string)))
  436. (defcustom markdown-gfm-use-electric-backquote t
  437. "Use `markdown-electric-backquote' when backquote is hit three times."
  438. :group 'markdown
  439. :type 'boolean)
  440. (defcustom markdown-gfm-downcase-languages t
  441. "If non-nil, downcase suggested languages.
  442. This applies to insertions done with
  443. `markdown-electric-backquote'."
  444. :group 'markdown
  445. :type 'boolean)
  446. (defcustom markdown-edit-code-block-default-mode 'normal-mode
  447. "Default mode to use for editing code blocks.
  448. This mode is used when automatic detection fails, such as for GFM
  449. code blocks with no language specified."
  450. :group 'markdown
  451. :type '(choice function (const :tag "None" nil))
  452. :package-version '(markdown-mode . "2.4"))
  453. (defcustom markdown-gfm-uppercase-checkbox nil
  454. "If non-nil, use [X] for completed checkboxes, [x] otherwise."
  455. :group 'markdown
  456. :type 'boolean
  457. :safe 'booleanp)
  458. (defcustom markdown-hide-urls nil
  459. "Hide URLs of inline links and reference tags of reference links.
  460. Such URLs will be replaced by a single customizable
  461. character, defined by `markdown-url-compose-char', but are still part
  462. of the buffer. Links can be edited interactively with
  463. \\[markdown-insert-link] or, for example, by deleting the final
  464. parenthesis to remove the invisibility property. You can also
  465. hover your mouse pointer over the link text to see the URL.
  466. Set this to a non-nil value to turn this feature on by default.
  467. You can interactively set the value of this variable by calling
  468. `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding],
  469. or from the menu Markdown > Links & Images menu."
  470. :group 'markdown
  471. :type 'boolean
  472. :safe 'booleanp
  473. :package-version '(markdown-mode . "2.3"))
  474. (make-variable-buffer-local 'markdown-hide-urls)
  475. (defcustom markdown-translate-filename-function #'identity
  476. "Function to use to translate filenames when following links.
  477. \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point]
  478. call this function with the filename as only argument whenever
  479. they encounter a filename (instead of a URL) to be visited and
  480. use its return value instead of the filename in the link. For
  481. example, if absolute filenames are actually relative to a server
  482. root directory, you can set
  483. `markdown-translate-filename-function' to a function that
  484. prepends the root directory to the given filename."
  485. :group 'markdown
  486. :type 'function
  487. :risky t
  488. :package-version '(markdown-mode . "2.4"))
  489. (defcustom markdown-max-image-size nil
  490. "Maximum width and height for displayed inline images.
  491. This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT).
  492. When nil, use the actual size. Otherwise, use ImageMagick to
  493. resize larger images to be of the given maximum dimensions. This
  494. requires Emacs to be built with ImageMagick support."
  495. :group 'markdown
  496. :package-version '(markdown-mode . "2.4")
  497. :type '(choice
  498. (const :tag "Use actual image width" nil)
  499. (cons (choice (sexp :tag "Maximum width in pixels")
  500. (const :tag "No maximum width" nil))
  501. (choice (sexp :tag "Maximum height in pixels")
  502. (const :tag "No maximum height" nil)))))
  503. (defcustom markdown-mouse-follow-link t
  504. "Non-nil means mouse on a link will follow the link.
  505. This variable must be set before loading markdown-mode."
  506. :group 'markdown
  507. :type 'bool
  508. :safe 'booleanp
  509. :package-version '(markdown-mode . "2.5"))
  510. ;;; Markdown-Specific `rx' Macro ==============================================
  511. ;; Based on python-rx from python.el.
  512. (eval-and-compile
  513. (defconst markdown-rx-constituents
  514. `((newline . ,(rx "\n"))
  515. ;; Note: #405 not consider markdown-list-indent-width however this is never used
  516. (indent . ,(rx (or (repeat 4 " ") "\t")))
  517. (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end))))
  518. (numeral . ,(rx (and (one-or-more (any "0-9#")) ".")))
  519. (bullet . ,(rx (any "*+:-")))
  520. (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".")
  521. (any "*+:-"))))
  522. (checkbox . ,(rx "[" (any " xX") "]")))
  523. "Markdown-specific sexps for `markdown-rx'")
  524. (defun markdown-rx-to-string (form &optional no-group)
  525. "Markdown mode specialized `rx-to-string' function.
  526. This variant supports named Markdown expressions in FORM.
  527. NO-GROUP non-nil means don't put shy groups around the result."
  528. (let ((rx-constituents (append markdown-rx-constituents rx-constituents)))
  529. (rx-to-string form no-group)))
  530. (defmacro markdown-rx (&rest regexps)
  531. "Markdown mode specialized rx macro.
  532. This variant of `rx' supports common Markdown named REGEXPS."
  533. (cond ((null regexps)
  534. (error "No regexp"))
  535. ((cdr regexps)
  536. (markdown-rx-to-string `(and ,@regexps) t))
  537. (t
  538. (markdown-rx-to-string (car regexps) t)))))
  539. ;;; Regular Expressions =======================================================
  540. (defconst markdown-regex-comment-start
  541. "<!--"
  542. "Regular expression matches HTML comment opening.")
  543. (defconst markdown-regex-comment-end
  544. "--[ \t]*>"
  545. "Regular expression matches HTML comment closing.")
  546. (defconst markdown-regex-link-inline
  547. "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)"
  548. "Regular expression for a [text](file) or an image link ![text](file).
  549. Group 1 matches the leading exclamation point (optional).
  550. Group 2 matches the opening square bracket.
  551. Group 3 matches the text inside the square brackets.
  552. Group 4 matches the closing square bracket.
  553. Group 5 matches the opening parenthesis.
  554. Group 6 matches the URL.
  555. Group 7 matches the title (optional).
  556. Group 8 matches the closing parenthesis.")
  557. (defconst markdown-regex-link-reference
  558. "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)"
  559. "Regular expression for a reference link [text][id].
  560. Group 1 matches the leading exclamation point (optional).
  561. Group 2 matches the opening square bracket for the link text.
  562. Group 3 matches the text inside the square brackets.
  563. Group 4 matches the closing square bracket for the link text.
  564. Group 5 matches the opening square bracket for the reference label.
  565. Group 6 matches the reference label.
  566. Group 7 matches the closing square bracket for the reference label.")
  567. (defconst markdown-regex-reference-definition
  568. "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)"
  569. "Regular expression for a reference definition.
  570. Group 1 matches the opening square bracket.
  571. Group 2 matches the reference label.
  572. Group 3 matches the closing square bracket.
  573. Group 4 matches the colon.
  574. Group 5 matches the URL.
  575. Group 6 matches the title attribute (optional).")
  576. (defconst markdown-regex-footnote
  577. "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)"
  578. "Regular expression for a footnote marker [^fn].
  579. Group 1 matches the opening square bracket and carat.
  580. Group 2 matches only the label, without the surrounding markup.
  581. Group 3 matches the closing square bracket.")
  582. (defconst markdown-regex-header
  583. "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$"
  584. "Regexp identifying Markdown headings.
  585. Group 1 matches the text of a setext heading.
  586. Group 2 matches the underline of a level-1 setext heading.
  587. Group 3 matches the underline of a level-2 setext heading.
  588. Group 4 matches the opening hash marks of an atx heading and whitespace.
  589. Group 5 matches the text, without surrounding whitespace, of an atx heading.
  590. Group 6 matches the closing whitespace and hash marks of an atx heading.")
  591. (defconst markdown-regex-header-setext
  592. "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$"
  593. "Regular expression for generic setext-style (underline) headers.")
  594. (defconst markdown-regex-header-atx
  595. "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$"
  596. "Regular expression for generic atx-style (hash mark) headers.")
  597. (defconst markdown-regex-hr
  598. (rx line-start
  599. (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* ")))
  600. (and (repeat 3 (and "-" (? " "))) (* (any "- ")))
  601. (and (repeat 3 (and "_" (? " "))) (* (any "_ ")))))
  602. line-end)
  603. "Regular expression for matching Markdown horizontal rules.")
  604. (defconst markdown-regex-code
  605. "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)"
  606. "Regular expression for matching inline code fragments.
  607. Group 1 matches the entire code fragment including the backquotes.
  608. Group 2 matches the opening backquotes.
  609. Group 3 matches the code fragment itself, without backquotes.
  610. Group 4 matches the closing backquotes.
  611. The leading, unnumbered group ensures that the leading backquote
  612. character is not escaped.
  613. The last group, also unnumbered, requires that the character
  614. following the code fragment is not a backquote.
  615. Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines,
  616. but not two newlines in a row.")
  617. (defconst markdown-regex-kbd
  618. "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)"
  619. "Regular expression for matching <kbd> tags.
  620. Groups 1 and 3 match the opening and closing tags.
  621. Group 2 matches the key sequence.")
  622. (defconst markdown-regex-gfm-code-block-open
  623. "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$"
  624. "Regular expression matching opening of GFM code blocks.
  625. Group 1 matches the opening three backquotes and any following whitespace.
  626. Group 2 matches the opening brace (optional) and surrounding whitespace.
  627. Group 3 matches the language identifier (optional).
  628. Group 4 matches the info string (optional).
  629. Group 5 matches the closing brace (optional), whitespace, and newline.
  630. Groups need to agree with `markdown-regex-tilde-fence-begin'.")
  631. (defconst markdown-regex-gfm-code-block-close
  632. "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$"
  633. "Regular expression matching closing of GFM code blocks.
  634. Group 1 matches the closing three backquotes.
  635. Group 2 matches any whitespace and the final newline.")
  636. (defconst markdown-regex-pre
  637. "^\\( \\|\t\\).*$"
  638. "Regular expression for matching preformatted text sections.")
  639. (defconst markdown-regex-list
  640. (markdown-rx line-start
  641. ;; 1. Leading whitespace
  642. (group (* blank))
  643. ;; 2. List marker: a numeral, bullet, or colon
  644. (group list-marker)
  645. ;; 3. Trailing whitespace
  646. (group (+ blank))
  647. ;; 4. Optional checkbox for GFM task list items
  648. (opt (group (and checkbox (* blank)))))
  649. "Regular expression for matching list items.")
  650. (defconst markdown-regex-bold
  651. "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)"
  652. "Regular expression for matching bold text.
  653. Group 1 matches the character before the opening asterisk or
  654. underscore, if any, ensuring that it is not a backslash escape.
  655. Group 2 matches the entire expression, including delimiters.
  656. Groups 3 and 5 matches the opening and closing delimiters.
  657. Group 4 matches the text inside the delimiters.")
  658. (defconst markdown-regex-italic
  659. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)"
  660. "Regular expression for matching italic text.
  661. The leading unnumbered matches the character before the opening
  662. asterisk or underscore, if any, ensuring that it is not a
  663. backslash escape.
  664. Group 1 matches the entire expression, including delimiters.
  665. Groups 2 and 4 matches the opening and closing delimiters.
  666. Group 3 matches the text inside the delimiters.")
  667. (defconst markdown-regex-strike-through
  668. "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)"
  669. "Regular expression for matching strike-through text.
  670. Group 1 matches the character before the opening tilde, if any,
  671. ensuring that it is not a backslash escape.
  672. Group 2 matches the entire expression, including delimiters.
  673. Groups 3 and 5 matches the opening and closing delimiters.
  674. Group 4 matches the text inside the delimiters.")
  675. (defconst markdown-regex-gfm-italic
  676. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)"
  677. "Regular expression for matching italic text in GitHub Flavored Markdown.
  678. Underscores in words are not treated as special.
  679. Group 1 matches the entire expression, including delimiters.
  680. Groups 2 and 4 matches the opening and closing delimiters.
  681. Group 3 matches the text inside the delimiters.")
  682. (defconst markdown-regex-blockquote
  683. "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$"
  684. "Regular expression for matching blockquote lines.
  685. Also accounts for a potential capital letter preceding the angle
  686. bracket, for use with Leanpub blocks (asides, warnings, info
  687. blocks, etc.).
  688. Group 1 matches the leading angle bracket.
  689. Group 2 matches the separating whitespace.
  690. Group 3 matches the text.")
  691. (defconst markdown-regex-line-break
  692. "[^ \n\t][ \t]*\\( \\)$"
  693. "Regular expression for matching line breaks.")
  694. (defconst markdown-regex-wiki-link
  695. "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)"
  696. "Regular expression for matching wiki links.
  697. This matches typical bracketed [[WikiLinks]] as well as 'aliased'
  698. wiki links of the form [[PageName|link text]].
  699. The meanings of the first and second components depend
  700. on the value of `markdown-wiki-link-alias-first'.
  701. Group 1 matches the entire link.
  702. Group 2 matches the opening square brackets.
  703. Group 3 matches the first component of the wiki link.
  704. Group 4 matches the pipe separator, when present.
  705. Group 5 matches the second component of the wiki link, when present.
  706. Group 6 matches the closing square brackets.")
  707. (defconst markdown-regex-uri
  708. (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)")
  709. "Regular expression for matching inline URIs.")
  710. (defconst markdown-regex-angle-uri
  711. (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)")
  712. "Regular expression for matching inline URIs in angle brackets.")
  713. (defconst markdown-regex-email
  714. "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>"
  715. "Regular expression for matching inline email addresses.")
  716. (defsubst markdown-make-regex-link-generic ()
  717. "Make regular expression for matching any recognized link."
  718. (concat "\\(?:" markdown-regex-link-inline
  719. (when markdown-enable-wiki-links
  720. (concat "\\|" markdown-regex-wiki-link))
  721. "\\|" markdown-regex-link-reference
  722. "\\|" markdown-regex-angle-uri "\\)"))
  723. (defconst markdown-regex-gfm-checkbox
  724. " \\(\\[[ xX]\\]\\) "
  725. "Regular expression for matching GFM checkboxes.
  726. Group 1 matches the text to become a button.")
  727. (defconst markdown-regex-blank-line
  728. "^[[:blank:]]*$"
  729. "Regular expression that matches a blank line.")
  730. (defconst markdown-regex-block-separator
  731. "\n[\n\t\f ]*\n"
  732. "Regular expression for matching block boundaries.")
  733. (defconst markdown-regex-block-separator-noindent
  734. (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)")
  735. "Regexp for block separators before lines with no indentation.")
  736. (defconst markdown-regex-math-inline-single
  737. "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)"
  738. "Regular expression for itex $..$ math mode expressions.
  739. Groups 1 and 3 match the opening and closing dollar signs.
  740. Group 2 matches the mathematical expression contained within.")
  741. (defconst markdown-regex-math-inline-double
  742. "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)"
  743. "Regular expression for itex $$..$$ math mode expressions.
  744. Groups 1 and 3 match opening and closing dollar signs.
  745. Group 2 matches the mathematical expression contained within.")
  746. (defconst markdown-regex-math-display
  747. (rx line-start (* blank)
  748. (group (group (repeat 1 2 "\\")) "[")
  749. (group (*? anything))
  750. (group (backref 2) "]")
  751. line-end)
  752. "Regular expression for \[..\] or \\[..\\] display math.
  753. Groups 1 and 4 match the opening and closing markup.
  754. Group 3 matches the mathematical expression contained within.
  755. Group 2 matches the opening slashes, and is used internally to
  756. match the closing slashes.")
  757. (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line)
  758. "Return regexp matching a tilde code fence at least NUM-TILDES long.
  759. END-OF-LINE is the regexp construct to indicate end of line; $ if
  760. missing."
  761. (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)"
  762. (or end-of-line "$")))
  763. (defconst markdown-regex-tilde-fence-begin
  764. (markdown-make-tilde-fence-regex
  765. 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$")
  766. "Regular expression for matching tilde-fenced code blocks.
  767. Group 1 matches the opening tildes.
  768. Group 2 matches (optional) opening brace and surrounding whitespace.
  769. Group 3 matches the language identifier (optional).
  770. Group 4 matches the info string (optional).
  771. Group 5 matches the closing brace (optional) and any surrounding whitespace.
  772. Groups need to agree with `markdown-regex-gfm-code-block-open'.")
  773. (defconst markdown-regex-declarative-metadata
  774. "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$"
  775. "Regular expression for matching declarative metadata statements.
  776. This matches MultiMarkdown metadata as well as YAML and TOML
  777. assignments such as the following:
  778. variable: value
  779. or
  780. variable = value")
  781. (defconst markdown-regex-pandoc-metadata
  782. "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)"
  783. "Regular expression for matching Pandoc metadata.")
  784. (defconst markdown-regex-yaml-metadata-border
  785. "\\(-\\{3\\}\\)$"
  786. "Regular expression for matching YAML metadata.")
  787. (defconst markdown-regex-yaml-pandoc-metadata-end-border
  788. "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$"
  789. "Regular expression for matching YAML metadata end borders.")
  790. (defsubst markdown-get-yaml-metadata-start-border ()
  791. "Return YAML metadata start border depending upon whether Pandoc is used."
  792. (concat
  793. (if markdown-use-pandoc-style-yaml-metadata "^" "\\`")
  794. markdown-regex-yaml-metadata-border))
  795. (defsubst markdown-get-yaml-metadata-end-border (_)
  796. "Return YAML metadata end border depending upon whether Pandoc is used."
  797. (if markdown-use-pandoc-style-yaml-metadata
  798. markdown-regex-yaml-pandoc-metadata-end-border
  799. markdown-regex-yaml-metadata-border))
  800. (defconst markdown-regex-inline-attributes
  801. "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$"
  802. "Regular expression for matching inline identifiers or attribute lists.
  803. Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.")
  804. (defconst markdown-regex-leanpub-sections
  805. (concat
  806. "^\\({\\)\\("
  807. (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak"))
  808. "\\)\\(}\\)[ \t]*\n")
  809. "Regular expression for Leanpub section markers and related syntax.")
  810. (defconst markdown-regex-sub-superscript
  811. "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[[:alnum:]]+\\)\\(?4:\\2\\)\\)"
  812. "The regular expression matching a sub- or superscript.
  813. The leading un-numbered group matches the character before the
  814. opening tilde or carat, if any, ensuring that it is not a
  815. backslash escape, carat, or tilde.
  816. Group 1 matches the entire expression, including markup.
  817. Group 2 matches the opening markup--a tilde or carat.
  818. Group 3 matches the text inside the delimiters.
  819. Group 4 matches the closing markup--a tilde or carat.")
  820. (defconst markdown-regex-include
  821. "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$"
  822. "Regular expression matching common forms of include syntax.
  823. Marked 2, Leanpub, and other processors support some of these forms:
  824. <<[sections/section1.md]
  825. <<(folder/filename)
  826. <<[Code title](folder/filename)
  827. <<{folder/raw_file.html}
  828. Group 1 matches the opening two angle brackets.
  829. Groups 2-4 match the opening square bracket, the text inside,
  830. and the closing square bracket, respectively.
  831. Groups 5-7 match the opening parenthesis, the text inside, and
  832. the closing parenthesis.
  833. Groups 8-10 match the opening brace, the text inside, and the brace.")
  834. (defconst markdown-regex-pandoc-inline-footnote
  835. "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)"
  836. "Regular expression for Pandoc inline footnote^[footnote text].
  837. Group 1 matches the opening caret.
  838. Group 2 matches the opening square bracket.
  839. Group 3 matches the footnote text, without the surrounding markup.
  840. Group 4 matches the closing square bracket.")
  841. (defconst markdown-regex-html-attr
  842. "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?"
  843. "Regular expression for matching HTML attributes and values.
  844. Group 1 matches the attribute name.
  845. Group 2 matches the following whitespace, equals sign, and value, if any.
  846. Group 3 matches the equals sign, if any.
  847. Group 4 matches single-, double-, or un-quoted attribute values.")
  848. (defconst markdown-regex-html-tag
  849. (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr
  850. "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)")
  851. "Regular expression for matching HTML tags.
  852. Groups 1 and 9 match the beginning and ending angle brackets and slashes.
  853. Group 2 matches the tag name.
  854. Group 3 matches all attributes and whitespace following the tag name.")
  855. (defconst markdown-regex-html-entity
  856. "\\(&#?[[:alnum:]]+;\\)"
  857. "Regular expression for matching HTML entities.")
  858. ;;; Syntax ====================================================================
  859. (defvar markdown--syntax-properties
  860. (list 'markdown-tilde-fence-begin nil
  861. 'markdown-tilde-fence-end nil
  862. 'markdown-fenced-code nil
  863. 'markdown-yaml-metadata-begin nil
  864. 'markdown-yaml-metadata-end nil
  865. 'markdown-yaml-metadata-section nil
  866. 'markdown-gfm-block-begin nil
  867. 'markdown-gfm-block-end nil
  868. 'markdown-gfm-code nil
  869. 'markdown-list-item nil
  870. 'markdown-pre nil
  871. 'markdown-blockquote nil
  872. 'markdown-hr nil
  873. 'markdown-comment nil
  874. 'markdown-heading nil
  875. 'markdown-heading-1-setext nil
  876. 'markdown-heading-2-setext nil
  877. 'markdown-heading-1-atx nil
  878. 'markdown-heading-2-atx nil
  879. 'markdown-heading-3-atx nil
  880. 'markdown-heading-4-atx nil
  881. 'markdown-heading-5-atx nil
  882. 'markdown-heading-6-atx nil
  883. 'markdown-metadata-key nil
  884. 'markdown-metadata-value nil
  885. 'markdown-metadata-markup nil)
  886. "Property list of all Markdown syntactic properties.")
  887. (defsubst markdown-in-comment-p (&optional pos)
  888. "Return non-nil if POS is in a comment.
  889. If POS is not given, use point instead."
  890. (get-text-property (or pos (point)) 'markdown-comment))
  891. (defun markdown--face-p (pos faces)
  892. "Return non-nil if face of POS contain FACES."
  893. (let ((face-prop (get-text-property pos 'face)))
  894. (if (listp face-prop)
  895. (cl-loop for face in face-prop
  896. thereis (memq face faces))
  897. (memq face-prop faces))))
  898. (defun markdown-syntax-propertize-extend-region (start end)
  899. "Extend START to END region to include an entire block of text.
  900. This helps improve syntax analysis for block constructs.
  901. Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
  902. Function is called repeatedly until it returns nil. For details, see
  903. `syntax-propertize-extend-region-functions'."
  904. (save-match-data
  905. (save-excursion
  906. (let* ((new-start (progn (goto-char start)
  907. (skip-chars-forward "\n")
  908. (if (re-search-backward "\n\n" nil t)
  909. (min start (match-end 0))
  910. (point-min))))
  911. (new-end (progn (goto-char end)
  912. (skip-chars-backward "\n")
  913. (if (re-search-forward "\n\n" nil t)
  914. (max end (match-beginning 0))
  915. (point-max))))
  916. (code-match (markdown-code-block-at-pos new-start))
  917. (new-start (or (and code-match (cl-first code-match)) new-start))
  918. (code-match (and (< end (point-max)) (markdown-code-block-at-pos end)))
  919. (new-end (or (and code-match (cl-second code-match)) new-end)))
  920. (unless (and (eq new-start start) (eq new-end end))
  921. (cons new-start (min new-end (point-max))))))))
  922. (defun markdown-font-lock-extend-region-function (start end _)
  923. "Used in `jit-lock-after-change-extend-region-functions'.
  924. Delegates to `markdown-syntax-propertize-extend-region'. START
  925. and END are the previous region to refontify."
  926. (let ((res (markdown-syntax-propertize-extend-region start end)))
  927. (when res
  928. ;; syntax-propertize-function is not called when character at
  929. ;; (point-max) is deleted, but font-lock-extend-region-functions
  930. ;; are called. Force a syntax property update in that case.
  931. (when (= end (point-max))
  932. ;; This function is called in a buffer modification hook.
  933. ;; `markdown-syntax-propertize' doesn't save the match data,
  934. ;; so we have to do it here.
  935. (save-match-data
  936. (markdown-syntax-propertize (car res) (cdr res))))
  937. (setq jit-lock-start (car res)
  938. jit-lock-end (cdr res)))))
  939. (defun markdown--cur-list-item-bounds ()
  940. "Return a list describing the list item at point.
  941. Assumes that match data is set for `markdown-regex-list'. See the
  942. documentation for `markdown-cur-list-item-bounds' for the format of
  943. the returned list."
  944. (save-excursion
  945. (let* ((begin (match-beginning 0))
  946. (indent (length (match-string-no-properties 1)))
  947. (nonlist-indent (- (match-end 3) (match-beginning 0)))
  948. (marker (buffer-substring-no-properties
  949. (match-beginning 2) (match-end 3)))
  950. (checkbox (match-string-no-properties 4))
  951. (match (butlast (match-data t)))
  952. (end (markdown-cur-list-item-end nonlist-indent)))
  953. (list begin end indent nonlist-indent marker checkbox match))))
  954. (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds)
  955. "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS.
  956. Here, MARKER is a string representing the type of list and INDENT
  957. is an integer giving the indentation, in spaces, of the current
  958. block. CUR-BOUNDS is a list of the form returned by
  959. `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds
  960. values for parent list items. When BOUNDS is nil, it means we are
  961. at baseline (not inside of a nested list)."
  962. (let ((prev-indent (or (cl-third (car bounds)) 0)))
  963. (cond
  964. ;; New list item at baseline.
  965. ((and marker (null bounds))
  966. (list cur-bounds))
  967. ;; List item with greater indentation (four or more spaces).
  968. ;; Increase list level by consing CUR-BOUNDS onto BOUNDS.
  969. ((and marker (>= indent (+ prev-indent markdown-list-indent-width)))
  970. (cons cur-bounds bounds))
  971. ;; List item with greater or equal indentation (less than four spaces).
  972. ;; Keep list level the same by replacing the car of BOUNDS.
  973. ((and marker (>= indent prev-indent))
  974. (cons cur-bounds (cdr bounds)))
  975. ;; Lesser indentation level.
  976. ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser
  977. ;; indentation could move back more than one list level). Note
  978. ;; that this block need not be the beginning of list item.
  979. ((< indent prev-indent)
  980. (while (and (> (length bounds) 1)
  981. (setq prev-indent (cl-third (cadr bounds)))
  982. (< indent (+ prev-indent markdown-list-indent-width)))
  983. (setq bounds (cdr bounds)))
  984. (cons cur-bounds bounds))
  985. ;; Otherwise, do nothing.
  986. (t bounds))))
  987. (defun markdown-syntax-propertize-list-items (start end)
  988. "Propertize list items from START to END.
  989. Stores nested list item information in the `markdown-list-item'
  990. text property to make later syntax analysis easier. The value of
  991. this property is a list with elements of the form (begin . end)
  992. giving the bounds of the current and parent list items."
  993. (save-excursion
  994. (goto-char start)
  995. (let (bounds level pre-regexp)
  996. ;; Find a baseline point with zero list indentation
  997. (markdown-search-backward-baseline)
  998. ;; Search for all list items between baseline and END
  999. (while (and (< (point) end)
  1000. (re-search-forward markdown-regex-list end 'limit))
  1001. ;; Level of list nesting
  1002. (setq level (length bounds))
  1003. ;; Pre blocks need to be indented one level past the list level
  1004. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level)))
  1005. (beginning-of-line)
  1006. (cond
  1007. ;; Reset at headings, horizontal rules, and top-level blank lines.
  1008. ;; Propertize baseline when in range.
  1009. ((markdown-new-baseline)
  1010. (setq bounds nil))
  1011. ;; Make sure this is not a line from a pre block
  1012. ((looking-at-p pre-regexp))
  1013. ;; If not, then update levels and propertize list item when in range.
  1014. (t
  1015. (let* ((indent (current-indentation))
  1016. (cur-bounds (markdown--cur-list-item-bounds))
  1017. (first (cl-first cur-bounds))
  1018. (last (cl-second cur-bounds))
  1019. (marker (cl-fifth cur-bounds)))
  1020. (setq bounds (markdown--append-list-item-bounds
  1021. marker indent cur-bounds bounds))
  1022. (when (and (<= start (point)) (<= (point) end))
  1023. (put-text-property first last 'markdown-list-item bounds)))))
  1024. (end-of-line)))))
  1025. (defun markdown-syntax-propertize-pre-blocks (start end)
  1026. "Match preformatted text blocks from START to END."
  1027. (save-excursion
  1028. (goto-char start)
  1029. (let (finish)
  1030. ;; Use loop for avoiding too many recursive calls
  1031. ;; https://github.com/jrblevin/markdown-mode/issues/512
  1032. (while (not finish)
  1033. (let ((levels (markdown-calculate-list-levels))
  1034. indent pre-regexp close-regexp open close)
  1035. (while (and (< (point) end) (not close))
  1036. ;; Search for a region with sufficient indentation
  1037. (if (null levels)
  1038. (setq indent 1)
  1039. (setq indent (1+ (length levels))))
  1040. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent))
  1041. (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent)))
  1042. (cond
  1043. ;; If not at the beginning of a line, move forward
  1044. ((not (bolp)) (forward-line))
  1045. ;; Move past blank lines
  1046. ((markdown-cur-line-blank-p) (forward-line))
  1047. ;; At headers and horizontal rules, reset levels
  1048. ((markdown-new-baseline) (forward-line) (setq levels nil))
  1049. ;; If the current line has sufficient indentation, mark out pre block
  1050. ;; The opening should be preceded by a blank line.
  1051. ((and (markdown-prev-line-blank) (looking-at pre-regexp))
  1052. (setq open (match-beginning 0))
  1053. (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p))
  1054. (not (eobp)))
  1055. (forward-line))
  1056. (skip-syntax-backward "-")
  1057. (setq close (point)))
  1058. ;; If current line has a list marker, update levels, move to end of block
  1059. ((looking-at markdown-regex-list)
  1060. (setq levels (markdown-update-list-levels
  1061. (match-string 2) (current-indentation) levels))
  1062. (markdown-end-of-text-block))
  1063. ;; If this is the end of the indentation level, adjust levels accordingly.
  1064. ;; Only match end of indentation level if levels is not the empty list.
  1065. ((and (car levels) (looking-at-p close-regexp))
  1066. (setq levels (markdown-update-list-levels
  1067. nil (current-indentation) levels))
  1068. (markdown-end-of-text-block))
  1069. (t (markdown-end-of-text-block))))
  1070. (if (and open close)
  1071. ;; Set text property data and continue to search
  1072. (put-text-property open close 'markdown-pre (list open close))
  1073. (setq finish t))))
  1074. nil)))
  1075. (defconst markdown-fenced-block-pairs
  1076. `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin)
  1077. (markdown-make-tilde-fence-regex markdown-tilde-fence-end)
  1078. markdown-fenced-code)
  1079. ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin)
  1080. (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end)
  1081. markdown-yaml-metadata-section)
  1082. ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin)
  1083. (,markdown-regex-gfm-code-block-close markdown-gfm-block-end)
  1084. markdown-gfm-code))
  1085. "Mapping of regular expressions to \"fenced-block\" constructs.
  1086. These constructs are distinguished by having a distinctive start
  1087. and end pattern, both of which take up an entire line of text,
  1088. but no special pattern to identify text within the fenced
  1089. blocks (unlike blockquotes and indented-code sections).
  1090. Each element within this list takes the form:
  1091. ((START-REGEX-OR-FUN START-PROPERTY)
  1092. (END-REGEX-OR-FUN END-PROPERTY)
  1093. MIDDLE-PROPERTY)
  1094. Each *-REGEX-OR-FUN element can be a regular expression as a string, or a
  1095. function which evaluates to same. Functions for START-REGEX-OR-FUN accept no
  1096. arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument
  1097. which is the length of the first group of the START-REGEX-OR-FUN match, which
  1098. can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to
  1099. evaluate these into \"real\" regexps.
  1100. The *-PROPERTY elements are the text properties applied to each part of the
  1101. block construct when it is matched using
  1102. `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied
  1103. to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and
  1104. MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the
  1105. `match-data' when the regexp was matched to the text. In the case of
  1106. MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with
  1107. begin and end set to the edges of the \"middle\" text. This makes fontification
  1108. easier.")
  1109. (defun markdown-text-property-at-point (prop)
  1110. (get-text-property (point) prop))
  1111. (defsubst markdown-maybe-funcall-regexp (object &optional arg)
  1112. (cond ((functionp object)
  1113. (if arg (funcall object arg) (funcall object)))
  1114. ((stringp object) object)
  1115. (t (error "Object cannot be turned into regex"))))
  1116. (defsubst markdown-get-start-fence-regexp ()
  1117. "Return regexp to find all \"start\" sections of fenced block constructs.
  1118. Which construct is actually contained in the match must be found separately."
  1119. (mapconcat
  1120. #'identity
  1121. (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry)))
  1122. markdown-fenced-block-pairs)
  1123. "\\|"))
  1124. (defun markdown-get-fenced-block-begin-properties ()
  1125. (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs))
  1126. (defun markdown-get-fenced-block-end-properties ()
  1127. (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs))
  1128. (defun markdown-get-fenced-block-middle-properties ()
  1129. (cl-mapcar #'cl-third markdown-fenced-block-pairs))
  1130. (defun markdown-find-previous-prop (prop &optional lim)
  1131. "Find previous place where property PROP is non-nil, up to LIM.
  1132. Return a cons of (pos . property). pos is point if point contains
  1133. non-nil PROP."
  1134. (let ((res
  1135. (if (get-text-property (point) prop) (point)
  1136. (previous-single-property-change
  1137. (point) prop nil (or lim (point-min))))))
  1138. (when (and (not (get-text-property res prop))
  1139. (> res (point-min))
  1140. (get-text-property (1- res) prop))
  1141. (cl-decf res))
  1142. (when (and res (get-text-property res prop)) (cons res prop))))
  1143. (defun markdown-find-next-prop (prop &optional lim)
  1144. "Find next place where property PROP is non-nil, up to LIM.
  1145. Return a cons of (POS . PROPERTY) where POS is point if point
  1146. contains non-nil PROP."
  1147. (let ((res
  1148. (if (get-text-property (point) prop) (point)
  1149. (next-single-property-change
  1150. (point) prop nil (or lim (point-max))))))
  1151. (when (and res (get-text-property res prop)) (cons res prop))))
  1152. (defun markdown-min-of-seq (map-fn seq)
  1153. "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN."
  1154. (cl-loop for el in seq
  1155. with min = 1.0e+INF ; infinity
  1156. with min-el = nil
  1157. do (let ((res (funcall map-fn el)))
  1158. (when (< res min)
  1159. (setq min res)
  1160. (setq min-el el)))
  1161. finally return min-el))
  1162. (defun markdown-max-of-seq (map-fn seq)
  1163. "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN."
  1164. (cl-loop for el in seq
  1165. with max = -1.0e+INF ; negative infinity
  1166. with max-el = nil
  1167. do (let ((res (funcall map-fn el)))
  1168. (when (and res (> res max))
  1169. (setq max res)
  1170. (setq max-el el)))
  1171. finally return max-el))
  1172. (defun markdown-find-previous-block ()
  1173. "Find previous block.
  1174. Detect whether `markdown-syntax-propertize-fenced-block-constructs' was
  1175. unable to propertize the entire block, but was able to propertize the beginning
  1176. of the block. If so, return a cons of (pos . property) where the beginning of
  1177. the block was propertized."
  1178. (let ((start-pt (point))
  1179. (closest-open
  1180. (markdown-max-of-seq
  1181. #'car
  1182. (cl-remove-if
  1183. #'null
  1184. (cl-mapcar
  1185. #'markdown-find-previous-prop
  1186. (markdown-get-fenced-block-begin-properties))))))
  1187. (when closest-open
  1188. (let* ((length-of-open-match
  1189. (let ((match-d
  1190. (get-text-property (car closest-open) (cdr closest-open))))
  1191. (- (cl-fourth match-d) (cl-third match-d))))
  1192. (end-regexp
  1193. (markdown-maybe-funcall-regexp
  1194. (cl-caadr
  1195. (cl-find-if
  1196. (lambda (entry) (eq (cl-cadar entry) (cdr closest-open)))
  1197. markdown-fenced-block-pairs))
  1198. length-of-open-match))
  1199. (end-prop-loc
  1200. (save-excursion
  1201. (save-match-data
  1202. (goto-char (car closest-open))
  1203. (and (re-search-forward end-regexp start-pt t)
  1204. (match-beginning 0))))))
  1205. (and (not end-prop-loc) closest-open)))))
  1206. (defun markdown-get-fenced-block-from-start (prop)
  1207. "Return limits of an enclosing fenced block from its start, using PROP.
  1208. Return value is a list usable as `match-data'."
  1209. (catch 'no-rest-of-block
  1210. (let* ((correct-entry
  1211. (cl-find-if
  1212. (lambda (entry) (eq (cl-cadar entry) prop))
  1213. markdown-fenced-block-pairs))
  1214. (begin-of-begin (cl-first (markdown-text-property-at-point prop)))
  1215. (middle-prop (cl-third correct-entry))
  1216. (end-prop (cl-cadadr correct-entry))
  1217. (end-of-end
  1218. (save-excursion
  1219. (goto-char (match-end 0)) ; end of begin
  1220. (unless (eobp) (forward-char))
  1221. (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
  1222. (if (not mid-prop-v) ; no middle
  1223. (progn
  1224. ;; try to find end by advancing one
  1225. (let ((end-prop-v
  1226. (markdown-text-property-at-point end-prop)))
  1227. (if end-prop-v (cl-second end-prop-v)
  1228. (throw 'no-rest-of-block nil))))
  1229. (set-match-data mid-prop-v)
  1230. (goto-char (match-end 0)) ; end of middle
  1231. (beginning-of-line) ; into end
  1232. (cl-second (markdown-text-property-at-point end-prop)))))))
  1233. (list begin-of-begin end-of-end))))
  1234. (defun markdown-get-fenced-block-from-middle (prop)
  1235. "Return limits of an enclosing fenced block from its middle, using PROP.
  1236. Return value is a list usable as `match-data'."
  1237. (let* ((correct-entry
  1238. (cl-find-if
  1239. (lambda (entry) (eq (cl-third entry) prop))
  1240. markdown-fenced-block-pairs))
  1241. (begin-prop (cl-cadar correct-entry))
  1242. (begin-of-begin
  1243. (save-excursion
  1244. (goto-char (match-beginning 0))
  1245. (unless (bobp) (forward-line -1))
  1246. (beginning-of-line)
  1247. (cl-first (markdown-text-property-at-point begin-prop))))
  1248. (end-prop (cl-cadadr correct-entry))
  1249. (end-of-end
  1250. (save-excursion
  1251. (goto-char (match-end 0))
  1252. (beginning-of-line)
  1253. (cl-second (markdown-text-property-at-point end-prop)))))
  1254. (list begin-of-begin end-of-end)))
  1255. (defun markdown-get-fenced-block-from-end (prop)
  1256. "Return limits of an enclosing fenced block from its end, using PROP.
  1257. Return value is a list usable as `match-data'."
  1258. (let* ((correct-entry
  1259. (cl-find-if
  1260. (lambda (entry) (eq (cl-cadadr entry) prop))
  1261. markdown-fenced-block-pairs))
  1262. (end-of-end (cl-second (markdown-text-property-at-point prop)))
  1263. (middle-prop (cl-third correct-entry))
  1264. (begin-prop (cl-cadar correct-entry))
  1265. (begin-of-begin
  1266. (save-excursion
  1267. (goto-char (match-beginning 0)) ; beginning of end
  1268. (unless (bobp) (backward-char)) ; into middle
  1269. (let ((mid-prop-v (markdown-text-property-at-point middle-prop)))
  1270. (if (not mid-prop-v)
  1271. (progn
  1272. (beginning-of-line)
  1273. (cl-first (markdown-text-property-at-point begin-prop)))
  1274. (set-match-data mid-prop-v)
  1275. (goto-char (match-beginning 0)) ; beginning of middle
  1276. (unless (bobp) (forward-line -1)) ; into beginning
  1277. (beginning-of-line)
  1278. (cl-first (markdown-text-property-at-point begin-prop)))))))
  1279. (list begin-of-begin end-of-end)))
  1280. (defun markdown-get-enclosing-fenced-block-construct (&optional pos)
  1281. "Get \"fake\" match data for block enclosing POS.
  1282. Returns fake match data which encloses the start, middle, and end
  1283. of the block construct enclosing POS, if it exists. Used in
  1284. `markdown-code-block-at-pos'."
  1285. (save-excursion
  1286. (when pos (goto-char pos))
  1287. (beginning-of-line)
  1288. (car
  1289. (cl-remove-if
  1290. #'null
  1291. (cl-mapcar
  1292. (lambda (fun-and-prop)
  1293. (cl-destructuring-bind (fun prop) fun-and-prop
  1294. (when prop
  1295. (save-match-data
  1296. (set-match-data (markdown-text-property-at-point prop))
  1297. (funcall fun prop)))))
  1298. `((markdown-get-fenced-block-from-start
  1299. ,(cl-find-if
  1300. #'markdown-text-property-at-point
  1301. (markdown-get-fenced-block-begin-properties)))
  1302. (markdown-get-fenced-block-from-middle
  1303. ,(cl-find-if
  1304. #'markdown-text-property-at-point
  1305. (markdown-get-fenced-block-middle-properties)))
  1306. (markdown-get-fenced-block-from-end
  1307. ,(cl-find-if
  1308. #'markdown-text-property-at-point
  1309. (markdown-get-fenced-block-end-properties)))))))))
  1310. (defun markdown-propertize-end-match (reg end fence-spec middle-begin)
  1311. "Get match for REG up to END, if exists, and propertize appropriately.
  1312. FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and
  1313. MIDDLE-BEGIN is the start of the \"middle\" section of the block."
  1314. (when (re-search-forward reg end t)
  1315. (let ((close-begin (match-beginning 0)) ; Start of closing line.
  1316. (close-end (match-end 0)) ; End of closing line.
  1317. (close-data (match-data t))) ; Match data for closing line.
  1318. ;; Propertize middle section of fenced block.
  1319. (put-text-property middle-begin close-begin
  1320. (cl-third fence-spec)
  1321. (list middle-begin close-begin))
  1322. ;; If the block is a YAML block, propertize the declarations inside
  1323. (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)
  1324. ;; Propertize closing line of fenced block.
  1325. (put-text-property close-begin close-end
  1326. (cl-cadadr fence-spec) close-data))))
  1327. (defun markdown-syntax-propertize-fenced-block-constructs (start end)
  1328. "Propertize according to `markdown-fenced-block-pairs' from START to END.
  1329. If unable to propertize an entire block (if the start of a block is within START
  1330. and END, but the end of the block is not), propertize the start section of a
  1331. block, then in a subsequent call propertize both middle and end by finding the
  1332. start which was previously propertized."
  1333. (let ((start-reg (markdown-get-start-fence-regexp)))
  1334. (save-excursion
  1335. (goto-char start)
  1336. ;; start from previous unclosed block, if exists
  1337. (let ((prev-begin-block (markdown-find-previous-block)))
  1338. (when prev-begin-block
  1339. (let* ((correct-entry
  1340. (cl-find-if (lambda (entry)
  1341. (eq (cdr prev-begin-block) (cl-cadar entry)))
  1342. markdown-fenced-block-pairs))
  1343. (enclosed-text-start (1+ (car prev-begin-block)))
  1344. (start-length
  1345. (save-excursion
  1346. (goto-char (car prev-begin-block))
  1347. (string-match
  1348. (markdown-maybe-funcall-regexp
  1349. (caar correct-entry))
  1350. (buffer-substring
  1351. (point-at-bol) (point-at-eol)))
  1352. (- (match-end 1) (match-beginning 1))))
  1353. (end-reg (markdown-maybe-funcall-regexp
  1354. (cl-caadr correct-entry) start-length)))
  1355. (markdown-propertize-end-match
  1356. end-reg end correct-entry enclosed-text-start))))
  1357. ;; find all new blocks within region
  1358. (while (re-search-forward start-reg end t)
  1359. ;; we assume the opening constructs take up (only) an entire line,
  1360. ;; so we re-check the current line
  1361. (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol)))
  1362. ;; find entry in `markdown-fenced-block-pairs' corresponding
  1363. ;; to regex which was matched
  1364. (correct-entry
  1365. (cl-find-if
  1366. (lambda (fenced-pair)
  1367. (string-match-p
  1368. (markdown-maybe-funcall-regexp (caar fenced-pair))
  1369. cur-line))
  1370. markdown-fenced-block-pairs))
  1371. (enclosed-text-start
  1372. (save-excursion (1+ (point-at-eol))))
  1373. (end-reg
  1374. (markdown-maybe-funcall-regexp
  1375. (cl-caadr correct-entry)
  1376. (if (and (match-beginning 1) (match-end 1))
  1377. (- (match-end 1) (match-beginning 1))
  1378. 0))))
  1379. ;; get correct match data
  1380. (save-excursion
  1381. (beginning-of-line)
  1382. (re-search-forward
  1383. (markdown-maybe-funcall-regexp (caar correct-entry))
  1384. (point-at-eol)))
  1385. ;; mark starting, even if ending is outside of region
  1386. (put-text-property (match-beginning 0) (match-end 0)
  1387. (cl-cadar correct-entry) (match-data t))
  1388. (markdown-propertize-end-match
  1389. end-reg end correct-entry enclosed-text-start))))))
  1390. (defun markdown-syntax-propertize-blockquotes (start end)
  1391. "Match blockquotes from START to END."
  1392. (save-excursion
  1393. (goto-char start)
  1394. (while (and (re-search-forward markdown-regex-blockquote end t)
  1395. (not (markdown-code-block-at-pos (match-beginning 0))))
  1396. (put-text-property (match-beginning 0) (match-end 0)
  1397. 'markdown-blockquote
  1398. (match-data t)))))
  1399. (defun markdown-syntax-propertize-hrs (start end)
  1400. "Match horizontal rules from START to END."
  1401. (save-excursion
  1402. (goto-char start)
  1403. (while (re-search-forward markdown-regex-hr end t)
  1404. (let ((beg (match-beginning 0))
  1405. (end (match-end 0)))
  1406. (goto-char beg)
  1407. (unless (or (markdown-on-heading-p)
  1408. (markdown-code-block-at-point-p))
  1409. (put-text-property beg end 'markdown-hr (match-data t)))
  1410. (goto-char end)))))
  1411. (defun markdown-syntax-propertize-yaml-metadata (start end)
  1412. "Propertize elements inside YAML metadata blocks from START to END.
  1413. Assumes region from START and END is already known to be the interior
  1414. region of a YAML metadata block as propertized by
  1415. `markdown-syntax-propertize-fenced-block-constructs'."
  1416. (save-excursion
  1417. (goto-char start)
  1418. (cl-loop
  1419. while (re-search-forward markdown-regex-declarative-metadata end t)
  1420. do (progn
  1421. (put-text-property (match-beginning 1) (match-end 1)
  1422. 'markdown-metadata-key (match-data t))
  1423. (put-text-property (match-beginning 2) (match-end 2)
  1424. 'markdown-metadata-markup (match-data t))
  1425. (put-text-property (match-beginning 3) (match-end 3)
  1426. 'markdown-metadata-value (match-data t))))))
  1427. (defun markdown-syntax-propertize-headings (start end)
  1428. "Match headings of type SYMBOL with REGEX from START to END."
  1429. (goto-char start)
  1430. (while (re-search-forward markdown-regex-header end t)
  1431. (unless (markdown-code-block-at-pos (match-beginning 0))
  1432. (put-text-property
  1433. (match-beginning 0) (match-end 0) 'markdown-heading
  1434. (match-data t))
  1435. (put-text-property
  1436. (match-beginning 0) (match-end 0)
  1437. (cond ((match-string-no-properties 2) 'markdown-heading-1-setext)
  1438. ((match-string-no-properties 3) 'markdown-heading-2-setext)
  1439. (t (let ((atx-level (length (markdown-trim-whitespace
  1440. (match-string-no-properties 4)))))
  1441. (intern (format "markdown-heading-%d-atx" atx-level)))))
  1442. (match-data t)))))
  1443. (defun markdown-syntax-propertize-comments (start end)
  1444. "Match HTML comments from the START to END."
  1445. ;; Implement by loop instead of recursive call for avoiding
  1446. ;; exceed max-lisp-eval-depth issue
  1447. ;; https://github.com/jrblevin/markdown-mode/issues/536
  1448. (let (finish)
  1449. (goto-char start)
  1450. (while (not finish)
  1451. (let* ((in-comment (nth 4 (syntax-ppss)))
  1452. (comment-begin (nth 8 (syntax-ppss))))
  1453. (cond
  1454. ;; Comment start
  1455. ((and (not in-comment)
  1456. (re-search-forward markdown-regex-comment-start end t)
  1457. (not (markdown-inline-code-at-point-p))
  1458. (not (markdown-code-block-at-point-p)))
  1459. (let ((open-beg (match-beginning 0)))
  1460. (put-text-property open-beg (1+ open-beg)
  1461. 'syntax-table (string-to-syntax "<"))
  1462. (goto-char (min (1+ (match-end 0)) end (point-max)))))
  1463. ;; Comment end
  1464. ((and in-comment comment-begin
  1465. (re-search-forward markdown-regex-comment-end end t))
  1466. (let ((comment-end (match-end 0)))
  1467. (put-text-property (1- comment-end) comment-end
  1468. 'syntax-table (string-to-syntax ">"))
  1469. ;; Remove any other text properties inside the comment
  1470. (remove-text-properties comment-begin comment-end
  1471. markdown--syntax-properties)
  1472. (put-text-property comment-begin comment-end
  1473. 'markdown-comment (list comment-begin comment-end))
  1474. (goto-char (min (1+ comment-end) end (point-max)))))
  1475. ;; Nothing found
  1476. (t (setq finish t)))))
  1477. nil))
  1478. (defun markdown-syntax-propertize (start end)
  1479. "Function used as `syntax-propertize-function'.
  1480. START and END delimit region to propertize."
  1481. (with-silent-modifications
  1482. (save-excursion
  1483. (remove-text-properties start end markdown--syntax-properties)
  1484. (markdown-syntax-propertize-fenced-block-constructs start end)
  1485. (markdown-syntax-propertize-list-items start end)
  1486. (markdown-syntax-propertize-pre-blocks start end)
  1487. (markdown-syntax-propertize-blockquotes start end)
  1488. (markdown-syntax-propertize-headings start end)
  1489. (markdown-syntax-propertize-hrs start end)
  1490. (markdown-syntax-propertize-comments start end))))
  1491. ;;; Markup Hiding =============================================================
  1492. (defconst markdown-markup-properties
  1493. '(face markdown-markup-face invisible markdown-markup)
  1494. "List of properties and values to apply to markup.")
  1495. (defconst markdown-language-keyword-properties
  1496. '(face markdown-language-keyword-face invisible markdown-markup)
  1497. "List of properties and values to apply to code block language names.")
  1498. (defconst markdown-language-info-properties
  1499. '(face markdown-language-info-face invisible markdown-markup)
  1500. "List of properties and values to apply to code block language info strings.")
  1501. (defconst markdown-include-title-properties
  1502. '(face markdown-link-title-face invisible markdown-markup)
  1503. "List of properties and values to apply to included code titles.")
  1504. (defcustom markdown-hide-markup nil
  1505. "Determines whether markup in the buffer will be hidden.
  1506. When set to nil, all markup is displayed in the buffer as it
  1507. appears in the file. An exception is when `markdown-hide-urls'
  1508. is non-nil.
  1509. Set this to a non-nil value to turn this feature on by default.
  1510. You can interactively toggle the value of this variable with
  1511. `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding],
  1512. or from the Markdown > Show & Hide menu.
  1513. Markup hiding works by adding text properties to positions in the
  1514. buffer---either the `invisible' property or the `display' property
  1515. in cases where alternative glyphs are used (e.g., list bullets).
  1516. This does not, however, affect printing or other output.
  1517. Functions such as `htmlfontify-buffer' and `ps-print-buffer' will
  1518. not honor these text properties. For printing, it would be better
  1519. to first convert to HTML or PDF (e.g,. using Pandoc)."
  1520. :group 'markdown
  1521. :type 'boolean
  1522. :safe 'booleanp
  1523. :package-version '(markdown-mode . "2.3"))
  1524. (make-variable-buffer-local 'markdown-hide-markup)
  1525. (defun markdown-toggle-markup-hiding (&optional arg)
  1526. "Toggle the display or hiding of markup.
  1527. With a prefix argument ARG, enable markup hiding if ARG is positive,
  1528. and disable it otherwise.
  1529. See `markdown-hide-markup' for additional details."
  1530. (interactive (list (or current-prefix-arg 'toggle)))
  1531. (setq markdown-hide-markup
  1532. (if (eq arg 'toggle)
  1533. (not markdown-hide-markup)
  1534. (> (prefix-numeric-value arg) 0)))
  1535. (if markdown-hide-markup
  1536. (progn (add-to-invisibility-spec 'markdown-markup)
  1537. (message "markdown-mode markup hiding enabled"))
  1538. (progn (remove-from-invisibility-spec 'markdown-markup)
  1539. (message "markdown-mode markup hiding disabled")))
  1540. (markdown-reload-extensions))
  1541. ;;; Font Lock =================================================================
  1542. (require 'font-lock)
  1543. (defgroup markdown-faces nil
  1544. "Faces used in Markdown Mode"
  1545. :group 'markdown
  1546. :group 'faces)
  1547. (defface markdown-italic-face
  1548. '((t (:inherit italic)))
  1549. "Face for italic text."
  1550. :group 'markdown-faces)
  1551. (defface markdown-bold-face
  1552. '((t (:inherit bold)))
  1553. "Face for bold text."
  1554. :group 'markdown-faces)
  1555. (defface markdown-strike-through-face
  1556. '((t (:strike-through t)))
  1557. "Face for strike-through text."
  1558. :group 'markdown-faces)
  1559. (defface markdown-markup-face
  1560. '((t (:inherit shadow :slant normal :weight normal)))
  1561. "Face for markup elements."
  1562. :group 'markdown-faces)
  1563. (defface markdown-header-rule-face
  1564. '((t (:inherit markdown-markup-face)))
  1565. "Base face for headers rules."
  1566. :group 'markdown-faces)
  1567. (defface markdown-header-delimiter-face
  1568. '((t (:inherit markdown-markup-face)))
  1569. "Base face for headers hash delimiter."
  1570. :group 'markdown-faces)
  1571. (defface markdown-list-face
  1572. '((t (:inherit markdown-markup-face)))
  1573. "Face for list item markers."
  1574. :group 'markdown-faces)
  1575. (defface markdown-blockquote-face
  1576. '((t (:inherit font-lock-doc-face)))
  1577. "Face for blockquote sections."
  1578. :group 'markdown-faces)
  1579. (defface markdown-code-face
  1580. '((t (:inherit fixed-pitch)))
  1581. "Face for inline code, pre blocks, and fenced code blocks.
  1582. This may be used, for example, to add a contrasting background to
  1583. inline code fragments and code blocks."
  1584. :group 'markdown-faces)
  1585. (defface markdown-inline-code-face
  1586. '((t (:inherit (markdown-code-face font-lock-constant-face))))
  1587. "Face for inline code."
  1588. :group 'markdown-faces)
  1589. (defface markdown-pre-face
  1590. '((t (:inherit (markdown-code-face font-lock-constant-face))))
  1591. "Face for preformatted text."
  1592. :group 'markdown-faces)
  1593. (defface markdown-table-face
  1594. '((t (:inherit (markdown-code-face))))
  1595. "Face for tables."
  1596. :group 'markdown-faces)
  1597. (defface markdown-language-keyword-face
  1598. '((t (:inherit font-lock-type-face)))
  1599. "Face for programming language identifiers."
  1600. :group 'markdown-faces)
  1601. (defface markdown-language-info-face
  1602. '((t (:inherit font-lock-string-face)))
  1603. "Face for programming language info strings."
  1604. :group 'markdown-faces)
  1605. (defface markdown-link-face
  1606. '((t (:inherit link)))
  1607. "Face for links."
  1608. :group 'markdown-faces)
  1609. (defface markdown-missing-link-face
  1610. '((t (:inherit font-lock-warning-face)))
  1611. "Face for missing links."
  1612. :group 'markdown-faces)
  1613. (defface markdown-reference-face
  1614. '((t (:inherit markdown-markup-face)))
  1615. "Face for link references."
  1616. :group 'markdown-faces)
  1617. (defface markdown-footnote-marker-face
  1618. '((t (:inherit markdown-markup-face)))
  1619. "Face for footnote markers."
  1620. :group 'markdown-faces)
  1621. (defface markdown-footnote-text-face
  1622. '((t (:inherit font-lock-comment-face)))
  1623. "Face for footnote text."
  1624. :group 'markdown-faces)
  1625. (defface markdown-url-face
  1626. '((t (:inherit font-lock-string-face)))
  1627. "Face for URLs that are part of markup.
  1628. For example, this applies to URLs in inline links:
  1629. [link text](http://example.com/)."
  1630. :group 'markdown-faces)
  1631. (defface markdown-plain-url-face
  1632. '((t (:inherit markdown-link-face)))
  1633. "Face for URLs that are also links.
  1634. For example, this applies to plain angle bracket URLs:
  1635. <http://example.com/>."
  1636. :group 'markdown-faces)
  1637. (defface markdown-link-title-face
  1638. '((t (:inherit font-lock-comment-face)))
  1639. "Face for reference link titles."
  1640. :group 'markdown-faces)
  1641. (defface markdown-line-break-face
  1642. '((t (:inherit font-lock-constant-face :underline t)))
  1643. "Face for hard line breaks."
  1644. :group 'markdown-faces)
  1645. (defface markdown-comment-face
  1646. '((t (:inherit font-lock-comment-face)))
  1647. "Face for HTML comments."
  1648. :group 'markdown-faces)
  1649. (defface markdown-math-face
  1650. '((t (:inherit font-lock-string-face)))
  1651. "Face for LaTeX expressions."
  1652. :group 'markdown-faces)
  1653. (defface markdown-metadata-key-face
  1654. '((t (:inherit font-lock-variable-name-face)))
  1655. "Face for metadata keys."
  1656. :group 'markdown-faces)
  1657. (defface markdown-metadata-value-face
  1658. '((t (:inherit font-lock-string-face)))
  1659. "Face for metadata values."
  1660. :group 'markdown-faces)
  1661. (defface markdown-gfm-checkbox-face
  1662. '((t (:inherit font-lock-builtin-face)))
  1663. "Face for GFM checkboxes."
  1664. :group 'markdown-faces)
  1665. (defface markdown-highlight-face
  1666. '((t (:inherit highlight)))
  1667. "Face for mouse highlighting."
  1668. :group 'markdown-faces)
  1669. (defface markdown-hr-face
  1670. '((t (:inherit markdown-markup-face)))
  1671. "Face for horizontal rules."
  1672. :group 'markdown-faces)
  1673. (defface markdown-html-tag-name-face
  1674. '((t (:inherit font-lock-type-face)))
  1675. "Face for HTML tag names."
  1676. :group 'markdown-faces)
  1677. (defface markdown-html-tag-delimiter-face
  1678. '((t (:inherit markdown-markup-face)))
  1679. "Face for HTML tag delimiters."
  1680. :group 'markdown-faces)
  1681. (defface markdown-html-attr-name-face
  1682. '((t (:inherit font-lock-variable-name-face)))
  1683. "Face for HTML attribute names."
  1684. :group 'markdown-faces)
  1685. (defface markdown-html-attr-value-face
  1686. '((t (:inherit font-lock-string-face)))
  1687. "Face for HTML attribute values."
  1688. :group 'markdown-faces)
  1689. (defface markdown-html-entity-face
  1690. '((t (:inherit font-lock-variable-name-face)))
  1691. "Face for HTML entities."
  1692. :group 'markdown-faces)
  1693. (defcustom markdown-header-scaling nil
  1694. "Whether to use variable-height faces for headers.
  1695. When non-nil, `markdown-header-face' will inherit from
  1696. `variable-pitch' and the scaling values in
  1697. `markdown-header-scaling-values' will be applied to
  1698. headers of levels one through six respectively."
  1699. :type 'boolean
  1700. :initialize 'custom-initialize-default
  1701. :set (lambda (symbol value)
  1702. (set-default symbol value)
  1703. (markdown-update-header-faces value))
  1704. :group 'markdown-faces
  1705. :package-version '(markdown-mode . "2.2"))
  1706. (defcustom markdown-header-scaling-values
  1707. '(2.0 1.7 1.4 1.1 1.0 1.0)
  1708. "List of scaling values for headers of level one through six.
  1709. Used when `markdown-header-scaling' is non-nil."
  1710. :type 'list
  1711. :initialize 'custom-initialize-default
  1712. :set (lambda (symbol value)
  1713. (set-default symbol value)
  1714. (markdown-update-header-faces markdown-header-scaling value))
  1715. :group 'markdown-faces)
  1716. (defun markdown-make-header-faces ()
  1717. "Build the faces used for Markdown headers."
  1718. (let ((inherit-faces '(font-lock-function-name-face)))
  1719. (when markdown-header-scaling
  1720. (setq inherit-faces (cons 'variable-pitch inherit-faces)))
  1721. (defface markdown-header-face
  1722. `((t (:inherit ,inherit-faces :weight bold)))
  1723. "Base face for headers."
  1724. :group 'markdown-faces))
  1725. (dotimes (num 6)
  1726. (let* ((num1 (1+ num))
  1727. (face-name (intern (format "markdown-header-face-%s" num1)))
  1728. (scale (if markdown-header-scaling
  1729. (float (nth num markdown-header-scaling-values))
  1730. 1.0)))
  1731. (eval
  1732. `(defface ,face-name
  1733. '((t (:inherit markdown-header-face :height ,scale)))
  1734. (format "Face for level %s headers.
  1735. You probably don't want to customize this face directly. Instead
  1736. you can customize the base face `markdown-header-face' or the
  1737. variable-height variable `markdown-header-scaling'." ,num1)
  1738. :group 'markdown-faces)))))
  1739. (markdown-make-header-faces)
  1740. (defun markdown-update-header-faces (&optional scaling scaling-values)
  1741. "Update header faces, depending on if header SCALING is desired.
  1742. If so, use given list of SCALING-VALUES relative to the baseline
  1743. size of `markdown-header-face'."
  1744. (dotimes (num 6)
  1745. (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num))))
  1746. (scale (cond ((not scaling) 1.0)
  1747. (scaling-values (float (nth num scaling-values)))
  1748. (t (float (nth num markdown-header-scaling-values))))))
  1749. (unless (get face-name 'saved-face) ; Don't update customized faces
  1750. (set-face-attribute face-name nil :height scale)))))
  1751. (defun markdown-syntactic-face (state)
  1752. "Return font-lock face for characters with given STATE.
  1753. See `font-lock-syntactic-face-function' for details."
  1754. (let ((in-comment (nth 4 state)))
  1755. (cond
  1756. (in-comment 'markdown-comment-face)
  1757. (t nil))))
  1758. (defcustom markdown-list-item-bullets
  1759. '("" "" "" "" "" "" "")
  1760. "List of bullets to use for unordered lists.
  1761. It can contain any number of symbols, which will be repeated.
  1762. Depending on your font, some reasonable choices are:
  1763. ."
  1764. :group 'markdown
  1765. :type '(repeat (string :tag "Bullet character"))
  1766. :package-version '(markdown-mode . "2.3"))
  1767. (defun markdown--footnote-marker-properties ()
  1768. "Return a font-lock facespec expression for footnote marker text."
  1769. `(face markdown-footnote-marker-face
  1770. ,@(when markdown-hide-markup
  1771. `(display ,markdown-footnote-display))))
  1772. (defun markdown--pandoc-inline-footnote-properties ()
  1773. "Return a font-lock facespec expression for Pandoc inline footnote text."
  1774. `(face markdown-footnote-text-face
  1775. ,@(when markdown-hide-markup
  1776. `(display ,markdown-footnote-display))))
  1777. (defvar markdown-mode-font-lock-keywords
  1778. `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face)))
  1779. (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face)))
  1780. (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face)
  1781. (2 'markdown-markup-face)
  1782. (3 'markdown-metadata-value-face)))
  1783. (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties)
  1784. (2 markdown-markup-properties nil t)
  1785. (3 markdown-language-keyword-properties nil t)
  1786. (4 markdown-language-info-properties nil t)
  1787. (5 markdown-markup-properties nil t)))
  1788. (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties)))
  1789. (markdown-fontify-gfm-code-blocks)
  1790. (markdown-fontify-tables)
  1791. (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties)
  1792. (2 markdown-markup-properties nil t)
  1793. (3 markdown-language-keyword-properties nil t)
  1794. (4 markdown-language-info-properties nil t)
  1795. (5 markdown-markup-properties nil t)))
  1796. (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties)))
  1797. (markdown-fontify-fenced-code-blocks)
  1798. (markdown-match-pre-blocks . ((0 'markdown-pre-face)))
  1799. (markdown-fontify-headings)
  1800. (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face)
  1801. (2 'markdown-markup-face)
  1802. (3 'markdown-metadata-value-face)))
  1803. (markdown-match-pandoc-metadata . ((1 'markdown-markup-face)
  1804. (2 'markdown-markup-face)
  1805. (3 'markdown-metadata-value-face)))
  1806. (markdown-fontify-hrs)
  1807. (markdown-match-code . ((1 markdown-markup-properties prepend)
  1808. (2 'markdown-inline-code-face prepend)
  1809. (3 markdown-markup-properties prepend)))
  1810. (,markdown-regex-kbd . ((1 markdown-markup-properties)
  1811. (2 'markdown-inline-code-face)
  1812. (3 markdown-markup-properties)))
  1813. (markdown-fontify-angle-uris)
  1814. (,markdown-regex-email . 'markdown-plain-url-face)
  1815. (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t)
  1816. (2 'markdown-html-tag-name-face t)
  1817. (3 'markdown-html-tag-delimiter-face t)
  1818. ;; Anchored matcher for HTML tag attributes
  1819. (,markdown-regex-html-attr
  1820. ;; Before searching, move past tag
  1821. ;; name; set limit at tag close.
  1822. (progn
  1823. (goto-char (match-end 2)) (match-end 3))
  1824. nil
  1825. . ((1 'markdown-html-attr-name-face)
  1826. (3 'markdown-html-tag-delimiter-face nil t)
  1827. (4 'markdown-html-attr-value-face nil t)))))
  1828. (,markdown-regex-html-entity . 'markdown-html-entity-face)
  1829. (markdown-fontify-list-items)
  1830. (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^
  1831. (2 (markdown--footnote-marker-properties)) ; label
  1832. (3 markdown-markup-properties))) ; ]
  1833. (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^
  1834. (2 markdown-markup-properties) ; [
  1835. (3 (markdown--pandoc-inline-footnote-properties)) ; text
  1836. (4 markdown-markup-properties))) ; ]
  1837. (markdown-match-includes . ((1 markdown-markup-properties)
  1838. (2 markdown-markup-properties nil t)
  1839. (3 markdown-include-title-properties nil t)
  1840. (4 markdown-markup-properties nil t)
  1841. (5 markdown-markup-properties)
  1842. (6 'markdown-url-face)
  1843. (7 markdown-markup-properties)))
  1844. (markdown-fontify-inline-links)
  1845. (markdown-fontify-reference-links)
  1846. (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [
  1847. (2 'markdown-reference-face) ; label
  1848. (3 'markdown-markup-face) ; ]
  1849. (4 'markdown-markup-face) ; :
  1850. (5 'markdown-url-face) ; url
  1851. (6 'markdown-link-title-face))) ; "title" (optional)
  1852. (markdown-fontify-plain-uris)
  1853. ;; Math mode $..$
  1854. (markdown-match-math-single . ((1 'markdown-markup-face prepend)
  1855. (2 'markdown-math-face append)
  1856. (3 'markdown-markup-face prepend)))
  1857. ;; Math mode $$..$$
  1858. (markdown-match-math-double . ((1 'markdown-markup-face prepend)
  1859. (2 'markdown-math-face append)
  1860. (3 'markdown-markup-face prepend)))
  1861. ;; Math mode \[..\] and \\[..\\]
  1862. (markdown-match-math-display . ((1 'markdown-markup-face prepend)
  1863. (3 'markdown-math-face append)
  1864. (4 'markdown-markup-face prepend)))
  1865. (markdown-match-bold . ((1 markdown-markup-properties prepend)
  1866. (2 'markdown-bold-face append)
  1867. (3 markdown-markup-properties prepend)))
  1868. (markdown-match-italic . ((1 markdown-markup-properties prepend)
  1869. (2 'markdown-italic-face append)
  1870. (3 markdown-markup-properties prepend)))
  1871. (,markdown-regex-strike-through . ((3 markdown-markup-properties)
  1872. (4 'markdown-strike-through-face)
  1873. (5 markdown-markup-properties)))
  1874. (,markdown-regex-line-break . (1 'markdown-line-break-face prepend))
  1875. (markdown-fontify-sub-superscripts)
  1876. (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend)))
  1877. (markdown-match-leanpub-sections . ((0 markdown-markup-properties)))
  1878. (markdown-fontify-blockquotes)
  1879. (markdown-match-wiki-link . ((0 'markdown-link-face prepend))))
  1880. "Syntax highlighting for Markdown files.")
  1881. ;; Footnotes
  1882. (defvar-local markdown-footnote-counter 0
  1883. "Counter for footnote numbers.")
  1884. (defconst markdown-footnote-chars
  1885. "[[:alnum:]-]"
  1886. "Regular expression matching any character that is allowed in a footnote identifier.")
  1887. (defconst markdown-regex-footnote-definition
  1888. (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)")
  1889. "Regular expression matching a footnote definition, capturing the label.")
  1890. ;;; Compatibility =============================================================
  1891. (defun markdown-flyspell-check-word-p ()
  1892. "Return t if `flyspell' should check word just before point.
  1893. Used for `flyspell-generic-check-word-predicate'."
  1894. (save-excursion
  1895. (goto-char (1- (point)))
  1896. ;; https://github.com/jrblevin/markdown-mode/issues/560
  1897. ;; enable spell check YAML meta data
  1898. (if (or (and (markdown-code-block-at-point-p)
  1899. (not (markdown-text-property-at-point 'markdown-yaml-metadata-section)))
  1900. (markdown-inline-code-at-point-p)
  1901. (markdown-in-comment-p)
  1902. (markdown--face-p (point) '(markdown-reference-face
  1903. markdown-markup-face
  1904. markdown-plain-url-face
  1905. markdown-inline-code-face
  1906. markdown-url-face)))
  1907. (prog1 nil
  1908. ;; If flyspell overlay is put, then remove it
  1909. (let ((bounds (bounds-of-thing-at-point 'word)))
  1910. (when bounds
  1911. (cl-loop for ov in (overlays-in (car bounds) (cdr bounds))
  1912. when (overlay-get ov 'flyspell-overlay)
  1913. do
  1914. (delete-overlay ov)))))
  1915. t)))
  1916. ;;; Markdown Parsing Functions ================================================
  1917. (defun markdown-cur-line-blank-p ()
  1918. "Return t if the current line is blank and nil otherwise."
  1919. (save-excursion
  1920. (beginning-of-line)
  1921. (looking-at-p markdown-regex-blank-line)))
  1922. (defun markdown-prev-line-blank ()
  1923. "Return t if the previous line is blank and nil otherwise.
  1924. If we are at the first line, then consider the previous line to be blank."
  1925. (or (= (line-beginning-position) (point-min))
  1926. (save-excursion
  1927. (forward-line -1)
  1928. (looking-at markdown-regex-blank-line))))
  1929. (defun markdown-prev-line-blank-p ()
  1930. "Like `markdown-prev-line-blank', but preserve `match-data'."
  1931. (save-match-data (markdown-prev-line-blank)))
  1932. (defun markdown-next-line-blank-p ()
  1933. "Return t if the next line is blank and nil otherwise.
  1934. If we are at the last line, then consider the next line to be blank."
  1935. (or (= (line-end-position) (point-max))
  1936. (save-excursion
  1937. (forward-line 1)
  1938. (markdown-cur-line-blank-p))))
  1939. (defun markdown-prev-line-indent ()
  1940. "Return the number of leading whitespace characters in the previous line.
  1941. Return 0 if the current line is the first line in the buffer."
  1942. (save-excursion
  1943. (if (= (line-beginning-position) (point-min))
  1944. 0
  1945. (forward-line -1)
  1946. (current-indentation))))
  1947. (defun markdown-next-line-indent ()
  1948. "Return the number of leading whitespace characters in the next line.
  1949. Return 0 if line is the last line in the buffer."
  1950. (save-excursion
  1951. (if (= (line-end-position) (point-max))
  1952. 0
  1953. (forward-line 1)
  1954. (current-indentation))))
  1955. (defun markdown-new-baseline ()
  1956. "Determine if the current line begins a new baseline level.
  1957. Assume point is positioned at beginning of line."
  1958. (or (looking-at markdown-regex-header)
  1959. (looking-at markdown-regex-hr)
  1960. (and (= (current-indentation) 0)
  1961. (not (looking-at markdown-regex-list))
  1962. (markdown-prev-line-blank))))
  1963. (defun markdown-search-backward-baseline ()
  1964. "Search backward baseline point with no indentation and not a list item."
  1965. (end-of-line)
  1966. (let (stop)
  1967. (while (not (or stop (bobp)))
  1968. (re-search-backward markdown-regex-block-separator-noindent nil t)
  1969. (when (match-end 2)
  1970. (goto-char (match-end 2))
  1971. (cond
  1972. ((markdown-new-baseline)
  1973. (setq stop t))
  1974. ((looking-at-p markdown-regex-list)
  1975. (setq stop nil))
  1976. (t (setq stop t)))))))
  1977. (defun markdown-update-list-levels (marker indent levels)
  1978. "Update list levels given list MARKER, block INDENT, and current LEVELS.
  1979. Here, MARKER is a string representing the type of list, INDENT is an integer
  1980. giving the indentation, in spaces, of the current block, and LEVELS is a
  1981. list of the indentation levels of parent list items. When LEVELS is nil,
  1982. it means we are at baseline (not inside of a nested list)."
  1983. (cond
  1984. ;; New list item at baseline.
  1985. ((and marker (null levels))
  1986. (setq levels (list indent)))
  1987. ;; List item with greater indentation (four or more spaces).
  1988. ;; Increase list level.
  1989. ((and marker (>= indent (+ (car levels) markdown-list-indent-width)))
  1990. (setq levels (cons indent levels)))
  1991. ;; List item with greater or equal indentation (less than four spaces).
  1992. ;; Do not increase list level.
  1993. ((and marker (>= indent (car levels)))
  1994. levels)
  1995. ;; Lesser indentation level.
  1996. ;; Pop appropriate number of elements off LEVELS list (e.g., lesser
  1997. ;; indentation could move back more than one list level). Note
  1998. ;; that this block need not be the beginning of list item.
  1999. ((< indent (car levels))
  2000. (while (and (> (length levels) 1)
  2001. (< indent (+ (cadr levels) markdown-list-indent-width)))
  2002. (setq levels (cdr levels)))
  2003. levels)
  2004. ;; Otherwise, do nothing.
  2005. (t levels)))
  2006. (defun markdown-calculate-list-levels ()
  2007. "Calculate list levels at point.
  2008. Return a list of the form (n1 n2 n3 ...) where n1 is the
  2009. indentation of the deepest nested list item in the branch of
  2010. the list at the point, n2 is the indentation of the parent
  2011. list item, and so on. The depth of the list item is therefore
  2012. the length of the returned list. If the point is not at or
  2013. immediately after a list item, return nil."
  2014. (save-excursion
  2015. (let ((first (point)) levels indent pre-regexp)
  2016. ;; Find a baseline point with zero list indentation
  2017. (markdown-search-backward-baseline)
  2018. ;; Search for all list items between baseline and LOC
  2019. (while (and (< (point) first)
  2020. (re-search-forward markdown-regex-list first t))
  2021. (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels))))
  2022. (beginning-of-line)
  2023. (cond
  2024. ;; Make sure this is not a header or hr
  2025. ((markdown-new-baseline) (setq levels nil))
  2026. ;; Make sure this is not a line from a pre block
  2027. ((looking-at-p pre-regexp))
  2028. ;; If not, then update levels
  2029. (t
  2030. (setq indent (current-indentation))
  2031. (setq levels (markdown-update-list-levels (match-string 2)
  2032. indent levels))))
  2033. (end-of-line))
  2034. levels)))
  2035. (defun markdown-prev-list-item (level)
  2036. "Search backward from point for a list item with indentation LEVEL.
  2037. Set point to the beginning of the item, and return point, or nil
  2038. upon failure."
  2039. (let (bounds indent prev)
  2040. (setq prev (point))
  2041. (forward-line -1)
  2042. (setq indent (current-indentation))
  2043. (while
  2044. (cond
  2045. ;; List item
  2046. ((and (looking-at-p markdown-regex-list)
  2047. (setq bounds (markdown-cur-list-item-bounds)))
  2048. (cond
  2049. ;; Stop and return point at item of equal indentation
  2050. ((= (nth 3 bounds) level)
  2051. (setq prev (point))
  2052. nil)
  2053. ;; Stop and return nil at item with lesser indentation
  2054. ((< (nth 3 bounds) level)
  2055. (setq prev nil)
  2056. nil)
  2057. ;; Stop at beginning of buffer
  2058. ((bobp) (setq prev nil))
  2059. ;; Continue at item with greater indentation
  2060. ((> (nth 3 bounds) level) t)))
  2061. ;; Stop at beginning of buffer
  2062. ((bobp) (setq prev nil))
  2063. ;; Continue if current line is blank
  2064. ((markdown-cur-line-blank-p) t)
  2065. ;; Continue while indentation is the same or greater
  2066. ((>= indent level) t)
  2067. ;; Stop if current indentation is less than list item
  2068. ;; and the next is blank
  2069. ((and (< indent level)
  2070. (markdown-next-line-blank-p))
  2071. (setq prev nil))
  2072. ;; Stop at a header
  2073. ((looking-at-p markdown-regex-header) (setq prev nil))
  2074. ;; Stop at a horizontal rule
  2075. ((looking-at-p markdown-regex-hr) (setq prev nil))
  2076. ;; Otherwise, continue.
  2077. (t t))
  2078. (forward-line -1)
  2079. (setq indent (current-indentation)))
  2080. prev))
  2081. (defun markdown-next-list-item (level)
  2082. "Search forward from point for the next list item with indentation LEVEL.
  2083. Set point to the beginning of the item, and return point, or nil
  2084. upon failure."
  2085. (let (bounds indent next)
  2086. (setq next (point))
  2087. (if (looking-at markdown-regex-header-setext)
  2088. (goto-char (match-end 0)))
  2089. (forward-line)
  2090. (setq indent (current-indentation))
  2091. (while
  2092. (cond
  2093. ;; Stop at end of the buffer.
  2094. ((eobp) nil)
  2095. ;; Continue if the current line is blank
  2096. ((markdown-cur-line-blank-p) t)
  2097. ;; List item
  2098. ((and (looking-at-p markdown-regex-list)
  2099. (setq bounds (markdown-cur-list-item-bounds)))
  2100. (cond
  2101. ;; Continue at item with greater indentation
  2102. ((> (nth 3 bounds) level) t)
  2103. ;; Stop and return point at item of equal indentation
  2104. ((= (nth 3 bounds) level)
  2105. (setq next (point))
  2106. nil)
  2107. ;; Stop and return nil at item with lesser indentation
  2108. ((< (nth 3 bounds) level)
  2109. (setq next nil)
  2110. nil)))
  2111. ;; Continue while indentation is the same or greater
  2112. ((>= indent level) t)
  2113. ;; Stop if current indentation is less than list item
  2114. ;; and the previous line was blank.
  2115. ((and (< indent level)
  2116. (markdown-prev-line-blank-p))
  2117. (setq next nil))
  2118. ;; Stop at a header
  2119. ((looking-at-p markdown-regex-header) (setq next nil))
  2120. ;; Stop at a horizontal rule
  2121. ((looking-at-p markdown-regex-hr) (setq next nil))
  2122. ;; Otherwise, continue.
  2123. (t t))
  2124. (forward-line)
  2125. (setq indent (current-indentation)))
  2126. next))
  2127. (defun markdown-cur-list-item-end (level)
  2128. "Move to end of list item with pre-marker indentation LEVEL.
  2129. Return the point at the end when a list item was found at the
  2130. original point. If the point is not in a list item, do nothing."
  2131. (let (indent)
  2132. (forward-line)
  2133. (setq indent (current-indentation))
  2134. (while
  2135. (cond
  2136. ;; Stop at end of the buffer.
  2137. ((eobp) nil)
  2138. ;; Continue while indentation is the same or greater
  2139. ((>= indent level) t)
  2140. ;; Continue if the current line is blank
  2141. ((looking-at markdown-regex-blank-line) t)
  2142. ;; Stop if current indentation is less than list item
  2143. ;; and the previous line was blank.
  2144. ((and (< indent level)
  2145. (markdown-prev-line-blank))
  2146. nil)
  2147. ;; Stop at a new list items of the same or lesser
  2148. ;; indentation, headings, and horizontal rules.
  2149. ((looking-at (concat "\\(?:" markdown-regex-list
  2150. "\\|" markdown-regex-header
  2151. "\\|" markdown-regex-hr "\\)"))
  2152. nil)
  2153. ;; Otherwise, continue.
  2154. (t t))
  2155. (forward-line)
  2156. (setq indent (current-indentation)))
  2157. ;; Don't skip over whitespace for empty list items (marker and
  2158. ;; whitespace only), just move to end of whitespace.
  2159. (if (save-excursion
  2160. (beginning-of-line)
  2161. (looking-at (concat markdown-regex-list "[ \t]*$")))
  2162. (goto-char (match-end 3))
  2163. (skip-chars-backward " \t\n"))
  2164. (end-of-line)
  2165. (point)))
  2166. (defun markdown-cur-list-item-bounds ()
  2167. "Return bounds for list item at point.
  2168. Return a list of the following form:
  2169. (begin end indent nonlist-indent marker checkbox match)
  2170. The named components are:
  2171. - begin: Position of beginning of list item, including leading indentation.
  2172. - end: Position of the end of the list item, including list item text.
  2173. - indent: Number of characters of indentation before list marker (an integer).
  2174. - nonlist-indent: Number characters of indentation, list
  2175. marker, and whitespace following list marker (an integer).
  2176. - marker: String containing the list marker and following whitespace
  2177. (e.g., \"- \" or \"* \").
  2178. - checkbox: String containing the GFM checkbox portion, if any,
  2179. including any trailing whitespace before the text
  2180. begins (e.g., \"[x] \").
  2181. - match: match data for markdown-regex-list
  2182. As an example, for the following unordered list item
  2183. - item
  2184. the returned list would be
  2185. (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6))
  2186. If the point is not inside a list item, return nil."
  2187. (car (get-text-property (point-at-bol) 'markdown-list-item)))
  2188. (defun markdown-list-item-at-point-p ()
  2189. "Return t if there is a list item at the point and nil otherwise."
  2190. (save-match-data (markdown-cur-list-item-bounds)))
  2191. (defun markdown-prev-list-item-bounds ()
  2192. "Return bounds of previous item in the same list of any level.
  2193. The return value has the same form as that of
  2194. `markdown-cur-list-item-bounds'."
  2195. (save-excursion
  2196. (let ((cur-bounds (markdown-cur-list-item-bounds))
  2197. (beginning-of-list (save-excursion (markdown-beginning-of-list)))
  2198. stop)
  2199. (when cur-bounds
  2200. (goto-char (nth 0 cur-bounds))
  2201. (while (and (not stop) (not (bobp))
  2202. (re-search-backward markdown-regex-list
  2203. beginning-of-list t))
  2204. (unless (or (looking-at markdown-regex-hr)
  2205. (markdown-code-block-at-point-p))
  2206. (setq stop (point))))
  2207. (markdown-cur-list-item-bounds)))))
  2208. (defun markdown-next-list-item-bounds ()
  2209. "Return bounds of next item in the same list of any level.
  2210. The return value has the same form as that of
  2211. `markdown-cur-list-item-bounds'."
  2212. (save-excursion
  2213. (let ((cur-bounds (markdown-cur-list-item-bounds))
  2214. (end-of-list (save-excursion (markdown-end-of-list)))
  2215. stop)
  2216. (when cur-bounds
  2217. (goto-char (nth 0 cur-bounds))
  2218. (end-of-line)
  2219. (while (and (not stop) (not (eobp))
  2220. (re-search-forward markdown-regex-list
  2221. end-of-list t))
  2222. (unless (or (looking-at markdown-regex-hr)
  2223. (markdown-code-block-at-point-p))
  2224. (setq stop (point))))
  2225. (when stop
  2226. (markdown-cur-list-item-bounds))))))
  2227. (defun markdown-beginning-of-list ()
  2228. "Move point to beginning of list at point, if any."
  2229. (interactive)
  2230. (let ((orig-point (point))
  2231. (list-begin (save-excursion
  2232. (markdown-search-backward-baseline)
  2233. ;; Stop at next list item, regardless of the indentation.
  2234. (markdown-next-list-item (point-max))
  2235. (when (looking-at markdown-regex-list)
  2236. (point)))))
  2237. (when (and list-begin (<= list-begin orig-point))
  2238. (goto-char list-begin))))
  2239. (defun markdown-end-of-list ()
  2240. "Move point to end of list at point, if any."
  2241. (interactive)
  2242. (let ((start (point))
  2243. (end (save-excursion
  2244. (when (markdown-beginning-of-list)
  2245. ;; Items can't have nonlist-indent <= 1, so this
  2246. ;; moves past all list items.
  2247. (markdown-next-list-item 1)
  2248. (skip-syntax-backward "-")
  2249. (unless (eobp) (forward-char 1))
  2250. (point)))))
  2251. (when (and end (>= end start))
  2252. (goto-char end))))
  2253. (defun markdown-up-list ()
  2254. "Move point to beginning of parent list item."
  2255. (interactive)
  2256. (let ((cur-bounds (markdown-cur-list-item-bounds)))
  2257. (when cur-bounds
  2258. (markdown-prev-list-item (1- (nth 3 cur-bounds)))
  2259. (let ((up-bounds (markdown-cur-list-item-bounds)))
  2260. (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds)))
  2261. (point))))))
  2262. (defun markdown-bounds-of-thing-at-point (thing)
  2263. "Call `bounds-of-thing-at-point' for THING with slight modifications.
  2264. Does not include trailing newlines when THING is 'line. Handles the
  2265. end of buffer case by setting both endpoints equal to the value of
  2266. `point-max', since an empty region will trigger empty markup insertion.
  2267. Return bounds of form (beg . end) if THING is found, or nil otherwise."
  2268. (let* ((bounds (bounds-of-thing-at-point thing))
  2269. (a (car bounds))
  2270. (b (cdr bounds)))
  2271. (when bounds
  2272. (when (eq thing 'line)
  2273. (cond ((and (eobp) (markdown-cur-line-blank-p))
  2274. (setq a b))
  2275. ((char-equal (char-before b) ?\^J)
  2276. (setq b (1- b)))))
  2277. (cons a b))))
  2278. (defun markdown-reference-definition (reference)
  2279. "Find out whether Markdown REFERENCE is defined.
  2280. REFERENCE should not include the square brackets.
  2281. When REFERENCE is defined, return a list of the form (text start end)
  2282. containing the definition text itself followed by the start and end
  2283. locations of the text. Otherwise, return nil.
  2284. Leave match data for `markdown-regex-reference-definition'
  2285. intact additional processing."
  2286. (let ((reference (downcase reference)))
  2287. (save-excursion
  2288. (goto-char (point-min))
  2289. (catch 'found
  2290. (while (re-search-forward markdown-regex-reference-definition nil t)
  2291. (when (string= reference (downcase (match-string-no-properties 2)))
  2292. (throw 'found
  2293. (list (match-string-no-properties 5)
  2294. (match-beginning 5) (match-end 5)))))))))
  2295. (defun markdown-get-defined-references ()
  2296. "Return all defined reference labels and their line numbers (not including square brackets)."
  2297. (save-excursion
  2298. (goto-char (point-min))
  2299. (let (refs)
  2300. (while (re-search-forward markdown-regex-reference-definition nil t)
  2301. (let ((target (match-string-no-properties 2)))
  2302. (cl-pushnew
  2303. (cons (downcase target)
  2304. (markdown-line-number-at-pos (match-beginning 2)))
  2305. refs :test #'equal :key #'car)))
  2306. (reverse refs))))
  2307. (defun markdown-get-used-uris ()
  2308. "Return a list of all used URIs in the buffer."
  2309. (save-excursion
  2310. (goto-char (point-min))
  2311. (let (uris)
  2312. (while (re-search-forward
  2313. (concat "\\(?:" markdown-regex-link-inline
  2314. "\\|" markdown-regex-angle-uri
  2315. "\\|" markdown-regex-uri
  2316. "\\|" markdown-regex-email
  2317. "\\)")
  2318. nil t)
  2319. (unless (or (markdown-inline-code-at-point-p)
  2320. (markdown-code-block-at-point-p))
  2321. (cl-pushnew (or (match-string-no-properties 6)
  2322. (match-string-no-properties 10)
  2323. (match-string-no-properties 12)
  2324. (match-string-no-properties 13))
  2325. uris :test #'equal)))
  2326. (reverse uris))))
  2327. (defun markdown-inline-code-at-pos (pos)
  2328. "Return non-nil if there is an inline code fragment at POS.
  2329. Return nil otherwise. Set match data according to
  2330. `markdown-match-code' upon success.
  2331. This function searches the block for a code fragment that
  2332. contains the point using `markdown-match-code'. We do this
  2333. because `thing-at-point-looking-at' does not work reliably with
  2334. `markdown-regex-code'.
  2335. The match data is set as follows:
  2336. Group 1 matches the opening backquotes.
  2337. Group 2 matches the code fragment itself, without backquotes.
  2338. Group 3 matches the closing backquotes."
  2339. (save-excursion
  2340. (goto-char pos)
  2341. (let ((old-point (point))
  2342. (end-of-block (progn (markdown-end-of-text-block) (point)))
  2343. found)
  2344. (markdown-beginning-of-text-block)
  2345. (while (and (markdown-match-code end-of-block)
  2346. (setq found t)
  2347. (< (match-end 0) old-point)))
  2348. (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1)))
  2349. (and found ; matched something
  2350. (<= (match-beginning match-group) old-point) ; match contains old-point
  2351. (> (match-end 0) old-point))))))
  2352. (defun markdown-inline-code-at-pos-p (pos)
  2353. "Return non-nil if there is an inline code fragment at POS.
  2354. Like `markdown-inline-code-at-pos`, but preserves match data."
  2355. (save-match-data (markdown-inline-code-at-pos pos)))
  2356. (defun markdown-inline-code-at-point ()
  2357. "Return non-nil if the point is at an inline code fragment.
  2358. See `markdown-inline-code-at-pos' for details."
  2359. (markdown-inline-code-at-pos (point)))
  2360. (defun markdown-inline-code-at-point-p (&optional pos)
  2361. "Return non-nil if there is inline code at the POS.
  2362. This is a predicate function counterpart to
  2363. `markdown-inline-code-at-point' which does not modify the match
  2364. data. See `markdown-code-block-at-point-p' for code blocks."
  2365. (save-match-data (markdown-inline-code-at-pos (or pos (point)))))
  2366. (defun markdown-code-block-at-pos (pos)
  2367. "Return match data list if there is a code block at POS.
  2368. Uses text properties at the beginning of the line position.
  2369. This includes pre blocks, tilde-fenced code blocks, and GFM
  2370. quoted code blocks. Return nil otherwise."
  2371. (let ((bol (save-excursion (goto-char pos) (point-at-bol))))
  2372. (or (get-text-property bol 'markdown-pre)
  2373. (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos))
  2374. (second (cl-second bounds)))
  2375. (if second
  2376. ;; chunks are right open
  2377. (when (< pos second)
  2378. bounds)
  2379. bounds)))))
  2380. ;; Function was renamed to emphasize that it does not modify match-data.
  2381. (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p)
  2382. (defun markdown-code-block-at-point-p (&optional pos)
  2383. "Return non-nil if there is a code block at the POS.
  2384. This includes pre blocks, tilde-fenced code blocks, and GFM
  2385. quoted code blocks. This function does not modify the match
  2386. data. See `markdown-inline-code-at-point-p' for inline code."
  2387. (save-match-data (markdown-code-block-at-pos (or pos (point)))))
  2388. (defun markdown-heading-at-point (&optional pos)
  2389. "Return non-nil if there is a heading at the POS.
  2390. Set match data for `markdown-regex-header'."
  2391. (let ((match-data (get-text-property (or pos (point)) 'markdown-heading)))
  2392. (when match-data
  2393. (set-match-data match-data)
  2394. t)))
  2395. (defun markdown-pipe-at-bol-p ()
  2396. "Return non-nil if the line begins with a pipe symbol.
  2397. This may be useful for tables and Pandoc's line_blocks extension."
  2398. (char-equal (char-after (point-at-bol)) ?|))
  2399. ;;; Markdown Font Lock Matching Functions =====================================
  2400. (defun markdown-range-property-any (begin end prop prop-values)
  2401. "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES.
  2402. Also returns t if PROP is a list containing one of the PROP-VALUES.
  2403. Return nil otherwise."
  2404. (let (props)
  2405. (catch 'found
  2406. (dolist (loc (number-sequence begin end))
  2407. (when (setq props (get-text-property loc prop))
  2408. (cond ((listp props)
  2409. ;; props is a list, check for membership
  2410. (dolist (val prop-values)
  2411. (when (memq val props) (throw 'found loc))))
  2412. (t
  2413. ;; props is a scalar, check for equality
  2414. (dolist (val prop-values)
  2415. (when (eq val props) (throw 'found loc))))))))))
  2416. (defun markdown-range-properties-exist (begin end props)
  2417. (cl-loop
  2418. for loc in (number-sequence begin end)
  2419. with result = nil
  2420. while (not
  2421. (setq result
  2422. (cl-some (lambda (prop) (get-text-property loc prop)) props)))
  2423. finally return result))
  2424. (defun markdown-match-inline-generic (regex last &optional faceless)
  2425. "Match inline REGEX from the point to LAST.
  2426. When FACELESS is non-nil, do not return matches where faces have been applied."
  2427. (when (re-search-forward regex last t)
  2428. (let ((bounds (markdown-code-block-at-pos (match-beginning 1)))
  2429. (face (and faceless (text-property-not-all
  2430. (match-beginning 0) (match-end 0) 'face nil))))
  2431. (cond
  2432. ;; In code block: move past it and recursively search again
  2433. (bounds
  2434. (when (< (goto-char (cl-second bounds)) last)
  2435. (markdown-match-inline-generic regex last faceless)))
  2436. ;; When faces are found in the match range, skip over the match and
  2437. ;; recursively search again.
  2438. (face
  2439. (when (< (goto-char (match-end 0)) last)
  2440. (markdown-match-inline-generic regex last faceless)))
  2441. ;; Keep match data and return t when in bounds.
  2442. (t
  2443. (<= (match-end 0) last))))))
  2444. (defun markdown-match-code (last)
  2445. "Match inline code fragments from point to LAST."
  2446. (unless (bobp)
  2447. (backward-char 1))
  2448. (when (markdown-search-until-condition
  2449. (lambda ()
  2450. (and
  2451. ;; Advance point in case of failure, but without exceeding last.
  2452. (goto-char (min (1+ (match-beginning 1)) last))
  2453. (not (markdown-in-comment-p (match-beginning 1)))
  2454. (not (markdown-in-comment-p (match-end 1)))
  2455. (not (markdown-code-block-at-pos (match-beginning 1)))))
  2456. markdown-regex-code last t)
  2457. (set-match-data (list (match-beginning 1) (match-end 1)
  2458. (match-beginning 2) (match-end 2)
  2459. (match-beginning 3) (match-end 3)
  2460. (match-beginning 4) (match-end 4)))
  2461. (goto-char (min (1+ (match-end 0)) last (point-max)))
  2462. t))
  2463. (defun markdown--gfm-markup-underscore-p (begin end)
  2464. (let ((is-underscore (eql (char-after begin) ?_)))
  2465. (if (not is-underscore)
  2466. t
  2467. (save-excursion
  2468. (save-match-data
  2469. (goto-char begin)
  2470. (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin))
  2471. (progn
  2472. (goto-char end)
  2473. (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)"))))))))
  2474. (defun markdown-match-bold (last)
  2475. "Match inline bold from the point to LAST."
  2476. (when (markdown-match-inline-generic markdown-regex-bold last)
  2477. (let ((is-gfm (derived-mode-p 'gfm-mode))
  2478. (begin (match-beginning 2))
  2479. (end (match-end 2)))
  2480. (if (or (markdown-inline-code-at-pos-p begin)
  2481. (markdown-inline-code-at-pos-p end)
  2482. (markdown-in-comment-p)
  2483. (markdown-range-property-any
  2484. begin begin 'face '(markdown-url-face
  2485. markdown-plain-url-face))
  2486. (markdown-range-property-any
  2487. begin end 'face '(markdown-hr-face
  2488. markdown-math-face))
  2489. (and is-gfm (not (markdown--gfm-markup-underscore-p begin end))))
  2490. (progn (goto-char (min (1+ begin) last))
  2491. (when (< (point) last)
  2492. (markdown-match-bold last)))
  2493. (set-match-data (list (match-beginning 2) (match-end 2)
  2494. (match-beginning 3) (match-end 3)
  2495. (match-beginning 4) (match-end 4)
  2496. (match-beginning 5) (match-end 5)))
  2497. t))))
  2498. (defun markdown-match-italic (last)
  2499. "Match inline italics from the point to LAST."
  2500. (let* ((is-gfm (derived-mode-p 'gfm-mode))
  2501. (regex (if is-gfm
  2502. markdown-regex-gfm-italic
  2503. markdown-regex-italic)))
  2504. (when (and (markdown-match-inline-generic regex last)
  2505. (not (markdown--face-p
  2506. (match-beginning 1)
  2507. '(markdown-html-attr-name-face markdown-html-attr-value-face))))
  2508. (let ((begin (match-beginning 1))
  2509. (end (match-end 1))
  2510. (close-end (match-end 4)))
  2511. (if (or (eql (char-before begin) (char-after begin))
  2512. (markdown-inline-code-at-pos-p begin)
  2513. (markdown-inline-code-at-pos-p (1- end))
  2514. (markdown-in-comment-p)
  2515. (markdown-range-property-any
  2516. begin begin 'face '(markdown-url-face
  2517. markdown-plain-url-face))
  2518. (markdown-range-property-any
  2519. begin end 'face '(markdown-bold-face
  2520. markdown-list-face
  2521. markdown-hr-face
  2522. markdown-math-face))
  2523. (and is-gfm
  2524. (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case
  2525. (not (markdown--gfm-markup-underscore-p begin close-end)))))
  2526. (progn (goto-char (min (1+ begin) last))
  2527. (when (< (point) last)
  2528. (markdown-match-italic last)))
  2529. (set-match-data (list (match-beginning 1) (match-end 1)
  2530. (match-beginning 2) (match-end 2)
  2531. (match-beginning 3) (match-end 3)
  2532. (match-beginning 4) (match-end 4)))
  2533. t)))))
  2534. (defun markdown-match-math-generic (regex last)
  2535. "Match REGEX from point to LAST.
  2536. REGEX is either `markdown-regex-math-inline-single' for matching
  2537. $..$ or `markdown-regex-math-inline-double' for matching $$..$$."
  2538. (when (markdown-match-inline-generic regex last)
  2539. (let ((begin (match-beginning 1)) (end (match-end 1)))
  2540. (prog1
  2541. (if (or (markdown-range-property-any
  2542. begin end 'face
  2543. '(markdown-inline-code-face markdown-bold-face))
  2544. (markdown-range-properties-exist
  2545. begin end
  2546. (markdown-get-fenced-block-middle-properties)))
  2547. (markdown-match-math-generic regex last)
  2548. t)
  2549. (goto-char (1+ (match-end 0)))))))
  2550. (defun markdown-match-list-items (last)
  2551. "Match list items from point to LAST."
  2552. (let* ((first (point))
  2553. (pos first)
  2554. (prop 'markdown-list-item)
  2555. (bounds (car (get-text-property pos prop))))
  2556. (while
  2557. (and (or (null (setq bounds (car (get-text-property pos prop))))
  2558. (< (cl-first bounds) pos))
  2559. (< (point) last)
  2560. (setq pos (next-single-property-change pos prop nil last))
  2561. (goto-char pos)))
  2562. (when bounds
  2563. (set-match-data (cl-seventh bounds))
  2564. ;; Step at least one character beyond point. Otherwise
  2565. ;; `font-lock-fontify-keywords-region' infloops.
  2566. (goto-char (min (1+ (max (point-at-eol) first))
  2567. (point-max)))
  2568. t)))
  2569. (defun markdown-match-math-single (last)
  2570. "Match single quoted $..$ math from point to LAST."
  2571. (when markdown-enable-math
  2572. (when (and (char-equal (char-after) ?$)
  2573. (not (bolp))
  2574. (not (char-equal (char-before) ?\\))
  2575. (not (char-equal (char-before) ?$)))
  2576. (forward-char -1))
  2577. (markdown-match-math-generic markdown-regex-math-inline-single last)))
  2578. (defun markdown-match-math-double (last)
  2579. "Match double quoted $$..$$ math from point to LAST."
  2580. (when markdown-enable-math
  2581. (when (and (char-equal (char-after) ?$)
  2582. (char-equal (char-after (1+ (point))) ?$)
  2583. (not (bolp))
  2584. (not (char-equal (char-before) ?\\))
  2585. (not (char-equal (char-before) ?$)))
  2586. (forward-char -1))
  2587. (markdown-match-math-generic markdown-regex-math-inline-double last)))
  2588. (defun markdown-match-math-display (last)
  2589. "Match bracketed display math \[..\] and \\[..\\] from point to LAST."
  2590. (when markdown-enable-math
  2591. (markdown-match-math-generic markdown-regex-math-display last)))
  2592. (defun markdown-match-propertized-text (property last)
  2593. "Match text with PROPERTY from point to LAST.
  2594. Restore match data previously stored in PROPERTY."
  2595. (let ((saved (get-text-property (point) property))
  2596. pos)
  2597. (unless saved
  2598. (setq pos (next-single-property-change (point) property nil last))
  2599. (unless (= pos last)
  2600. (setq saved (get-text-property pos property))))
  2601. (when saved
  2602. (set-match-data saved)
  2603. ;; Step at least one character beyond point. Otherwise
  2604. ;; `font-lock-fontify-keywords-region' infloops.
  2605. (goto-char (min (1+ (max (match-end 0) (point)))
  2606. (point-max)))
  2607. saved)))
  2608. (defun markdown-match-pre-blocks (last)
  2609. "Match preformatted blocks from point to LAST.
  2610. Use data stored in 'markdown-pre text property during syntax
  2611. analysis."
  2612. (markdown-match-propertized-text 'markdown-pre last))
  2613. (defun markdown-match-gfm-code-blocks (last)
  2614. "Match GFM quoted code blocks from point to LAST.
  2615. Use data stored in 'markdown-gfm-code text property during syntax
  2616. analysis."
  2617. (markdown-match-propertized-text 'markdown-gfm-code last))
  2618. (defun markdown-match-gfm-open-code-blocks (last)
  2619. (markdown-match-propertized-text 'markdown-gfm-block-begin last))
  2620. (defun markdown-match-gfm-close-code-blocks (last)
  2621. (markdown-match-propertized-text 'markdown-gfm-block-end last))
  2622. (defun markdown-match-fenced-code-blocks (last)
  2623. "Match fenced code blocks from the point to LAST."
  2624. (markdown-match-propertized-text 'markdown-fenced-code last))
  2625. (defun markdown-match-fenced-start-code-block (last)
  2626. (markdown-match-propertized-text 'markdown-tilde-fence-begin last))
  2627. (defun markdown-match-fenced-end-code-block (last)
  2628. (markdown-match-propertized-text 'markdown-tilde-fence-end last))
  2629. (defun markdown-match-blockquotes (last)
  2630. "Match blockquotes from point to LAST.
  2631. Use data stored in 'markdown-blockquote text property during syntax
  2632. analysis."
  2633. (markdown-match-propertized-text 'markdown-blockquote last))
  2634. (defun markdown-match-hr (last)
  2635. "Match horizontal rules comments from the point to LAST."
  2636. (markdown-match-propertized-text 'markdown-hr last))
  2637. (defun markdown-match-comments (last)
  2638. "Match HTML comments from the point to LAST."
  2639. (when (and (skip-syntax-forward "^<" last))
  2640. (let ((beg (point)))
  2641. (when (and (skip-syntax-forward "^>" last) (< (point) last))
  2642. (forward-char)
  2643. (set-match-data (list beg (point)))
  2644. t))))
  2645. (defun markdown-match-generic-links (last ref)
  2646. "Match inline links from point to LAST.
  2647. When REF is non-nil, match reference links instead of standard
  2648. links with URLs.
  2649. This function should only be used during font-lock, as it
  2650. determines syntax based on the presence of faces for previously
  2651. processed elements."
  2652. ;; Search for the next potential link (not in a code block).
  2653. (let ((prohibited-faces '(markdown-pre-face
  2654. markdown-code-face
  2655. markdown-inline-code-face
  2656. markdown-comment-face))
  2657. found)
  2658. (while
  2659. (and (not found) (< (point) last)
  2660. (progn
  2661. ;; Clear match data to test for a match after functions returns.
  2662. (set-match-data nil)
  2663. ;; Preliminary regular expression search so we can return
  2664. ;; quickly upon failure. This doesn't handle malformed links
  2665. ;; or nested square brackets well, so if it passes we back up
  2666. ;; continue with a more precise search.
  2667. (re-search-forward
  2668. (if ref
  2669. markdown-regex-link-reference
  2670. markdown-regex-link-inline)
  2671. last 'limit)))
  2672. ;; Keep searching if this is in a code block, inline code, or a
  2673. ;; comment, or if it is include syntax. The link text portion
  2674. ;; (group 3) may contain inline code or comments, but the
  2675. ;; markup, URL, and title should not be part of such elements.
  2676. (if (or (markdown-range-property-any
  2677. (match-beginning 0) (match-end 2) 'face prohibited-faces)
  2678. (markdown-range-property-any
  2679. (match-beginning 4) (match-end 0) 'face prohibited-faces)
  2680. (and (char-equal (char-after (point-at-bol)) ?<)
  2681. (char-equal (char-after (1+ (point-at-bol))) ?<)))
  2682. (set-match-data nil)
  2683. (setq found t))))
  2684. ;; Match opening exclamation point (optional) and left bracket.
  2685. (when (match-beginning 2)
  2686. (let* ((bang (match-beginning 1))
  2687. (first-begin (match-beginning 2))
  2688. ;; Find end of block to prevent matching across blocks.
  2689. (end-of-block (save-excursion
  2690. (progn
  2691. (goto-char (match-beginning 2))
  2692. (markdown-end-of-text-block)
  2693. (point))))
  2694. ;; Move over balanced expressions to closing right bracket.
  2695. ;; Catch unbalanced expression errors and return nil.
  2696. (first-end (condition-case nil
  2697. (and (goto-char first-begin)
  2698. (scan-sexps (point) 1))
  2699. (error nil)))
  2700. ;; Continue with point at CONT-POINT upon failure.
  2701. (cont-point (min (1+ first-begin) last))
  2702. second-begin second-end url-begin url-end
  2703. title-begin title-end)
  2704. ;; When bracket found, in range, and followed by a left paren/bracket...
  2705. (when (and first-end (< first-end end-of-block) (goto-char first-end)
  2706. (char-equal (char-after (point)) (if ref ?\[ ?\()))
  2707. ;; Scan across balanced expressions for closing parenthesis/bracket.
  2708. (setq second-begin (point)
  2709. second-end (condition-case nil
  2710. (scan-sexps (point) 1)
  2711. (error nil)))
  2712. ;; Check that closing parenthesis/bracket is in range.
  2713. (if (and second-end (<= second-end end-of-block) (<= second-end last))
  2714. (progn
  2715. ;; Search for (optional) title inside closing parenthesis
  2716. (when (and (not ref) (search-forward "\"" second-end t))
  2717. (setq title-begin (1- (point))
  2718. title-end (and (goto-char second-end)
  2719. (search-backward "\"" (1+ title-begin) t))
  2720. title-end (and title-end (1+ title-end))))
  2721. ;; Store URL/reference range
  2722. (setq url-begin (1+ second-begin)
  2723. url-end (1- (or title-begin second-end)))
  2724. ;; Set match data, move point beyond link, and return
  2725. (set-match-data
  2726. (list (or bang first-begin) second-end ; 0 - all
  2727. bang (and bang (1+ bang)) ; 1 - bang
  2728. first-begin (1+ first-begin) ; 2 - markup
  2729. (1+ first-begin) (1- first-end) ; 3 - link text
  2730. (1- first-end) first-end ; 4 - markup
  2731. second-begin (1+ second-begin) ; 5 - markup
  2732. url-begin url-end ; 6 - url/reference
  2733. title-begin title-end ; 7 - title
  2734. (1- second-end) second-end)) ; 8 - markup
  2735. ;; Nullify cont-point and leave point at end and
  2736. (setq cont-point nil)
  2737. (goto-char second-end))
  2738. ;; If no closing parenthesis in range, update continuation point
  2739. (setq cont-point (min end-of-block second-begin))))
  2740. (cond
  2741. ;; On failure, continue searching at cont-point
  2742. ((and cont-point (< cont-point last))
  2743. (goto-char cont-point)
  2744. (markdown-match-generic-links last ref))
  2745. ;; No more text, return nil
  2746. ((and cont-point (= cont-point last))
  2747. nil)
  2748. ;; Return t if a match occurred
  2749. (t t)))))
  2750. (defun markdown-match-angle-uris (last)
  2751. "Match angle bracket URIs from point to LAST."
  2752. (when (markdown-match-inline-generic markdown-regex-angle-uri last)
  2753. (goto-char (1+ (match-end 0)))))
  2754. (defun markdown-match-plain-uris (last)
  2755. "Match plain URIs from point to LAST."
  2756. (when (markdown-match-inline-generic markdown-regex-uri last t)
  2757. (goto-char (1+ (match-end 0)))))
  2758. (defvar markdown-conditional-search-function #'re-search-forward
  2759. "Conditional search function used in `markdown-search-until-condition'.
  2760. Made into a variable to allow for dynamic let-binding.")
  2761. (defun markdown-search-until-condition (condition &rest args)
  2762. (let (ret)
  2763. (while (and (not ret) (apply markdown-conditional-search-function args))
  2764. (setq ret (funcall condition)))
  2765. ret))
  2766. (defun markdown-metadata-line-p (pos regexp)
  2767. (save-excursion
  2768. (or (= (line-number-at-pos pos) 1)
  2769. (progn
  2770. (forward-line -1)
  2771. ;; skip multi-line metadata
  2772. (while (and (looking-at-p "^\\s-+[[:alpha:]]")
  2773. (> (line-number-at-pos (point)) 1))
  2774. (forward-line -1))
  2775. (looking-at-p regexp)))))
  2776. (defun markdown-match-generic-metadata (regexp last)
  2777. "Match metadata declarations specified by REGEXP from point to LAST.
  2778. These declarations must appear inside a metadata block that begins at
  2779. the beginning of the buffer and ends with a blank line (or the end of
  2780. the buffer)."
  2781. (let* ((first (point))
  2782. (end-re "\n[ \t]*\n\\|\n\\'\\|\\'")
  2783. (block-begin (goto-char 1))
  2784. (block-end (re-search-forward end-re nil t)))
  2785. (if (and block-end (> first block-end))
  2786. ;; Don't match declarations if there is no metadata block or if
  2787. ;; the point is beyond the block. Move point to point-max to
  2788. ;; prevent additional searches and return return nil since nothing
  2789. ;; was found.
  2790. (progn (goto-char (point-max)) nil)
  2791. ;; If a block was found that begins before LAST and ends after
  2792. ;; point, search for declarations inside it. If the starting is
  2793. ;; before the beginning of the block, start there. Otherwise,
  2794. ;; move back to FIRST.
  2795. (goto-char (if (< first block-begin) block-begin first))
  2796. (if (and (re-search-forward regexp (min last block-end) t)
  2797. (markdown-metadata-line-p (point) regexp))
  2798. ;; If a metadata declaration is found, set match-data and return t.
  2799. (let ((key-beginning (match-beginning 1))
  2800. (key-end (match-end 1))
  2801. (markup-begin (match-beginning 2))
  2802. (markup-end (match-end 2))
  2803. (value-beginning (match-beginning 3)))
  2804. (set-match-data (list key-beginning (point) ; complete metadata
  2805. key-beginning key-end ; key
  2806. markup-begin markup-end ; markup
  2807. value-beginning (point))) ; value
  2808. t)
  2809. ;; Otherwise, move the point to last and return nil
  2810. (goto-char last)
  2811. nil))))
  2812. (defun markdown-match-declarative-metadata (last)
  2813. "Match declarative metadata from the point to LAST."
  2814. (markdown-match-generic-metadata markdown-regex-declarative-metadata last))
  2815. (defun markdown-match-pandoc-metadata (last)
  2816. "Match Pandoc metadata from the point to LAST."
  2817. (markdown-match-generic-metadata markdown-regex-pandoc-metadata last))
  2818. (defun markdown-match-yaml-metadata-begin (last)
  2819. (markdown-match-propertized-text 'markdown-yaml-metadata-begin last))
  2820. (defun markdown-match-yaml-metadata-end (last)
  2821. (markdown-match-propertized-text 'markdown-yaml-metadata-end last))
  2822. (defun markdown-match-yaml-metadata-key (last)
  2823. (markdown-match-propertized-text 'markdown-metadata-key last))
  2824. (defun markdown-match-wiki-link (last)
  2825. "Match wiki links from point to LAST."
  2826. (when (and markdown-enable-wiki-links
  2827. (not markdown-wiki-link-fontify-missing)
  2828. (markdown-match-inline-generic markdown-regex-wiki-link last))
  2829. (let ((begin (match-beginning 1)) (end (match-end 1)))
  2830. (if (or (markdown-in-comment-p begin)
  2831. (markdown-in-comment-p end)
  2832. (markdown-inline-code-at-pos-p begin)
  2833. (markdown-inline-code-at-pos-p end)
  2834. (markdown-code-block-at-pos begin))
  2835. (progn (goto-char (min (1+ begin) last))
  2836. (when (< (point) last)
  2837. (markdown-match-wiki-link last)))
  2838. (set-match-data (list begin end))
  2839. t))))
  2840. (defun markdown-match-inline-attributes (last)
  2841. "Match inline attributes from point to LAST."
  2842. ;; #428 re-search-forward markdown-regex-inline-attributes is very slow.
  2843. ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes
  2844. ;; against matched string.
  2845. (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last)
  2846. (if (not (string-match-p markdown-regex-inline-attributes (match-string 0)))
  2847. (markdown-match-inline-attributes last)
  2848. (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
  2849. (markdown-inline-code-at-pos-p (match-end 0))
  2850. (markdown-in-comment-p))
  2851. t))))
  2852. (defun markdown-match-leanpub-sections (last)
  2853. "Match Leanpub section markers from point to LAST."
  2854. (when (markdown-match-inline-generic markdown-regex-leanpub-sections last)
  2855. (unless (or (markdown-inline-code-at-pos-p (match-beginning 0))
  2856. (markdown-inline-code-at-pos-p (match-end 0))
  2857. (markdown-in-comment-p))
  2858. t)))
  2859. (defun markdown-match-includes (last)
  2860. "Match include statements from point to LAST.
  2861. Sets match data for the following seven groups:
  2862. Group 1: opening two angle brackets
  2863. Group 2: opening title delimiter (optional)
  2864. Group 3: title text (optional)
  2865. Group 4: closing title delimiter (optional)
  2866. Group 5: opening filename delimiter
  2867. Group 6: filename
  2868. Group 7: closing filename delimiter"
  2869. (when (markdown-match-inline-generic markdown-regex-include last)
  2870. (let ((valid (not (or (markdown-in-comment-p (match-beginning 0))
  2871. (markdown-in-comment-p (match-end 0))
  2872. (markdown-code-block-at-pos (match-beginning 0))))))
  2873. (cond
  2874. ;; Parentheses and maybe square brackets, but no curly braces:
  2875. ;; match optional title in square brackets and file in parentheses.
  2876. ((and valid (match-beginning 5)
  2877. (not (match-beginning 8)))
  2878. (set-match-data (list (match-beginning 1) (match-end 7)
  2879. (match-beginning 1) (match-end 1)
  2880. (match-beginning 2) (match-end 2)
  2881. (match-beginning 3) (match-end 3)
  2882. (match-beginning 4) (match-end 4)
  2883. (match-beginning 5) (match-end 5)
  2884. (match-beginning 6) (match-end 6)
  2885. (match-beginning 7) (match-end 7))))
  2886. ;; Only square brackets present: match file in square brackets.
  2887. ((and valid (match-beginning 2)
  2888. (not (match-beginning 5))
  2889. (not (match-beginning 7)))
  2890. (set-match-data (list (match-beginning 1) (match-end 4)
  2891. (match-beginning 1) (match-end 1)
  2892. nil nil
  2893. nil nil
  2894. nil nil
  2895. (match-beginning 2) (match-end 2)
  2896. (match-beginning 3) (match-end 3)
  2897. (match-beginning 4) (match-end 4))))
  2898. ;; Only curly braces present: match file in curly braces.
  2899. ((and valid (match-beginning 8)
  2900. (not (match-beginning 2))
  2901. (not (match-beginning 5)))
  2902. (set-match-data (list (match-beginning 1) (match-end 10)
  2903. (match-beginning 1) (match-end 1)
  2904. nil nil
  2905. nil nil
  2906. nil nil
  2907. (match-beginning 8) (match-end 8)
  2908. (match-beginning 9) (match-end 9)
  2909. (match-beginning 10) (match-end 10))))
  2910. (t
  2911. ;; Not a valid match, move to next line and search again.
  2912. (forward-line)
  2913. (when (< (point) last)
  2914. (setq valid (markdown-match-includes last)))))
  2915. valid)))
  2916. (defun markdown-match-html-tag (last)
  2917. "Match HTML tags from point to LAST."
  2918. (when (and markdown-enable-html
  2919. (markdown-match-inline-generic markdown-regex-html-tag last t))
  2920. (set-match-data (list (match-beginning 0) (match-end 0)
  2921. (match-beginning 1) (match-end 1)
  2922. (match-beginning 2) (match-end 2)
  2923. (match-beginning 9) (match-end 9)))
  2924. t))
  2925. ;;; Markdown Font Fontification Functions =====================================
  2926. (defun markdown--first-displayable (seq)
  2927. "Return the first displayable character or string in SEQ.
  2928. SEQ may be an atom or a sequence."
  2929. (let ((seq (if (listp seq) seq (list seq))))
  2930. (cond ((stringp (car seq))
  2931. (cl-find-if
  2932. (lambda (str)
  2933. (and (mapcar #'char-displayable-p (string-to-list str))))
  2934. seq))
  2935. ((characterp (car seq))
  2936. (cl-find-if #'char-displayable-p seq)))))
  2937. (defun markdown--marginalize-string (level)
  2938. "Generate atx markup string of given LEVEL for left margin."
  2939. (let ((margin-left-space-count
  2940. (- markdown-marginalize-headers-margin-width level)))
  2941. (concat (make-string margin-left-space-count ? )
  2942. (make-string level ?#))))
  2943. (defun markdown-marginalize-update-current ()
  2944. "Update the window configuration to create a left margin."
  2945. (if window-system
  2946. (let* ((header-delimiter-font-width
  2947. (window-font-width nil 'markdown-header-delimiter-face))
  2948. (margin-pixel-width (* markdown-marginalize-headers-margin-width
  2949. header-delimiter-font-width))
  2950. (margin-char-width (/ margin-pixel-width (default-font-width))))
  2951. (set-window-margins nil margin-char-width))
  2952. ;; As a fallback, simply set margin based on character count.
  2953. (set-window-margins nil markdown-marginalize-headers-margin-width)))
  2954. (defun markdown-fontify-headings (last)
  2955. "Add text properties to headings from point to LAST."
  2956. (when (markdown-match-propertized-text 'markdown-heading last)
  2957. (let* ((level (markdown-outline-level))
  2958. (heading-face
  2959. (intern (format "markdown-header-face-%d" level)))
  2960. (heading-props `(face ,heading-face))
  2961. (left-markup-props
  2962. `(face markdown-header-delimiter-face
  2963. ,@(cond
  2964. (markdown-hide-markup
  2965. `(display ""))
  2966. (markdown-marginalize-headers
  2967. `(display ((margin left-margin)
  2968. ,(markdown--marginalize-string level)))))))
  2969. (right-markup-props
  2970. `(face markdown-header-delimiter-face
  2971. ,@(when markdown-hide-markup `(display ""))))
  2972. (rule-props `(face markdown-header-rule-face
  2973. ,@(when markdown-hide-markup `(display "")))))
  2974. (if (match-end 1)
  2975. ;; Setext heading
  2976. (progn (add-text-properties
  2977. (match-beginning 1) (match-end 1) heading-props)
  2978. (if (= level 1)
  2979. (add-text-properties
  2980. (match-beginning 2) (match-end 2) rule-props)
  2981. (add-text-properties
  2982. (match-beginning 3) (match-end 3) rule-props)))
  2983. ;; atx heading
  2984. (add-text-properties
  2985. (match-beginning 4) (match-end 4) left-markup-props)
  2986. (add-text-properties
  2987. (match-beginning 5) (match-end 5) heading-props)
  2988. (when (match-end 6)
  2989. (add-text-properties
  2990. (match-beginning 6) (match-end 6) right-markup-props))))
  2991. t))
  2992. (defun markdown-fontify-tables (last)
  2993. (when (and (re-search-forward "|" last t)
  2994. (markdown-table-at-point-p))
  2995. (font-lock-append-text-property
  2996. (line-beginning-position) (min (1+ (line-end-position)) (point-max))
  2997. 'face 'markdown-table-face)
  2998. (forward-line 1)
  2999. t))
  3000. (defun markdown-fontify-blockquotes (last)
  3001. "Apply font-lock properties to blockquotes from point to LAST."
  3002. (when (markdown-match-blockquotes last)
  3003. (let ((display-string
  3004. (markdown--first-displayable markdown-blockquote-display-char)))
  3005. (add-text-properties
  3006. (match-beginning 1) (match-end 1)
  3007. (if markdown-hide-markup
  3008. `(face markdown-blockquote-face display ,display-string)
  3009. `(face markdown-markup-face)))
  3010. (font-lock-append-text-property
  3011. (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face)
  3012. t)))
  3013. (defun markdown-fontify-list-items (last)
  3014. "Apply font-lock properties to list markers from point to LAST."
  3015. (when (markdown-match-list-items last)
  3016. (let* ((indent (length (match-string-no-properties 1)))
  3017. (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ...
  3018. (bullet (nth (mod level (length markdown-list-item-bullets))
  3019. markdown-list-item-bullets)))
  3020. (add-text-properties
  3021. (match-beginning 2) (match-end 2) '(face markdown-list-face))
  3022. (when markdown-hide-markup
  3023. (cond
  3024. ;; Unordered lists
  3025. ((string-match-p "[\\*\\+-]" (match-string 2))
  3026. (add-text-properties
  3027. (match-beginning 2) (match-end 2) `(display ,bullet)))
  3028. ;; Definition lists
  3029. ((string-equal ":" (match-string 2))
  3030. (let ((display-string
  3031. (char-to-string (markdown--first-displayable
  3032. markdown-definition-display-char))))
  3033. (add-text-properties (match-beginning 2) (match-end 2)
  3034. `(display ,display-string)))))))
  3035. t))
  3036. (defun markdown-fontify-hrs (last)
  3037. "Add text properties to horizontal rules from point to LAST."
  3038. (when (markdown-match-hr last)
  3039. (let ((hr-char (markdown--first-displayable markdown-hr-display-char)))
  3040. (add-text-properties
  3041. (match-beginning 0) (match-end 0)
  3042. `(face markdown-hr-face
  3043. font-lock-multiline t
  3044. ,@(when (and markdown-hide-markup hr-char)
  3045. `(display ,(make-string
  3046. (window-body-width) hr-char)))))
  3047. t)))
  3048. (defun markdown-fontify-sub-superscripts (last)
  3049. "Apply text properties to sub- and superscripts from point to LAST."
  3050. (when (markdown-search-until-condition
  3051. (lambda () (and (not (markdown-code-block-at-point-p))
  3052. (not (markdown-inline-code-at-point-p))
  3053. (not (markdown-in-comment-p))))
  3054. markdown-regex-sub-superscript last t)
  3055. (let* ((subscript-p (string= (match-string 2) "~"))
  3056. (props
  3057. (if subscript-p
  3058. (car markdown-sub-superscript-display)
  3059. (cdr markdown-sub-superscript-display)))
  3060. (mp (list 'face 'markdown-markup-face
  3061. 'invisible 'markdown-markup)))
  3062. (when markdown-hide-markup
  3063. (put-text-property (match-beginning 3) (match-end 3)
  3064. 'display props))
  3065. (add-text-properties (match-beginning 2) (match-end 2) mp)
  3066. (add-text-properties (match-beginning 4) (match-end 4) mp)
  3067. t)))
  3068. ;;; Syntax Table ==============================================================
  3069. (defvar markdown-mode-syntax-table
  3070. (let ((tab (make-syntax-table text-mode-syntax-table)))
  3071. (modify-syntax-entry ?\" "." tab)
  3072. tab)
  3073. "Syntax table for `markdown-mode'.")
  3074. ;;; Element Insertion =========================================================
  3075. (defun markdown-ensure-blank-line-before ()
  3076. "If previous line is not already blank, insert a blank line before point."
  3077. (unless (bolp) (insert "\n"))
  3078. (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n")))
  3079. (defun markdown-ensure-blank-line-after ()
  3080. "If following line is not already blank, insert a blank line after point.
  3081. Return the point where it was originally."
  3082. (save-excursion
  3083. (unless (eolp) (insert "\n"))
  3084. (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n"))))
  3085. (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end)
  3086. "Insert the strings S1 and S2, wrapping around region or THING.
  3087. If a region is specified by the optional BEG and END arguments,
  3088. wrap the strings S1 and S2 around that region.
  3089. If there is an active region, wrap the strings S1 and S2 around
  3090. the region. If there is not an active region but the point is at
  3091. THING, wrap that thing (which defaults to word). Otherwise, just
  3092. insert S1 and S2 and place the point in between. Return the
  3093. bounds of the entire wrapped string, or nil if nothing was wrapped
  3094. and S1 and S2 were only inserted."
  3095. (let (a b bounds new-point)
  3096. (cond
  3097. ;; Given region
  3098. ((and beg end)
  3099. (setq a beg
  3100. b end
  3101. new-point (+ (point) (length s1))))
  3102. ;; Active region
  3103. ((use-region-p)
  3104. (setq a (region-beginning)
  3105. b (region-end)
  3106. new-point (+ (point) (length s1))))
  3107. ;; Thing (word) at point
  3108. ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word)))
  3109. (setq a (car bounds)
  3110. b (cdr bounds)
  3111. new-point (+ (point) (length s1))))
  3112. ;; No active region and no word
  3113. (t
  3114. (setq a (point)
  3115. b (point))))
  3116. (goto-char b)
  3117. (insert s2)
  3118. (goto-char a)
  3119. (insert s1)
  3120. (when new-point (goto-char new-point))
  3121. (if (= a b)
  3122. nil
  3123. (setq b (+ b (length s1) (length s2)))
  3124. (cons a b))))
  3125. (defun markdown-point-after-unwrap (cur prefix suffix)
  3126. "Return desired position of point after an unwrapping operation.
  3127. CUR gives the position of the point before the operation.
  3128. Additionally, two cons cells must be provided. PREFIX gives the
  3129. bounds of the prefix string and SUFFIX gives the bounds of the
  3130. suffix string."
  3131. (cond ((< cur (cdr prefix)) (car prefix))
  3132. ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix))))
  3133. ((<= cur (cdr suffix))
  3134. (- cur (+ (- (cdr prefix) (car prefix))
  3135. (- cur (car suffix)))))
  3136. (t cur)))
  3137. (defun markdown-unwrap-thing-at-point (regexp all text)
  3138. "Remove prefix and suffix of thing at point and reposition the point.
  3139. When the thing at point matches REGEXP, replace the subexpression
  3140. ALL with the string in subexpression TEXT. Reposition the point
  3141. in an appropriate location accounting for the removal of prefix
  3142. and suffix strings. Return new bounds of string from group TEXT.
  3143. When REGEXP is nil, assumes match data is already set."
  3144. (when (or (null regexp)
  3145. (thing-at-point-looking-at regexp))
  3146. (let ((cur (point))
  3147. (prefix (cons (match-beginning all) (match-beginning text)))
  3148. (suffix (cons (match-end text) (match-end all)))
  3149. (bounds (cons (match-beginning text) (match-end text))))
  3150. ;; Replace the thing at point
  3151. (replace-match (match-string text) t t nil all)
  3152. ;; Reposition the point
  3153. (goto-char (markdown-point-after-unwrap cur prefix suffix))
  3154. ;; Adjust bounds
  3155. (setq bounds (cons (car prefix)
  3156. (- (cdr bounds) (- (cdr prefix) (car prefix))))))))
  3157. (defun markdown-unwrap-things-in-region (beg end regexp all text)
  3158. "Remove prefix and suffix of all things in region from BEG to END.
  3159. When a thing in the region matches REGEXP, replace the
  3160. subexpression ALL with the string in subexpression TEXT.
  3161. Return a cons cell containing updated bounds for the region."
  3162. (save-excursion
  3163. (goto-char beg)
  3164. (let ((removed 0) len-all len-text)
  3165. (while (re-search-forward regexp (- end removed) t)
  3166. (setq len-all (length (match-string-no-properties all)))
  3167. (setq len-text (length (match-string-no-properties text)))
  3168. (setq removed (+ removed (- len-all len-text)))
  3169. (replace-match (match-string text) t t nil all))
  3170. (cons beg (- end removed)))))
  3171. (defun markdown-insert-hr (arg)
  3172. "Insert or replace a horizontal rule.
  3173. By default, use the first element of `markdown-hr-strings'. When
  3174. ARG is non-nil, as when given a prefix, select a different
  3175. element as follows. When prefixed with \\[universal-argument],
  3176. use the last element of `markdown-hr-strings' instead. When
  3177. prefixed with an integer from 1 to the length of
  3178. `markdown-hr-strings', use the element in that position instead."
  3179. (interactive "*P")
  3180. (when (thing-at-point-looking-at markdown-regex-hr)
  3181. (delete-region (match-beginning 0) (match-end 0)))
  3182. (markdown-ensure-blank-line-before)
  3183. (cond ((equal arg '(4))
  3184. (insert (car (reverse markdown-hr-strings))))
  3185. ((and (integerp arg) (> arg 0)
  3186. (<= arg (length markdown-hr-strings)))
  3187. (insert (nth (1- arg) markdown-hr-strings)))
  3188. (t
  3189. (insert (car markdown-hr-strings))))
  3190. (markdown-ensure-blank-line-after))
  3191. (defun markdown--insert-common (start-delim end-delim regex start-group end-group face)
  3192. (if (use-region-p)
  3193. ;; Active region
  3194. (let ((bounds (markdown-unwrap-things-in-region
  3195. (region-beginning) (region-end)
  3196. regex start-group end-group)))
  3197. (markdown-wrap-or-insert start-delim end-delim nil (car bounds) (cdr bounds)))
  3198. (if (markdown--face-p (point) (list face))
  3199. (save-excursion
  3200. (while (and (markdown--face-p (point) (list face)) (not (bobp)))
  3201. (forward-char -1))
  3202. (forward-char (- (1- (length start-delim)))) ;; for delimiter
  3203. (unless (bolp)
  3204. (forward-char -1))
  3205. (when (looking-at regex)
  3206. (markdown-unwrap-thing-at-point nil start-group end-group)))
  3207. (if (thing-at-point-looking-at regex)
  3208. (markdown-unwrap-thing-at-point nil start-group end-group)
  3209. (markdown-wrap-or-insert start-delim end-delim 'word nil nil)))))
  3210. (defun markdown-insert-bold ()
  3211. "Insert markup to make a region or word bold.
  3212. If there is an active region, make the region bold. If the point
  3213. is at a non-bold word, make the word bold. If the point is at a
  3214. bold word or phrase, remove the bold markup. Otherwise, simply
  3215. insert bold delimiters and place the point in between them."
  3216. (interactive)
  3217. (let ((delim (if markdown-bold-underscore "__" "**")))
  3218. (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face)))
  3219. (defun markdown-insert-italic ()
  3220. "Insert markup to make a region or word italic.
  3221. If there is an active region, make the region italic. If the point
  3222. is at a non-italic word, make the word italic. If the point is at an
  3223. italic word or phrase, remove the italic markup. Otherwise, simply
  3224. insert italic delimiters and place the point in between them."
  3225. (interactive)
  3226. (let ((delim (if markdown-italic-underscore "_" "*")))
  3227. (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face)))
  3228. (defun markdown-insert-strike-through ()
  3229. "Insert markup to make a region or word strikethrough.
  3230. If there is an active region, make the region strikethrough. If the point
  3231. is at a non-bold word, make the word strikethrough. If the point is at a
  3232. strikethrough word or phrase, remove the strikethrough markup. Otherwise,
  3233. simply insert bold delimiters and place the point in between them."
  3234. (interactive)
  3235. (markdown--insert-common
  3236. "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face))
  3237. (defun markdown-insert-code ()
  3238. "Insert markup to make a region or word an inline code fragment.
  3239. If there is an active region, make the region an inline code
  3240. fragment. If the point is at a word, make the word an inline
  3241. code fragment. Otherwise, simply insert code delimiters and
  3242. place the point in between them."
  3243. (interactive)
  3244. (if (use-region-p)
  3245. ;; Active region
  3246. (let ((bounds (markdown-unwrap-things-in-region
  3247. (region-beginning) (region-end)
  3248. markdown-regex-code 1 3)))
  3249. (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds)))
  3250. ;; Code markup removal, code markup for word, or empty markup insertion
  3251. (if (markdown-inline-code-at-point)
  3252. (markdown-unwrap-thing-at-point nil 0 2)
  3253. (markdown-wrap-or-insert "`" "`" 'word nil nil))))
  3254. (defun markdown-insert-kbd ()
  3255. "Insert markup to wrap region or word in <kbd> tags.
  3256. If there is an active region, use the region. If the point is at
  3257. a word, use the word. Otherwise, simply insert <kbd> tags and
  3258. place the point in between them."
  3259. (interactive)
  3260. (if (use-region-p)
  3261. ;; Active region
  3262. (let ((bounds (markdown-unwrap-things-in-region
  3263. (region-beginning) (region-end)
  3264. markdown-regex-kbd 0 2)))
  3265. (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds)))
  3266. ;; Markup removal, markup for word, or empty markup insertion
  3267. (if (thing-at-point-looking-at markdown-regex-kbd)
  3268. (markdown-unwrap-thing-at-point nil 0 2)
  3269. (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil))))
  3270. (defun markdown-insert-inline-link (text url &optional title)
  3271. "Insert an inline link with TEXT pointing to URL.
  3272. Optionally, the user can provide a TITLE."
  3273. (let ((cur (point)))
  3274. (setq title (and title (concat " \"" title "\"")))
  3275. (insert (concat "[" text "](" url title ")"))
  3276. (cond ((not text) (goto-char (+ 1 cur)))
  3277. ((not url) (goto-char (+ 3 (length text) cur))))))
  3278. (defun markdown-insert-inline-image (text url &optional title)
  3279. "Insert an inline link with alt TEXT pointing to URL.
  3280. Optionally, also provide a TITLE."
  3281. (let ((cur (point)))
  3282. (setq title (and title (concat " \"" title "\"")))
  3283. (insert (concat "![" text "](" url title ")"))
  3284. (cond ((not text) (goto-char (+ 2 cur)))
  3285. ((not url) (goto-char (+ 4 (length text) cur))))))
  3286. (defun markdown-insert-reference-link (text label &optional url title)
  3287. "Insert a reference link and, optionally, a reference definition.
  3288. The link TEXT will be inserted followed by the optional LABEL.
  3289. If a URL is given, also insert a definition for the reference
  3290. LABEL according to `markdown-reference-location'. If a TITLE is
  3291. given, it will be added to the end of the reference definition
  3292. and will be used to populate the title attribute when converted
  3293. to XHTML. If URL is nil, insert only the link portion (for
  3294. example, when a reference label is already defined)."
  3295. (insert (concat "[" text "][" label "]"))
  3296. (when url
  3297. (markdown-insert-reference-definition
  3298. (if (string-equal label "") text label)
  3299. url title)))
  3300. (defun markdown-insert-reference-image (text label &optional url title)
  3301. "Insert a reference image and, optionally, a reference definition.
  3302. The alt TEXT will be inserted followed by the optional LABEL.
  3303. If a URL is given, also insert a definition for the reference
  3304. LABEL according to `markdown-reference-location'. If a TITLE is
  3305. given, it will be added to the end of the reference definition
  3306. and will be used to populate the title attribute when converted
  3307. to XHTML. If URL is nil, insert only the link portion (for
  3308. example, when a reference label is already defined)."
  3309. (insert (concat "![" text "][" label "]"))
  3310. (when url
  3311. (markdown-insert-reference-definition
  3312. (if (string-equal label "") text label)
  3313. url title)))
  3314. (defun markdown-insert-reference-definition (label &optional url title)
  3315. "Add definition for reference LABEL with URL and TITLE.
  3316. LABEL is a Markdown reference label without square brackets.
  3317. URL and TITLE are optional. When given, the TITLE will
  3318. be used to populate the title attribute when converted to XHTML."
  3319. ;; END specifies where to leave the point upon return
  3320. (let ((end (point)))
  3321. (cl-case markdown-reference-location
  3322. (end (goto-char (point-max)))
  3323. (immediately (markdown-end-of-text-block))
  3324. (subtree (markdown-end-of-subtree))
  3325. (header (markdown-end-of-defun)))
  3326. ;; Skip backwards over local variables. This logic is similar to the one
  3327. ;; used in ‘hack-local-variables’.
  3328. (when (and enable-local-variables (eobp))
  3329. (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move)
  3330. (when (let ((case-fold-search t))
  3331. (search-forward "Local Variables:" nil :move))
  3332. (beginning-of-line 0)
  3333. (when (eq (char-before) ?\n) (backward-char))))
  3334. (unless (or (markdown-cur-line-blank-p)
  3335. (thing-at-point-looking-at markdown-regex-reference-definition))
  3336. (insert "\n"))
  3337. (insert "\n[" label "]: ")
  3338. (if url
  3339. (insert url)
  3340. ;; When no URL is given, leave point at END following the colon
  3341. (setq end (point)))
  3342. (when (> (length title) 0)
  3343. (insert " \"" title "\""))
  3344. (unless (looking-at-p "\n")
  3345. (insert "\n"))
  3346. (goto-char end)
  3347. (when url
  3348. (message
  3349. (markdown--substitute-command-keys
  3350. "Reference [%s] was defined, press \\[markdown-do] to jump there")
  3351. label))))
  3352. (defcustom markdown-link-make-text-function nil
  3353. "Function that automatically generates a link text for a URL.
  3354. If non-nil, this function will be called by
  3355. `markdown--insert-link-or-image' and the result will be the
  3356. default link text. The function should receive exactly one
  3357. argument that corresponds to the link URL."
  3358. :group 'markdown
  3359. :type 'function
  3360. :package-version '(markdown-mode . "2.5"))
  3361. (defcustom markdown-disable-tooltip-prompt nil
  3362. "Disable prompt for tooltip when inserting a link or image.
  3363. If non-nil, `markdown-insert-link' and `markdown-insert-link'
  3364. will not prompt the user to insert a tooltip text for the given
  3365. link or image."
  3366. :group 'markdown
  3367. :type 'boolean
  3368. :safe 'booleanp
  3369. :package-version '(markdown-mode . "2.5"))
  3370. (defun markdown--insert-link-or-image (image)
  3371. "Interactively insert new or update an existing link or image.
  3372. When IMAGE is non-nil, insert an image. Otherwise, insert a link.
  3373. This is an internal function called by
  3374. `markdown-insert-link' and `markdown-insert-image'."
  3375. (cl-multiple-value-bind (begin end text uri ref title)
  3376. (if (use-region-p)
  3377. ;; Use region as either link text or URL as appropriate.
  3378. (let ((region (buffer-substring-no-properties
  3379. (region-beginning) (region-end))))
  3380. (if (string-match markdown-regex-uri region)
  3381. ;; Region contains a URL; use it as such.
  3382. (list (region-beginning) (region-end)
  3383. nil (match-string 0 region) nil nil)
  3384. ;; Region doesn't contain a URL, so use it as text.
  3385. (list (region-beginning) (region-end)
  3386. region nil nil nil)))
  3387. ;; Extract and use properties of existing link, if any.
  3388. (markdown-link-at-pos (point)))
  3389. (let* ((ref (when ref (concat "[" ref "]")))
  3390. (defined-refs (mapcar #'car (markdown-get-defined-references)))
  3391. (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs))
  3392. (used-uris (markdown-get-used-uris))
  3393. (uri-or-ref (completing-read
  3394. "URL or [reference]: "
  3395. (append defined-ref-cands used-uris)
  3396. nil nil (or uri ref)))
  3397. (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref)
  3398. (match-string 1 uri-or-ref))
  3399. ((string-equal "" uri-or-ref)
  3400. "")))
  3401. (uri (unless ref uri-or-ref))
  3402. (text-prompt (if image
  3403. "Alt text: "
  3404. (if ref
  3405. "Link text: "
  3406. "Link text (blank for plain URL): ")))
  3407. (text (or text (and markdown-link-make-text-function uri
  3408. (funcall markdown-link-make-text-function uri))))
  3409. (text (completing-read text-prompt defined-refs nil nil text))
  3410. (text (if (= (length text) 0) nil text))
  3411. (plainp (and uri (not text)))
  3412. (implicitp (string-equal ref ""))
  3413. (ref (if implicitp text ref))
  3414. (definedp (and ref (markdown-reference-definition ref)))
  3415. (ref-url (unless (or uri definedp)
  3416. (completing-read "Reference URL: " used-uris)))
  3417. (title (unless (or plainp definedp markdown-disable-tooltip-prompt)
  3418. (read-string "Title (tooltip text, optional): " title)))
  3419. (title (if (= (length title) 0) nil title)))
  3420. (when (and image implicitp)
  3421. (user-error "Reference required: implicit image references are invalid"))
  3422. (when (and begin end)
  3423. (delete-region begin end))
  3424. (cond
  3425. ((and (not image) uri text)
  3426. (markdown-insert-inline-link text uri title))
  3427. ((and image uri text)
  3428. (markdown-insert-inline-image text uri title))
  3429. ((and ref text)
  3430. (if image
  3431. (markdown-insert-reference-image text (unless implicitp ref) nil title)
  3432. (markdown-insert-reference-link text (unless implicitp ref) nil title))
  3433. (unless definedp
  3434. (markdown-insert-reference-definition ref ref-url title)))
  3435. ((and (not image) uri)
  3436. (markdown-insert-uri uri))))))
  3437. (defun markdown-insert-link ()
  3438. "Insert new or update an existing link, with interactive prompts.
  3439. If the point is at an existing link or URL, update the link text,
  3440. URL, reference label, and/or title. Otherwise, insert a new link.
  3441. The type of link inserted (inline, reference, or plain URL)
  3442. depends on which values are provided:
  3443. * If a URL and TEXT are given, insert an inline link: [TEXT](URL).
  3444. * If [REF] and TEXT are given, insert a reference link: [TEXT][REF].
  3445. * If only TEXT is given, insert an implicit reference link: [TEXT][].
  3446. * If only a URL is given, insert a plain link: <URL>.
  3447. In other words, to create an implicit reference link, leave the
  3448. URL prompt empty and to create a plain URL link, leave the link
  3449. text empty.
  3450. If there is an active region, use the text as the default URL, if
  3451. it seems to be a URL, or link text value otherwise.
  3452. If a given reference is not defined, this function will
  3453. additionally prompt for the URL and optional title. In this case,
  3454. the reference definition is placed at the location determined by
  3455. `markdown-reference-location'. In addition, it is possible to
  3456. have the `markdown-link-make-text-function' function, if non-nil,
  3457. define the default link text before prompting the user for it.
  3458. If `markdown-disable-tooltip-prompt' is non-nil, the user will
  3459. not be prompted to add or modify a tooltip text.
  3460. Through updating the link, this function can be used to convert a
  3461. link of one type (inline, reference, or plain) to another type by
  3462. selectively adding or removing information via the prompts."
  3463. (interactive)
  3464. (markdown--insert-link-or-image nil))
  3465. (defun markdown-insert-image ()
  3466. "Insert new or update an existing image, with interactive prompts.
  3467. If the point is at an existing image, update the alt text, URL,
  3468. reference label, and/or title. Otherwise, insert a new image.
  3469. The type of image inserted (inline or reference) depends on which
  3470. values are provided:
  3471. * If a URL and ALT-TEXT are given, insert an inline image:
  3472. ![ALT-TEXT](URL).
  3473. * If [REF] and ALT-TEXT are given, insert a reference image:
  3474. ![ALT-TEXT][REF].
  3475. If there is an active region, use the text as the default URL, if
  3476. it seems to be a URL, or alt text value otherwise.
  3477. If a given reference is not defined, this function will
  3478. additionally prompt for the URL and optional title. In this case,
  3479. the reference definition is placed at the location determined by
  3480. `markdown-reference-location'.
  3481. Through updating the image, this function can be used to convert an
  3482. image of one type (inline or reference) to another type by
  3483. selectively adding or removing information via the prompts."
  3484. (interactive)
  3485. (markdown--insert-link-or-image t))
  3486. (defun markdown-insert-uri (&optional uri)
  3487. "Insert markup for an inline URI.
  3488. If there is an active region, use it as the URI. If the point is
  3489. at a URI, wrap it with angle brackets. If the point is at an
  3490. inline URI, remove the angle brackets. Otherwise, simply insert
  3491. angle brackets place the point between them."
  3492. (interactive)
  3493. (if (use-region-p)
  3494. ;; Active region
  3495. (let ((bounds (markdown-unwrap-things-in-region
  3496. (region-beginning) (region-end)
  3497. markdown-regex-angle-uri 0 2)))
  3498. (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds)))
  3499. ;; Markup removal, URI at point, new URI, or empty markup insertion
  3500. (if (thing-at-point-looking-at markdown-regex-angle-uri)
  3501. (markdown-unwrap-thing-at-point nil 0 2)
  3502. (if uri
  3503. (insert "<" uri ">")
  3504. (markdown-wrap-or-insert "<" ">" 'url nil nil)))))
  3505. (defun markdown-insert-wiki-link ()
  3506. "Insert a wiki link of the form [[WikiLink]].
  3507. If there is an active region, use the region as the link text.
  3508. If the point is at a word, use the word as the link text. If
  3509. there is no active region and the point is not at word, simply
  3510. insert link markup."
  3511. (interactive)
  3512. (if (use-region-p)
  3513. ;; Active region
  3514. (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end))
  3515. ;; Markup removal, wiki link at at point, or empty markup insertion
  3516. (if (thing-at-point-looking-at markdown-regex-wiki-link)
  3517. (if (or markdown-wiki-link-alias-first
  3518. (null (match-string 5)))
  3519. (markdown-unwrap-thing-at-point nil 1 3)
  3520. (markdown-unwrap-thing-at-point nil 1 5))
  3521. (markdown-wrap-or-insert "[[" "]]"))))
  3522. (defun markdown-remove-header ()
  3523. "Remove header markup if point is at a header.
  3524. Return bounds of remaining header text if a header was removed
  3525. and nil otherwise."
  3526. (interactive "*")
  3527. (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2)
  3528. (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1)))
  3529. (defun markdown-insert-header (&optional level text setext)
  3530. "Insert or replace header markup.
  3531. The level of the header is specified by LEVEL and header text is
  3532. given by TEXT. LEVEL must be an integer from 1 and 6, and the
  3533. default value is 1.
  3534. When TEXT is nil, the header text is obtained as follows.
  3535. If there is an active region, it is used as the header text.
  3536. Otherwise, the current line will be used as the header text.
  3537. If there is not an active region and the point is at a header,
  3538. remove the header markup and replace with level N header.
  3539. Otherwise, insert empty header markup and place the point in
  3540. between.
  3541. The style of the header will be atx (hash marks) unless
  3542. SETEXT is non-nil, in which case a setext-style (underlined)
  3543. header will be inserted."
  3544. (interactive "p\nsHeader text: ")
  3545. (setq level (min (max (or level 1) 1) (if setext 2 6)))
  3546. ;; Determine header text if not given
  3547. (when (null text)
  3548. (if (use-region-p)
  3549. ;; Active region
  3550. (setq text (delete-and-extract-region (region-beginning) (region-end)))
  3551. ;; No active region
  3552. (markdown-remove-header)
  3553. (setq text (delete-and-extract-region
  3554. (line-beginning-position) (line-end-position)))
  3555. (when (and setext (string-match-p "^[ \t]*$" text))
  3556. (setq text (read-string "Header text: "))))
  3557. (setq text (markdown-compress-whitespace-string text)))
  3558. ;; Insertion with given text
  3559. (markdown-ensure-blank-line-before)
  3560. (let (hdr)
  3561. (cond (setext
  3562. (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=)))
  3563. (insert text "\n" hdr))
  3564. (t
  3565. (setq hdr (make-string level ?#))
  3566. (insert hdr " " text)
  3567. (when (null markdown-asymmetric-header) (insert " " hdr)))))
  3568. (markdown-ensure-blank-line-after)
  3569. ;; Leave point at end of text
  3570. (cond (setext
  3571. (backward-char (1+ (string-width text))))
  3572. ((null markdown-asymmetric-header)
  3573. (backward-char (1+ level)))))
  3574. (defun markdown-insert-header-dwim (&optional arg setext)
  3575. "Insert or replace header markup.
  3576. The level and type of the header are determined automatically by
  3577. the type and level of the previous header, unless a prefix
  3578. argument is given via ARG.
  3579. With a numeric prefix valued 1 to 6, insert a header of the given
  3580. level, with the type being determined automatically (note that
  3581. only level 1 or 2 setext headers are possible).
  3582. With a \\[universal-argument] prefix (i.e., when ARG is (4)),
  3583. promote the heading by one level.
  3584. With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
  3585. demote the heading by one level.
  3586. When SETEXT is non-nil, prefer setext-style headers when
  3587. possible (levels one and two).
  3588. When there is an active region, use it for the header text. When
  3589. the point is at an existing header, change the type and level
  3590. according to the rules above.
  3591. Otherwise, if the line is not empty, create a header using the
  3592. text on the current line as the header text.
  3593. Finally, if the point is on a blank line, insert empty header
  3594. markup (atx) or prompt for text (setext).
  3595. See `markdown-insert-header' for more details about how the
  3596. header text is determined."
  3597. (interactive "*P")
  3598. (let (level)
  3599. (save-excursion
  3600. (when (or (thing-at-point-looking-at markdown-regex-header)
  3601. (re-search-backward markdown-regex-header nil t))
  3602. ;; level of current or previous header
  3603. (setq level (markdown-outline-level))
  3604. ;; match group 1 indicates a setext header
  3605. (setq setext (match-end 1))))
  3606. ;; check prefix argument
  3607. (cond
  3608. ((and (equal arg '(4)) level (> level 1)) ;; C-u
  3609. (cl-decf level))
  3610. ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u
  3611. (cl-incf level))
  3612. (arg ;; numeric prefix
  3613. (setq level (prefix-numeric-value arg))))
  3614. ;; setext headers must be level one or two
  3615. (and level (setq setext (and setext (<= level 2))))
  3616. ;; insert the heading
  3617. (markdown-insert-header level nil setext)))
  3618. (defun markdown-insert-header-setext-dwim (&optional arg)
  3619. "Insert or replace header markup, with preference for setext.
  3620. See `markdown-insert-header-dwim' for details, including how ARG is handled."
  3621. (interactive "*P")
  3622. (markdown-insert-header-dwim arg t))
  3623. (defun markdown-insert-header-atx-1 ()
  3624. "Insert a first level atx-style (hash mark) header.
  3625. See `markdown-insert-header'."
  3626. (interactive "*")
  3627. (markdown-insert-header 1 nil nil))
  3628. (defun markdown-insert-header-atx-2 ()
  3629. "Insert a level two atx-style (hash mark) header.
  3630. See `markdown-insert-header'."
  3631. (interactive "*")
  3632. (markdown-insert-header 2 nil nil))
  3633. (defun markdown-insert-header-atx-3 ()
  3634. "Insert a level three atx-style (hash mark) header.
  3635. See `markdown-insert-header'."
  3636. (interactive "*")
  3637. (markdown-insert-header 3 nil nil))
  3638. (defun markdown-insert-header-atx-4 ()
  3639. "Insert a level four atx-style (hash mark) header.
  3640. See `markdown-insert-header'."
  3641. (interactive "*")
  3642. (markdown-insert-header 4 nil nil))
  3643. (defun markdown-insert-header-atx-5 ()
  3644. "Insert a level five atx-style (hash mark) header.
  3645. See `markdown-insert-header'."
  3646. (interactive "*")
  3647. (markdown-insert-header 5 nil nil))
  3648. (defun markdown-insert-header-atx-6 ()
  3649. "Insert a sixth level atx-style (hash mark) header.
  3650. See `markdown-insert-header'."
  3651. (interactive "*")
  3652. (markdown-insert-header 6 nil nil))
  3653. (defun markdown-insert-header-setext-1 ()
  3654. "Insert a setext-style (underlined) first-level header.
  3655. See `markdown-insert-header'."
  3656. (interactive "*")
  3657. (markdown-insert-header 1 nil t))
  3658. (defun markdown-insert-header-setext-2 ()
  3659. "Insert a setext-style (underlined) second-level header.
  3660. See `markdown-insert-header'."
  3661. (interactive "*")
  3662. (markdown-insert-header 2 nil t))
  3663. (defun markdown-blockquote-indentation (loc)
  3664. "Return string containing necessary indentation for a blockquote at LOC.
  3665. Also see `markdown-pre-indentation'."
  3666. (save-excursion
  3667. (goto-char loc)
  3668. (let* ((list-level (length (markdown-calculate-list-levels)))
  3669. (indent ""))
  3670. (dotimes (_ list-level indent)
  3671. (setq indent (concat indent " "))))))
  3672. (defun markdown-insert-blockquote ()
  3673. "Start a blockquote section (or blockquote the region).
  3674. If Transient Mark mode is on and a region is active, it is used as
  3675. the blockquote text."
  3676. (interactive)
  3677. (if (use-region-p)
  3678. (markdown-blockquote-region (region-beginning) (region-end))
  3679. (markdown-ensure-blank-line-before)
  3680. (insert (markdown-blockquote-indentation (point)) "> ")
  3681. (markdown-ensure-blank-line-after)))
  3682. (defun markdown-block-region (beg end prefix)
  3683. "Format the region using a block prefix.
  3684. Arguments BEG and END specify the beginning and end of the
  3685. region. The characters PREFIX will appear at the beginning
  3686. of each line."
  3687. (save-excursion
  3688. (let* ((end-marker (make-marker))
  3689. (beg-marker (make-marker))
  3690. (prefix-without-trailing-whitespace
  3691. (replace-regexp-in-string (rx (+ blank) eos) "" prefix)))
  3692. ;; Ensure blank line after and remove extra whitespace
  3693. (goto-char end)
  3694. (skip-syntax-backward "-")
  3695. (set-marker end-marker (point))
  3696. (delete-horizontal-space)
  3697. (markdown-ensure-blank-line-after)
  3698. ;; Ensure blank line before and remove extra whitespace
  3699. (goto-char beg)
  3700. (skip-syntax-forward "-")
  3701. (delete-horizontal-space)
  3702. (markdown-ensure-blank-line-before)
  3703. (set-marker beg-marker (point))
  3704. ;; Insert PREFIX before each line
  3705. (goto-char beg-marker)
  3706. (while (and (< (line-beginning-position) end-marker)
  3707. (not (eobp)))
  3708. ;; Don’t insert trailing whitespace.
  3709. (insert (if (eolp) prefix-without-trailing-whitespace prefix))
  3710. (forward-line)))))
  3711. (defun markdown-blockquote-region (beg end)
  3712. "Blockquote the region.
  3713. Arguments BEG and END specify the beginning and end of the region."
  3714. (interactive "*r")
  3715. (markdown-block-region
  3716. beg end (concat (markdown-blockquote-indentation
  3717. (max (point-min) (1- beg))) "> ")))
  3718. (defun markdown-pre-indentation (loc)
  3719. "Return string containing necessary whitespace for a pre block at LOC.
  3720. Also see `markdown-blockquote-indentation'."
  3721. (save-excursion
  3722. (goto-char loc)
  3723. (let* ((list-level (length (markdown-calculate-list-levels)))
  3724. indent)
  3725. (dotimes (_ (1+ list-level) indent)
  3726. (setq indent (concat indent " "))))))
  3727. (defun markdown-insert-pre ()
  3728. "Start a preformatted section (or apply to the region).
  3729. If Transient Mark mode is on and a region is active, it is marked
  3730. as preformatted text."
  3731. (interactive)
  3732. (if (use-region-p)
  3733. (markdown-pre-region (region-beginning) (region-end))
  3734. (markdown-ensure-blank-line-before)
  3735. (insert (markdown-pre-indentation (point)))
  3736. (markdown-ensure-blank-line-after)))
  3737. (defun markdown-pre-region (beg end)
  3738. "Format the region as preformatted text.
  3739. Arguments BEG and END specify the beginning and end of the region."
  3740. (interactive "*r")
  3741. (let ((indent (markdown-pre-indentation (max (point-min) (1- beg)))))
  3742. (markdown-block-region beg end indent)))
  3743. (defun markdown-electric-backquote (arg)
  3744. "Insert a backquote.
  3745. The numeric prefix argument ARG says how many times to repeat the insertion.
  3746. Call `markdown-insert-gfm-code-block' interactively
  3747. if three backquotes inserted at the beginning of line."
  3748. (interactive "*P")
  3749. (self-insert-command (prefix-numeric-value arg))
  3750. (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil))
  3751. (replace-match "")
  3752. (call-interactively #'markdown-insert-gfm-code-block)))
  3753. (defconst markdown-gfm-recognized-languages
  3754. ;; To reproduce/update, evaluate the let-form in
  3755. ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp,
  3756. ;; but with appropriate use of a keyboard macro, indenting and filling it
  3757. ;; properly is pretty fast.
  3758. '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR"
  3759. "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada"
  3760. "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer"
  3761. "AngelScript" "Ant-Build-System" "ApacheConf" "Apex"
  3762. "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly"
  3763. "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile"
  3764. "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax"
  3765. "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump"
  3766. "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb"
  3767. "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK"
  3768. "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates"
  3769. "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript"
  3770. "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language"
  3771. "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound"
  3772. "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump"
  3773. "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch"
  3774. "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript"
  3775. "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild"
  3776. "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm"
  3777. "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor"
  3778. "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth"
  3779. "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS"
  3780. "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN"
  3781. "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass"
  3782. "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config"
  3783. "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu"
  3784. "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL"
  3785. "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML"
  3786. "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP"
  3787. "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC"
  3788. "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7"
  3789. "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON"
  3790. "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java"
  3791. "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison"
  3792. "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout"
  3793. "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE"
  3794. "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex"
  3795. "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid"
  3796. "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript"
  3797. "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB"
  3798. "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako"
  3799. "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki"
  3800. "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah"
  3801. "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode"
  3802. "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL"
  3803. "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo"
  3804. "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml"
  3805. "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C"
  3806. "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal"
  3807. "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript"
  3808. "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox"
  3809. "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus"
  3810. "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn"
  3811. "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod"
  3812. "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell"
  3813. "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer"
  3814. "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python"
  3815. "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc"
  3816. "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket"
  3817. "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol"
  3818. "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript"
  3819. "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage"
  3820. "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL"
  3821. "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass"
  3822. "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession"
  3823. "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity"
  3824. "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark"
  3825. "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift"
  3826. "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh"
  3827. "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle"
  3828. "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset"
  3829. "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL"
  3830. "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue"
  3831. "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly"
  3832. "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok"
  3833. "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap"
  3834. "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS"
  3835. "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL"
  3836. "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors"
  3837. "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc"
  3838. "reStructuredText" "sed" "wdl" "wisp" "xBase")
  3839. "Language specifiers recognized by GitHub's syntax highlighting features.")
  3840. (defvar-local markdown-gfm-used-languages nil
  3841. "Language names used in GFM code blocks.")
  3842. (defun markdown-trim-whitespace (str)
  3843. (replace-regexp-in-string
  3844. "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str))
  3845. (defun markdown-clean-language-string (str)
  3846. (replace-regexp-in-string
  3847. "{\\.?\\|}" "" (markdown-trim-whitespace str)))
  3848. (defun markdown-validate-language-string (widget)
  3849. (let ((str (widget-value widget)))
  3850. (unless (string= str (markdown-clean-language-string str))
  3851. (widget-put widget :error (format "Invalid language spec: '%s'" str))
  3852. widget)))
  3853. (defun markdown-gfm-get-corpus ()
  3854. "Create corpus of recognized GFM code block languages for the given buffer."
  3855. (let ((given-corpus (append markdown-gfm-additional-languages
  3856. markdown-gfm-recognized-languages)))
  3857. (append
  3858. markdown-gfm-used-languages
  3859. (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus)
  3860. given-corpus))))
  3861. (defun markdown-gfm-add-used-language (lang)
  3862. "Clean LANG and add to list of used languages."
  3863. (setq markdown-gfm-used-languages
  3864. (cons lang (remove lang markdown-gfm-used-languages))))
  3865. (defcustom markdown-spaces-after-code-fence 1
  3866. "Number of space characters to insert after a code fence.
  3867. \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an
  3868. opening code fence and an info string."
  3869. :group 'markdown
  3870. :type 'integer
  3871. :safe #'natnump
  3872. :package-version '(markdown-mode . "2.3"))
  3873. (defun markdown-insert-gfm-code-block (&optional lang edit)
  3874. "Insert GFM code block for language LANG.
  3875. If LANG is nil, the language will be queried from user. If a
  3876. region is active, wrap this region with the markup instead. If
  3877. the region boundaries are not on empty lines, these are added
  3878. automatically in order to have the correct markup. When EDIT is
  3879. non-nil (e.g., when \\[universal-argument] is given), edit the
  3880. code block in an indirect buffer after insertion."
  3881. (interactive
  3882. (list (let ((completion-ignore-case nil))
  3883. (condition-case nil
  3884. (markdown-clean-language-string
  3885. (completing-read
  3886. "Programming language: "
  3887. (markdown-gfm-get-corpus)
  3888. nil 'confirm (car markdown-gfm-used-languages)
  3889. 'markdown-gfm-language-history))
  3890. (quit "")))
  3891. current-prefix-arg))
  3892. (unless (string= lang "") (markdown-gfm-add-used-language lang))
  3893. (when (> (length lang) 0)
  3894. (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s)
  3895. lang)))
  3896. (if (use-region-p)
  3897. (let* ((b (region-beginning)) (e (region-end)) end
  3898. (indent (progn (goto-char b) (current-indentation))))
  3899. (goto-char e)
  3900. ;; if we're on a blank line, don't newline, otherwise the ```
  3901. ;; should go on its own line
  3902. (unless (looking-back "\n" nil)
  3903. (newline))
  3904. (indent-to indent)
  3905. (insert "```")
  3906. (markdown-ensure-blank-line-after)
  3907. (setq end (point))
  3908. (goto-char b)
  3909. ;; if we're on a blank line, insert the quotes here, otherwise
  3910. ;; add a new line first
  3911. (unless (looking-at-p "\n")
  3912. (newline)
  3913. (forward-line -1))
  3914. (markdown-ensure-blank-line-before)
  3915. (indent-to indent)
  3916. (insert "```" lang)
  3917. (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end))
  3918. (let ((indent (current-indentation)) start-bol)
  3919. (delete-horizontal-space :backward-only)
  3920. (markdown-ensure-blank-line-before)
  3921. (indent-to indent)
  3922. (setq start-bol (point-at-bol))
  3923. (insert "```" lang "\n")
  3924. (indent-to indent)
  3925. (unless edit (insert ?\n))
  3926. (indent-to indent)
  3927. (insert "```")
  3928. (markdown-ensure-blank-line-after)
  3929. (markdown-syntax-propertize-fenced-block-constructs start-bol (point)))
  3930. (end-of-line 0)
  3931. (when edit (markdown-edit-code-block))))
  3932. (defun markdown-code-block-lang (&optional pos-prop)
  3933. "Return the language name for a GFM or tilde fenced code block.
  3934. The beginning of the block may be described by POS-PROP,
  3935. a cons of (pos . prop) giving the position and property
  3936. at the beginning of the block."
  3937. (or pos-prop
  3938. (setq pos-prop
  3939. (markdown-max-of-seq
  3940. #'car
  3941. (cl-remove-if
  3942. #'null
  3943. (cl-mapcar
  3944. #'markdown-find-previous-prop
  3945. (markdown-get-fenced-block-begin-properties))))))
  3946. (when pos-prop
  3947. (goto-char (car pos-prop))
  3948. (set-match-data (get-text-property (point) (cdr pos-prop)))
  3949. ;; Note: Hard-coded group number assumes tilde
  3950. ;; and GFM fenced code regexp groups agree.
  3951. (let ((begin (match-beginning 3))
  3952. (end (match-end 3)))
  3953. (when (and begin end)
  3954. ;; Fix language strings beginning with periods, like ".ruby".
  3955. (when (eq (char-after begin) ?.)
  3956. (setq begin (1+ begin)))
  3957. (buffer-substring-no-properties begin end)))))
  3958. (defun markdown-gfm-parse-buffer-for-languages (&optional buffer)
  3959. (with-current-buffer (or buffer (current-buffer))
  3960. (save-excursion
  3961. (goto-char (point-min))
  3962. (cl-loop
  3963. with prop = 'markdown-gfm-block-begin
  3964. for pos-prop = (markdown-find-next-prop prop)
  3965. while pos-prop
  3966. for lang = (markdown-code-block-lang pos-prop)
  3967. do (progn (when lang (markdown-gfm-add-used-language lang))
  3968. (goto-char (next-single-property-change (point) prop)))))))
  3969. ;;; Footnotes =================================================================
  3970. (defun markdown-footnote-counter-inc ()
  3971. "Increment `markdown-footnote-counter' and return the new value."
  3972. (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet.
  3973. (save-excursion
  3974. (goto-char (point-min))
  3975. (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:")
  3976. (point-max) t)
  3977. (let ((fn (string-to-number (match-string 1))))
  3978. (when (> fn markdown-footnote-counter)
  3979. (setq markdown-footnote-counter fn))))))
  3980. (cl-incf markdown-footnote-counter))
  3981. (defun markdown-insert-footnote ()
  3982. "Insert footnote with a new number and move point to footnote definition."
  3983. (interactive)
  3984. (let ((fn (markdown-footnote-counter-inc)))
  3985. (insert (format "[^%d]" fn))
  3986. (markdown-footnote-text-find-new-location)
  3987. (markdown-ensure-blank-line-before)
  3988. (unless (markdown-cur-line-blank-p)
  3989. (insert "\n"))
  3990. (insert (format "[^%d]: " fn))
  3991. (markdown-ensure-blank-line-after)))
  3992. (defun markdown-footnote-text-find-new-location ()
  3993. "Position the point at the proper location for a new footnote text."
  3994. (cond
  3995. ((eq markdown-footnote-location 'end) (goto-char (point-max)))
  3996. ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block))
  3997. ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree))
  3998. ((eq markdown-footnote-location 'header) (markdown-end-of-defun))))
  3999. (defun markdown-footnote-kill ()
  4000. "Kill the footnote at point.
  4001. The footnote text is killed (and added to the kill ring), the
  4002. footnote marker is deleted. Point has to be either at the
  4003. footnote marker or in the footnote text."
  4004. (interactive)
  4005. (let ((marker-pos nil)
  4006. (skip-deleting-marker nil)
  4007. (starting-footnote-text-positions
  4008. (markdown-footnote-text-positions)))
  4009. (when starting-footnote-text-positions
  4010. ;; We're starting in footnote text, so mark our return position and jump
  4011. ;; to the marker if possible.
  4012. (let ((marker-pos (markdown-footnote-find-marker
  4013. (cl-first starting-footnote-text-positions))))
  4014. (if marker-pos
  4015. (goto-char (1- marker-pos))
  4016. ;; If there isn't a marker, we still want to kill the text.
  4017. (setq skip-deleting-marker t))))
  4018. ;; Either we didn't start in the text, or we started in the text and jumped
  4019. ;; to the marker. We want to assume we're at the marker now and error if
  4020. ;; we're not.
  4021. (unless skip-deleting-marker
  4022. (let ((marker (markdown-footnote-delete-marker)))
  4023. (unless marker
  4024. (error "Not at a footnote"))
  4025. ;; Even if we knew the text position before, it changed when we deleted
  4026. ;; the label.
  4027. (setq marker-pos (cl-second marker))
  4028. (let ((new-text-pos (markdown-footnote-find-text (cl-first marker))))
  4029. (unless new-text-pos
  4030. (error "No text for footnote `%s'" (cl-first marker)))
  4031. (goto-char new-text-pos))))
  4032. (let ((pos (markdown-footnote-kill-text)))
  4033. (goto-char (if starting-footnote-text-positions
  4034. pos
  4035. marker-pos)))))
  4036. (defun markdown-footnote-delete-marker ()
  4037. "Delete a footnote marker at point.
  4038. Returns a list (ID START) containing the footnote ID and the
  4039. start position of the marker before deletion. If no footnote
  4040. marker was deleted, this function returns NIL."
  4041. (let ((marker (markdown-footnote-marker-positions)))
  4042. (when marker
  4043. (delete-region (cl-second marker) (cl-third marker))
  4044. (butlast marker))))
  4045. (defun markdown-footnote-kill-text ()
  4046. "Kill footnote text at point.
  4047. Returns the start position of the footnote text before deletion,
  4048. or NIL if point was not inside a footnote text.
  4049. The killed text is placed in the kill ring (without the footnote
  4050. number)."
  4051. (let ((fn (markdown-footnote-text-positions)))
  4052. (when fn
  4053. (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn))))
  4054. (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text)
  4055. (kill-new (match-string 1 text))
  4056. (when (and (markdown-cur-line-blank-p)
  4057. (markdown-prev-line-blank-p)
  4058. (not (bobp)))
  4059. (delete-region (1- (point)) (point)))
  4060. (cl-second fn)))))
  4061. (defun markdown-footnote-goto-text ()
  4062. "Jump to the text of the footnote at point."
  4063. (interactive)
  4064. (let ((fn (car (markdown-footnote-marker-positions))))
  4065. (unless fn
  4066. (user-error "Not at a footnote marker"))
  4067. (let ((new-pos (markdown-footnote-find-text fn)))
  4068. (unless new-pos
  4069. (error "No definition found for footnote `%s'" fn))
  4070. (goto-char new-pos))))
  4071. (defun markdown-footnote-return ()
  4072. "Return from a footnote to its footnote number in the main text."
  4073. (interactive)
  4074. (let ((fn (save-excursion
  4075. (car (markdown-footnote-text-positions)))))
  4076. (unless fn
  4077. (user-error "Not in a footnote"))
  4078. (let ((new-pos (markdown-footnote-find-marker fn)))
  4079. (unless new-pos
  4080. (error "Footnote marker `%s' not found" fn))
  4081. (goto-char new-pos))))
  4082. (defun markdown-footnote-find-marker (id)
  4083. "Find the location of the footnote marker with ID.
  4084. The actual buffer position returned is the position directly
  4085. following the marker's closing bracket. If no marker is found,
  4086. NIL is returned."
  4087. (save-excursion
  4088. (goto-char (point-min))
  4089. (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t)
  4090. (skip-chars-backward "^]")
  4091. (point))))
  4092. (defun markdown-footnote-find-text (id)
  4093. "Find the location of the text of footnote ID.
  4094. The actual buffer position returned is the position of the first
  4095. character of the text, after the footnote's identifier. If no
  4096. footnote text is found, NIL is returned."
  4097. (save-excursion
  4098. (goto-char (point-min))
  4099. (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t)
  4100. (skip-chars-forward "[ \t]")
  4101. (point))))
  4102. (defun markdown-footnote-marker-positions ()
  4103. "Return the position and ID of the footnote marker point is on.
  4104. The return value is a list (ID START END). If point is not on a
  4105. footnote, NIL is returned."
  4106. ;; first make sure we're at a footnote marker
  4107. (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position))
  4108. (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]")))
  4109. (save-excursion
  4110. ;; move point between [ and ^:
  4111. (if (looking-at-p "\\[")
  4112. (forward-char 1)
  4113. (skip-chars-backward "^["))
  4114. (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]"))
  4115. (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1))))))
  4116. (defun markdown-footnote-text-positions ()
  4117. "Return the start and end positions of the footnote text point is in.
  4118. The exact return value is a list of three elements: (ID START END).
  4119. The start position is the position of the opening bracket
  4120. of the footnote id. The end position is directly after the
  4121. newline that ends the footnote. If point is not in a footnote,
  4122. NIL is returned instead."
  4123. (save-excursion
  4124. (let (result)
  4125. (move-beginning-of-line 1)
  4126. ;; Try to find the label. If we haven't found the label and we're at a blank
  4127. ;; or indented line, back up if possible.
  4128. (while (and
  4129. (not (and (looking-at markdown-regex-footnote-definition)
  4130. (setq result (list (match-string 1) (point)))))
  4131. (and (not (bobp))
  4132. (or (markdown-cur-line-blank-p)
  4133. (>= (current-indentation) 4))))
  4134. (forward-line -1))
  4135. (when result
  4136. ;; Advance if there is a next line that is either blank or indented.
  4137. ;; (Need to check if we're on the last line, because
  4138. ;; markdown-next-line-blank-p returns true for last line in buffer.)
  4139. (while (and (/= (line-end-position) (point-max))
  4140. (or (markdown-next-line-blank-p)
  4141. (>= (markdown-next-line-indent) 4)))
  4142. (forward-line))
  4143. ;; Move back while the current line is blank.
  4144. (while (markdown-cur-line-blank-p)
  4145. (forward-line -1))
  4146. ;; Advance to capture this line and a single trailing newline (if there
  4147. ;; is one).
  4148. (forward-line)
  4149. (append result (list (point)))))))
  4150. (defun markdown-get-defined-footnotes ()
  4151. "Return a list of all defined footnotes.
  4152. Result is an alist of pairs (MARKER . LINE), where MARKER is the
  4153. footnote marker, a string, and LINE is the line number containing
  4154. the footnote definition.
  4155. For example, suppose the following footnotes are defined at positions
  4156. 448 and 475:
  4157. \[^1]: First footnote here.
  4158. \[^marker]: Second footnote.
  4159. Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))"
  4160. (save-excursion
  4161. (goto-char (point-min))
  4162. (let (footnotes)
  4163. (while (markdown-search-until-condition
  4164. (lambda () (and (not (markdown-code-block-at-point-p))
  4165. (not (markdown-inline-code-at-point-p))
  4166. (not (markdown-in-comment-p))))
  4167. markdown-regex-footnote-definition nil t)
  4168. (let ((marker (match-string-no-properties 1))
  4169. (pos (match-beginning 0)))
  4170. (unless (zerop (length marker))
  4171. (cl-pushnew (cons marker pos) footnotes :test #'equal))))
  4172. (reverse footnotes))))
  4173. ;;; Element Removal ===========================================================
  4174. (defun markdown-kill-thing-at-point ()
  4175. "Kill thing at point and add important text, without markup, to kill ring.
  4176. Possible things to kill include (roughly in order of precedence):
  4177. inline code, headers, horizontal rules, links (add link text to
  4178. kill ring), images (add alt text to kill ring), angle uri, email
  4179. addresses, bold, italics, reference definition (add URI to kill
  4180. ring), footnote markers and text (kill both marker and text, add
  4181. text to kill ring), and list items."
  4182. (interactive "*")
  4183. (let (val)
  4184. (cond
  4185. ;; Inline code
  4186. ((markdown-inline-code-at-point)
  4187. (kill-new (match-string 2))
  4188. (delete-region (match-beginning 0) (match-end 0)))
  4189. ;; ATX header
  4190. ((thing-at-point-looking-at markdown-regex-header-atx)
  4191. (kill-new (match-string 2))
  4192. (delete-region (match-beginning 0) (match-end 0)))
  4193. ;; Setext header
  4194. ((thing-at-point-looking-at markdown-regex-header-setext)
  4195. (kill-new (match-string 1))
  4196. (delete-region (match-beginning 0) (match-end 0)))
  4197. ;; Horizontal rule
  4198. ((thing-at-point-looking-at markdown-regex-hr)
  4199. (kill-new (match-string 0))
  4200. (delete-region (match-beginning 0) (match-end 0)))
  4201. ;; Inline link or image (add link or alt text to kill ring)
  4202. ((thing-at-point-looking-at markdown-regex-link-inline)
  4203. (kill-new (match-string 3))
  4204. (delete-region (match-beginning 0) (match-end 0)))
  4205. ;; Reference link or image (add link or alt text to kill ring)
  4206. ((thing-at-point-looking-at markdown-regex-link-reference)
  4207. (kill-new (match-string 3))
  4208. (delete-region (match-beginning 0) (match-end 0)))
  4209. ;; Angle URI (add URL to kill ring)
  4210. ((thing-at-point-looking-at markdown-regex-angle-uri)
  4211. (kill-new (match-string 2))
  4212. (delete-region (match-beginning 0) (match-end 0)))
  4213. ;; Email address in angle brackets (add email address to kill ring)
  4214. ((thing-at-point-looking-at markdown-regex-email)
  4215. (kill-new (match-string 1))
  4216. (delete-region (match-beginning 0) (match-end 0)))
  4217. ;; Wiki link (add alias text to kill ring)
  4218. ((and markdown-enable-wiki-links
  4219. (thing-at-point-looking-at markdown-regex-wiki-link))
  4220. (kill-new (markdown-wiki-link-alias))
  4221. (delete-region (match-beginning 1) (match-end 1)))
  4222. ;; Bold
  4223. ((thing-at-point-looking-at markdown-regex-bold)
  4224. (kill-new (match-string 4))
  4225. (delete-region (match-beginning 2) (match-end 2)))
  4226. ;; Italics
  4227. ((thing-at-point-looking-at markdown-regex-italic)
  4228. (kill-new (match-string 3))
  4229. (delete-region (match-beginning 1) (match-end 1)))
  4230. ;; Strikethrough
  4231. ((thing-at-point-looking-at markdown-regex-strike-through)
  4232. (kill-new (match-string 4))
  4233. (delete-region (match-beginning 2) (match-end 2)))
  4234. ;; Footnote marker (add footnote text to kill ring)
  4235. ((thing-at-point-looking-at markdown-regex-footnote)
  4236. (markdown-footnote-kill))
  4237. ;; Footnote text (add footnote text to kill ring)
  4238. ((setq val (markdown-footnote-text-positions))
  4239. (markdown-footnote-kill))
  4240. ;; Reference definition (add URL to kill ring)
  4241. ((thing-at-point-looking-at markdown-regex-reference-definition)
  4242. (kill-new (match-string 5))
  4243. (delete-region (match-beginning 0) (match-end 0)))
  4244. ;; List item
  4245. ((setq val (markdown-cur-list-item-bounds))
  4246. (kill-new (delete-and-extract-region (cl-first val) (cl-second val))))
  4247. (t
  4248. (user-error "Nothing found at point to kill")))))
  4249. (defun markdown-kill-outline ()
  4250. "Kill visible heading and add it to `kill-ring'."
  4251. (interactive)
  4252. (save-excursion
  4253. (markdown-outline-previous)
  4254. (kill-region (point) (progn (markdown-outline-next) (point)))))
  4255. (defun markdown-kill-block ()
  4256. "Kill visible code block, list item, or blockquote and add it to `kill-ring'."
  4257. (interactive)
  4258. (save-excursion
  4259. (markdown-backward-block)
  4260. (kill-region (point) (progn (markdown-forward-block) (point)))))
  4261. ;;; Indentation ===============================================================
  4262. (defun markdown-indent-find-next-position (cur-pos positions)
  4263. "Return the position after the index of CUR-POS in POSITIONS.
  4264. Positions are calculated by `markdown-calc-indents'."
  4265. (while (and positions
  4266. (not (equal cur-pos (car positions))))
  4267. (setq positions (cdr positions)))
  4268. (or (cadr positions) 0))
  4269. (defun markdown-outdent-find-next-position (cur-pos positions)
  4270. "Return the maximal element that precedes CUR-POS from POSITIONS.
  4271. Positions are calculated by `markdown-calc-indents'."
  4272. (let ((result 0))
  4273. (dolist (i positions)
  4274. (when (< i cur-pos)
  4275. (setq result (max result i))))
  4276. result))
  4277. (defun markdown-indent-line ()
  4278. "Indent the current line using some heuristics.
  4279. If the _previous_ command was either `markdown-enter-key' or
  4280. `markdown-cycle', then we should cycle to the next
  4281. reasonable indentation position. Otherwise, we could have been
  4282. called directly by `markdown-enter-key', by an initial call of
  4283. `markdown-cycle', or indirectly by `auto-fill-mode'. In
  4284. these cases, indent to the default position.
  4285. Positions are calculated by `markdown-calc-indents'."
  4286. (interactive)
  4287. (let ((positions (markdown-calc-indents))
  4288. (point-pos (current-column))
  4289. (_ (back-to-indentation))
  4290. (cur-pos (current-column)))
  4291. (if (not (equal this-command 'markdown-cycle))
  4292. (indent-line-to (car positions))
  4293. (setq positions (sort (delete-dups positions) '<))
  4294. (let* ((next-pos (markdown-indent-find-next-position cur-pos positions))
  4295. (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0)))
  4296. (indent-line-to next-pos)
  4297. (move-to-column new-point-pos)))))
  4298. (defun markdown-calc-indents ()
  4299. "Return a list of indentation columns to cycle through.
  4300. The first element in the returned list should be considered the
  4301. default indentation level. This function does not worry about
  4302. duplicate positions, which are handled up by calling functions."
  4303. (let (pos prev-line-pos positions)
  4304. ;; Indentation of previous line
  4305. (setq prev-line-pos (markdown-prev-line-indent))
  4306. (setq positions (cons prev-line-pos positions))
  4307. ;; Indentation of previous non-list-marker text
  4308. (when (setq pos (save-excursion
  4309. (forward-line -1)
  4310. (when (looking-at markdown-regex-list)
  4311. (- (match-end 3) (match-beginning 0)))))
  4312. (setq positions (cons pos positions)))
  4313. ;; Indentation required for a pre block in current context
  4314. (setq pos (length (markdown-pre-indentation (point))))
  4315. (setq positions (cons pos positions))
  4316. ;; Indentation of the previous line + tab-width
  4317. (if prev-line-pos
  4318. (setq positions (cons (+ prev-line-pos tab-width) positions))
  4319. (setq positions (cons tab-width positions)))
  4320. ;; Indentation of the previous line - tab-width
  4321. (if (and prev-line-pos (> prev-line-pos tab-width))
  4322. (setq positions (cons (- prev-line-pos tab-width) positions)))
  4323. ;; Indentation of all preceding list markers (when in a list)
  4324. (when (setq pos (markdown-calculate-list-levels))
  4325. (setq positions (append pos positions)))
  4326. ;; First column
  4327. (setq positions (cons 0 positions))
  4328. ;; Return reversed list
  4329. (reverse positions)))
  4330. (defun markdown-enter-key ()
  4331. "Handle RET depending on the context.
  4332. If the point is at a table, move to the next row. Otherwise,
  4333. indent according to value of `markdown-indent-on-enter'.
  4334. When it is nil, simply call `newline'. Otherwise, indent the next line
  4335. following RET using `markdown-indent-line'. Furthermore, when it
  4336. is set to 'indent-and-new-item and the point is in a list item,
  4337. start a new item with the same indentation. If the point is in an
  4338. empty list item, remove it (so that pressing RET twice when in a
  4339. list simply adds a blank line)."
  4340. (interactive)
  4341. (cond
  4342. ;; Table
  4343. ((markdown-table-at-point-p)
  4344. (call-interactively #'markdown-table-next-row))
  4345. ;; Indent non-table text
  4346. (markdown-indent-on-enter
  4347. (let (bounds)
  4348. (if (and (memq markdown-indent-on-enter '(indent-and-new-item))
  4349. (setq bounds (markdown-cur-list-item-bounds)))
  4350. (let ((beg (cl-first bounds))
  4351. (end (cl-second bounds))
  4352. (length (cl-fourth bounds)))
  4353. ;; Point is in a list item
  4354. (if (= (- end beg) length)
  4355. ;; Delete blank list
  4356. (progn
  4357. (delete-region beg end)
  4358. (newline)
  4359. (markdown-indent-line))
  4360. (call-interactively #'markdown-insert-list-item)))
  4361. ;; Point is not in a list
  4362. (newline)
  4363. (markdown-indent-line))))
  4364. ;; Insert a raw newline
  4365. (t (newline))))
  4366. (defun markdown-outdent-or-delete (arg)
  4367. "Handle BACKSPACE by cycling through indentation points.
  4368. When BACKSPACE is pressed, if there is only whitespace
  4369. before the current point, then outdent the line one level.
  4370. Otherwise, do normal delete by repeating
  4371. `backward-delete-char-untabify' ARG times."
  4372. (interactive "*p")
  4373. (if (use-region-p)
  4374. (backward-delete-char-untabify arg)
  4375. (let ((cur-pos (current-column))
  4376. (start-of-indention (save-excursion
  4377. (back-to-indentation)
  4378. (current-column)))
  4379. (positions (markdown-calc-indents)))
  4380. (if (and (> cur-pos 0) (= cur-pos start-of-indention))
  4381. (indent-line-to (markdown-outdent-find-next-position cur-pos positions))
  4382. (backward-delete-char-untabify arg)))))
  4383. (defun markdown-find-leftmost-column (beg end)
  4384. "Find the leftmost column in the region from BEG to END."
  4385. (let ((mincol 1000))
  4386. (save-excursion
  4387. (goto-char beg)
  4388. (while (< (point) end)
  4389. (back-to-indentation)
  4390. (unless (looking-at-p "[ \t]*$")
  4391. (setq mincol (min mincol (current-column))))
  4392. (forward-line 1)
  4393. ))
  4394. mincol))
  4395. (defun markdown-indent-region (beg end arg)
  4396. "Indent the region from BEG to END using some heuristics.
  4397. When ARG is non-nil, outdent the region instead.
  4398. See `markdown-indent-line' and `markdown-indent-line'."
  4399. (interactive "*r\nP")
  4400. (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<))
  4401. (leftmostcol (markdown-find-leftmost-column beg end))
  4402. (next-pos (if arg
  4403. (markdown-outdent-find-next-position leftmostcol positions)
  4404. (markdown-indent-find-next-position leftmostcol positions))))
  4405. (indent-rigidly beg end (- next-pos leftmostcol))
  4406. (setq deactivate-mark nil)))
  4407. (defun markdown-outdent-region (beg end)
  4408. "Call `markdown-indent-region' on region from BEG to END with prefix."
  4409. (interactive "*r")
  4410. (markdown-indent-region beg end t))
  4411. (defun markdown--indent-region (start end)
  4412. (let ((deactivate-mark nil))
  4413. (save-excursion
  4414. (goto-char end)
  4415. (setq end (point-marker))
  4416. (goto-char start)
  4417. (when (bolp)
  4418. (forward-line 1))
  4419. (while (< (point) end)
  4420. (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp)))
  4421. (indent-according-to-mode))
  4422. (forward-line 1))
  4423. (move-marker end nil))))
  4424. ;;; Markup Completion =========================================================
  4425. (defconst markdown-complete-alist
  4426. '((markdown-regex-header-atx . markdown-complete-atx)
  4427. (markdown-regex-header-setext . markdown-complete-setext)
  4428. (markdown-regex-hr . markdown-complete-hr))
  4429. "Association list of form (regexp . function) for markup completion.")
  4430. (defun markdown-incomplete-atx-p ()
  4431. "Return t if ATX header markup is incomplete and nil otherwise.
  4432. Assumes match data is available for `markdown-regex-header-atx'.
  4433. Checks that the number of trailing hash marks equals the number of leading
  4434. hash marks, that there is only a single space before and after the text,
  4435. and that there is no extraneous whitespace in the text."
  4436. (or
  4437. ;; Number of starting and ending hash marks differs
  4438. (not (= (length (match-string 1)) (length (match-string 3))))
  4439. ;; When the header text is not empty...
  4440. (and (> (length (match-string 2)) 0)
  4441. ;; ...if there are extra leading, trailing, or interior spaces
  4442. (or (not (= (match-beginning 2) (1+ (match-end 1))))
  4443. (not (= (match-beginning 3) (1+ (match-end 2))))
  4444. (string-match-p "[ \t\n]\\{2\\}" (match-string 2))))
  4445. ;; When the header text is empty...
  4446. (and (= (length (match-string 2)) 0)
  4447. ;; ...if there are too many or too few spaces
  4448. (not (= (match-beginning 3) (+ (match-end 1) 2))))))
  4449. (defun markdown-complete-atx ()
  4450. "Complete and normalize ATX headers.
  4451. Add or remove hash marks to the end of the header to match the
  4452. beginning. Ensure that there is only a single space between hash
  4453. marks and header text. Removes extraneous whitespace from header text.
  4454. Assumes match data is available for `markdown-regex-header-atx'.
  4455. Return nil if markup was complete and non-nil if markup was completed."
  4456. (when (markdown-incomplete-atx-p)
  4457. (let* ((new-marker (make-marker))
  4458. (new-marker (set-marker new-marker (match-end 2))))
  4459. ;; Hash marks and spacing at end
  4460. (goto-char (match-end 2))
  4461. (delete-region (match-end 2) (match-end 3))
  4462. (insert " " (match-string 1))
  4463. ;; Remove extraneous whitespace from title
  4464. (replace-match (markdown-compress-whitespace-string (match-string 2))
  4465. t t nil 2)
  4466. ;; Spacing at beginning
  4467. (goto-char (match-end 1))
  4468. (delete-region (match-end 1) (match-beginning 2))
  4469. (insert " ")
  4470. ;; Leave point at end of text
  4471. (goto-char new-marker))))
  4472. (defun markdown-incomplete-setext-p ()
  4473. "Return t if setext header markup is incomplete and nil otherwise.
  4474. Assumes match data is available for `markdown-regex-header-setext'.
  4475. Checks that length of underline matches text and that there is no
  4476. extraneous whitespace in the text."
  4477. (or (not (= (length (match-string 1)) (length (match-string 2))))
  4478. (string-match-p "[ \t\n]\\{2\\}" (match-string 1))))
  4479. (defun markdown-complete-setext ()
  4480. "Complete and normalize setext headers.
  4481. Add or remove underline characters to match length of header
  4482. text. Removes extraneous whitespace from header text. Assumes
  4483. match data is available for `markdown-regex-header-setext'.
  4484. Return nil if markup was complete and non-nil if markup was completed."
  4485. (when (markdown-incomplete-setext-p)
  4486. (let* ((text (markdown-compress-whitespace-string (match-string 1)))
  4487. (char (char-after (match-beginning 2)))
  4488. (level (if (char-equal char ?-) 2 1)))
  4489. (goto-char (match-beginning 0))
  4490. (delete-region (match-beginning 0) (match-end 0))
  4491. (markdown-insert-header level text t)
  4492. t)))
  4493. (defun markdown-incomplete-hr-p ()
  4494. "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise.
  4495. Assumes match data is available for `markdown-regex-hr'."
  4496. (not (member (match-string 0) markdown-hr-strings)))
  4497. (defun markdown-complete-hr ()
  4498. "Complete horizontal rules.
  4499. If horizontal rule string is a member of `markdown-hr-strings',
  4500. do nothing. Otherwise, replace with the car of
  4501. `markdown-hr-strings'.
  4502. Assumes match data is available for `markdown-regex-hr'.
  4503. Return nil if markup was complete and non-nil if markup was completed."
  4504. (when (markdown-incomplete-hr-p)
  4505. (replace-match (car markdown-hr-strings))
  4506. t))
  4507. (defun markdown-complete ()
  4508. "Complete markup of object near point or in region when active.
  4509. Handle all objects in `markdown-complete-alist', in order.
  4510. See `markdown-complete-at-point' and `markdown-complete-region'."
  4511. (interactive "*")
  4512. (if (use-region-p)
  4513. (markdown-complete-region (region-beginning) (region-end))
  4514. (markdown-complete-at-point)))
  4515. (defun markdown-complete-at-point ()
  4516. "Complete markup of object near point.
  4517. Handle all elements of `markdown-complete-alist' in order."
  4518. (interactive "*")
  4519. (let ((list markdown-complete-alist) found changed)
  4520. (while list
  4521. (let ((regexp (eval (caar list)))
  4522. (function (cdar list)))
  4523. (setq list (cdr list))
  4524. (when (thing-at-point-looking-at regexp)
  4525. (setq found t)
  4526. (setq changed (funcall function))
  4527. (setq list nil))))
  4528. (if found
  4529. (or changed (user-error "Markup at point is complete"))
  4530. (user-error "Nothing to complete at point"))))
  4531. (defun markdown-complete-region (beg end)
  4532. "Complete markup of objects in region from BEG to END.
  4533. Handle all objects in `markdown-complete-alist', in order. Each
  4534. match is checked to ensure that a previous regexp does not also
  4535. match."
  4536. (interactive "*r")
  4537. (let ((end-marker (set-marker (make-marker) end))
  4538. previous)
  4539. (dolist (element markdown-complete-alist)
  4540. (let ((regexp (eval (car element)))
  4541. (function (cdr element)))
  4542. (goto-char beg)
  4543. (while (re-search-forward regexp end-marker 'limit)
  4544. (when (match-string 0)
  4545. ;; Make sure this is not a match for any of the preceding regexps.
  4546. ;; This prevents mistaking an HR for a Setext subheading.
  4547. (let (match)
  4548. (save-match-data
  4549. (dolist (prev-regexp previous)
  4550. (or match (setq match (looking-back prev-regexp nil)))))
  4551. (unless match
  4552. (save-excursion (funcall function))))))
  4553. (cl-pushnew regexp previous :test #'equal)))
  4554. previous))
  4555. (defun markdown-complete-buffer ()
  4556. "Complete markup for all objects in the current buffer."
  4557. (interactive "*")
  4558. (markdown-complete-region (point-min) (point-max)))
  4559. ;;; Markup Cycling ============================================================
  4560. (defun markdown-cycle-atx (arg &optional remove)
  4561. "Cycle ATX header markup.
  4562. Promote header (decrease level) when ARG is 1 and demote
  4563. header (increase level) if arg is -1. When REMOVE is non-nil,
  4564. remove the header when the level reaches zero and stop cycling
  4565. when it reaches six. Otherwise, perform a proper cycling through
  4566. levels one through six. Assumes match data is available for
  4567. `markdown-regex-header-atx'."
  4568. (let* ((old-level (length (match-string 1)))
  4569. (new-level (+ old-level arg))
  4570. (text (match-string 2)))
  4571. (when (not remove)
  4572. (setq new-level (% new-level 6))
  4573. (setq new-level (cond ((= new-level 0) 6)
  4574. ((< new-level 0) (+ new-level 6))
  4575. (t new-level))))
  4576. (cond
  4577. ((= new-level 0)
  4578. (markdown-unwrap-thing-at-point nil 0 2))
  4579. ((<= new-level 6)
  4580. (goto-char (match-beginning 0))
  4581. (delete-region (match-beginning 0) (match-end 0))
  4582. (markdown-insert-header new-level text nil)))))
  4583. (defun markdown-cycle-setext (arg &optional remove)
  4584. "Cycle setext header markup.
  4585. Promote header (increase level) when ARG is 1 and demote
  4586. header (decrease level or remove) if arg is -1. When demoting a
  4587. level-two setext header, replace with a level-three atx header.
  4588. When REMOVE is non-nil, remove the header when the level reaches
  4589. zero. Otherwise, cycle back to a level six atx header. Assumes
  4590. match data is available for `markdown-regex-header-setext'."
  4591. (let* ((char (char-after (match-beginning 2)))
  4592. (old-level (if (char-equal char ?=) 1 2))
  4593. (new-level (+ old-level arg)))
  4594. (when (and (not remove) (= new-level 0))
  4595. (setq new-level 6))
  4596. (cond
  4597. ((= new-level 0)
  4598. (markdown-unwrap-thing-at-point nil 0 1))
  4599. ((<= new-level 2)
  4600. (markdown-insert-header new-level nil t))
  4601. ((<= new-level 6)
  4602. (markdown-insert-header new-level nil nil)))))
  4603. (defun markdown-cycle-hr (arg &optional remove)
  4604. "Cycle string used for horizontal rule from `markdown-hr-strings'.
  4605. When ARG is 1, cycle forward (demote), and when ARG is -1, cycle
  4606. backwards (promote). When REMOVE is non-nil, remove the hr instead
  4607. of cycling when the end of the list is reached.
  4608. Assumes match data is available for `markdown-regex-hr'."
  4609. (let* ((strings (if (= arg -1)
  4610. (reverse markdown-hr-strings)
  4611. markdown-hr-strings))
  4612. (tail (member (match-string 0) strings))
  4613. (new (or (cadr tail)
  4614. (if remove
  4615. (if (= arg 1)
  4616. ""
  4617. (car tail))
  4618. (car strings)))))
  4619. (replace-match new)))
  4620. (defun markdown-cycle-bold ()
  4621. "Cycle bold markup between underscores and asterisks.
  4622. Assumes match data is available for `markdown-regex-bold'."
  4623. (save-excursion
  4624. (let* ((old-delim (match-string 3))
  4625. (new-delim (if (string-equal old-delim "**") "__" "**")))
  4626. (replace-match new-delim t t nil 3)
  4627. (replace-match new-delim t t nil 5))))
  4628. (defun markdown-cycle-italic ()
  4629. "Cycle italic markup between underscores and asterisks.
  4630. Assumes match data is available for `markdown-regex-italic'."
  4631. (save-excursion
  4632. (let* ((old-delim (match-string 2))
  4633. (new-delim (if (string-equal old-delim "*") "_" "*")))
  4634. (replace-match new-delim t t nil 2)
  4635. (replace-match new-delim t t nil 4))))
  4636. ;;; Keymap ====================================================================
  4637. (defun markdown--style-map-prompt ()
  4638. "Return a formatted prompt for Markdown markup insertion."
  4639. (when markdown-enable-prefix-prompts
  4640. (concat
  4641. "Markdown: "
  4642. (propertize "bold" 'face 'markdown-bold-face) ", "
  4643. (propertize "italic" 'face 'markdown-italic-face) ", "
  4644. (propertize "code" 'face 'markdown-inline-code-face) ", "
  4645. (propertize "C = GFM code" 'face 'markdown-code-face) ", "
  4646. (propertize "pre" 'face 'markdown-pre-face) ", "
  4647. (propertize "footnote" 'face 'markdown-footnote-text-face) ", "
  4648. (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", "
  4649. (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", "
  4650. (propertize "- = hr" 'face 'markdown-hr-face) ", "
  4651. "C-h = more")))
  4652. (defun markdown--command-map-prompt ()
  4653. "Return prompt for Markdown buffer-wide commands."
  4654. (when markdown-enable-prefix-prompts
  4655. (concat
  4656. "Command: "
  4657. (propertize "m" 'face 'markdown-bold-face) "arkdown, "
  4658. (propertize "p" 'face 'markdown-bold-face) "review, "
  4659. (propertize "o" 'face 'markdown-bold-face) "pen, "
  4660. (propertize "e" 'face 'markdown-bold-face) "xport, "
  4661. "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, "
  4662. (propertize "c" 'face 'markdown-bold-face) "heck refs, "
  4663. (propertize "u" 'face 'markdown-bold-face) "nused refs, "
  4664. "C-h = more")))
  4665. (defvar markdown-mode-style-map
  4666. (let ((map (make-keymap (markdown--style-map-prompt))))
  4667. (define-key map (kbd "1") 'markdown-insert-header-atx-1)
  4668. (define-key map (kbd "2") 'markdown-insert-header-atx-2)
  4669. (define-key map (kbd "3") 'markdown-insert-header-atx-3)
  4670. (define-key map (kbd "4") 'markdown-insert-header-atx-4)
  4671. (define-key map (kbd "5") 'markdown-insert-header-atx-5)
  4672. (define-key map (kbd "6") 'markdown-insert-header-atx-6)
  4673. (define-key map (kbd "!") 'markdown-insert-header-setext-1)
  4674. (define-key map (kbd "@") 'markdown-insert-header-setext-2)
  4675. (define-key map (kbd "b") 'markdown-insert-bold)
  4676. (define-key map (kbd "c") 'markdown-insert-code)
  4677. (define-key map (kbd "C") 'markdown-insert-gfm-code-block)
  4678. (define-key map (kbd "f") 'markdown-insert-footnote)
  4679. (define-key map (kbd "h") 'markdown-insert-header-dwim)
  4680. (define-key map (kbd "H") 'markdown-insert-header-setext-dwim)
  4681. (define-key map (kbd "i") 'markdown-insert-italic)
  4682. (define-key map (kbd "k") 'markdown-insert-kbd)
  4683. (define-key map (kbd "l") 'markdown-insert-link)
  4684. (define-key map (kbd "p") 'markdown-insert-pre)
  4685. (define-key map (kbd "P") 'markdown-pre-region)
  4686. (define-key map (kbd "q") 'markdown-insert-blockquote)
  4687. (define-key map (kbd "s") 'markdown-insert-strike-through)
  4688. (define-key map (kbd "t") 'markdown-insert-table)
  4689. (define-key map (kbd "Q") 'markdown-blockquote-region)
  4690. (define-key map (kbd "w") 'markdown-insert-wiki-link)
  4691. (define-key map (kbd "-") 'markdown-insert-hr)
  4692. (define-key map (kbd "[") 'markdown-insert-gfm-checkbox)
  4693. ;; Deprecated keys that may be removed in a future version
  4694. (define-key map (kbd "e") 'markdown-insert-italic)
  4695. map)
  4696. "Keymap for Markdown text styling commands.")
  4697. (defvar markdown-mode-command-map
  4698. (let ((map (make-keymap (markdown--command-map-prompt))))
  4699. (define-key map (kbd "m") 'markdown-other-window)
  4700. (define-key map (kbd "p") 'markdown-preview)
  4701. (define-key map (kbd "e") 'markdown-export)
  4702. (define-key map (kbd "v") 'markdown-export-and-preview)
  4703. (define-key map (kbd "o") 'markdown-open)
  4704. (define-key map (kbd "l") 'markdown-live-preview-mode)
  4705. (define-key map (kbd "w") 'markdown-kill-ring-save)
  4706. (define-key map (kbd "c") 'markdown-check-refs)
  4707. (define-key map (kbd "u") 'markdown-unused-refs)
  4708. (define-key map (kbd "n") 'markdown-cleanup-list-numbers)
  4709. (define-key map (kbd "]") 'markdown-complete-buffer)
  4710. (define-key map (kbd "^") 'markdown-table-sort-lines)
  4711. (define-key map (kbd "|") 'markdown-table-convert-region)
  4712. (define-key map (kbd "t") 'markdown-table-transpose)
  4713. map)
  4714. "Keymap for Markdown buffer-wide commands.")
  4715. (defvar markdown-mode-map
  4716. (let ((map (make-keymap)))
  4717. ;; Markup insertion & removal
  4718. (define-key map (kbd "C-c C-s") markdown-mode-style-map)
  4719. (define-key map (kbd "C-c C-l") 'markdown-insert-link)
  4720. (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point)
  4721. ;; Promotion, demotion, and cycling
  4722. (define-key map (kbd "C-c C--") 'markdown-promote)
  4723. (define-key map (kbd "C-c C-=") 'markdown-demote)
  4724. (define-key map (kbd "C-c C-]") 'markdown-complete)
  4725. ;; Following and doing things
  4726. (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point)
  4727. (define-key map (kbd "C-c C-d") 'markdown-do)
  4728. (define-key map (kbd "C-c '") 'markdown-edit-code-block)
  4729. ;; Indentation
  4730. (define-key map (kbd "C-m") 'markdown-enter-key)
  4731. (define-key map (kbd "DEL") 'markdown-outdent-or-delete)
  4732. (define-key map (kbd "C-c >") 'markdown-indent-region)
  4733. (define-key map (kbd "C-c <") 'markdown-outdent-region)
  4734. ;; Visibility cycling
  4735. (define-key map (kbd "TAB") 'markdown-cycle)
  4736. (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab)
  4737. (define-key map (kbd "<S-tab>") 'markdown-shifttab)
  4738. (define-key map (kbd "<backtab>") 'markdown-shifttab)
  4739. ;; Heading and list navigation
  4740. (define-key map (kbd "C-c C-n") 'markdown-outline-next)
  4741. (define-key map (kbd "C-c C-p") 'markdown-outline-previous)
  4742. (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level)
  4743. (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level)
  4744. (define-key map (kbd "C-c C-u") 'markdown-outline-up)
  4745. ;; Buffer-wide commands
  4746. (define-key map (kbd "C-c C-c") markdown-mode-command-map)
  4747. ;; Subtree, list, and table editing
  4748. (define-key map (kbd "C-c <up>") 'markdown-move-up)
  4749. (define-key map (kbd "C-c <down>") 'markdown-move-down)
  4750. (define-key map (kbd "C-c <left>") 'markdown-promote)
  4751. (define-key map (kbd "C-c <right>") 'markdown-demote)
  4752. (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row)
  4753. (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row)
  4754. (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column)
  4755. (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column)
  4756. (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree)
  4757. (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree)
  4758. (define-key map (kbd "M-RET") 'markdown-insert-list-item)
  4759. (define-key map (kbd "C-c C-j") 'markdown-insert-list-item)
  4760. ;; Paragraphs (Markdown context aware)
  4761. (define-key map [remap backward-paragraph] 'markdown-backward-paragraph)
  4762. (define-key map [remap forward-paragraph] 'markdown-forward-paragraph)
  4763. (define-key map [remap mark-paragraph] 'markdown-mark-paragraph)
  4764. ;; Blocks (one or more paragraphs)
  4765. (define-key map (kbd "C-M-{") 'markdown-backward-block)
  4766. (define-key map (kbd "C-M-}") 'markdown-forward-block)
  4767. (define-key map (kbd "C-c M-h") 'markdown-mark-block)
  4768. (define-key map (kbd "C-x n b") 'markdown-narrow-to-block)
  4769. ;; Pages (top-level sections)
  4770. (define-key map [remap backward-page] 'markdown-backward-page)
  4771. (define-key map [remap forward-page] 'markdown-forward-page)
  4772. (define-key map [remap mark-page] 'markdown-mark-page)
  4773. (define-key map [remap narrow-to-page] 'markdown-narrow-to-page)
  4774. ;; Link Movement
  4775. (define-key map (kbd "M-n") 'markdown-next-link)
  4776. (define-key map (kbd "M-p") 'markdown-previous-link)
  4777. ;; Toggling functionality
  4778. (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math)
  4779. (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively)
  4780. (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images)
  4781. (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding)
  4782. (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding)
  4783. ;; Alternative keys (in case of problems with the arrow keys)
  4784. (define-key map (kbd "C-c C-x u") 'markdown-move-up)
  4785. (define-key map (kbd "C-c C-x d") 'markdown-move-down)
  4786. (define-key map (kbd "C-c C-x l") 'markdown-promote)
  4787. (define-key map (kbd "C-c C-x r") 'markdown-demote)
  4788. ;; Deprecated keys that may be removed in a future version
  4789. (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l
  4790. (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l
  4791. (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l
  4792. (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l
  4793. (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote)
  4794. (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link)
  4795. (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1)
  4796. (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2)
  4797. (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3)
  4798. (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4)
  4799. (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5)
  4800. (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6)
  4801. (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1)
  4802. (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2)
  4803. (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim)
  4804. (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim)
  4805. (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2)
  4806. (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1)
  4807. (define-key map (kbd "C-c C-i") 'markdown-insert-image)
  4808. (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j
  4809. (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d
  4810. (define-key map (kbd "C-c -") 'markdown-insert-hr)
  4811. map)
  4812. "Keymap for Markdown major mode.")
  4813. (defvar markdown-mode-mouse-map
  4814. (when markdown-mouse-follow-link
  4815. (let ((map (make-sparse-keymap)))
  4816. (define-key map [follow-link] 'mouse-face)
  4817. (define-key map [mouse-2] #'markdown-follow-thing-at-point)
  4818. map))
  4819. "Keymap for following links with mouse.")
  4820. (defvar gfm-mode-map
  4821. (let ((map (make-sparse-keymap)))
  4822. (set-keymap-parent map markdown-mode-map)
  4823. (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through)
  4824. (define-key map "`" 'markdown-electric-backquote)
  4825. map)
  4826. "Keymap for `gfm-mode'.
  4827. See also `markdown-mode-map'.")
  4828. ;;; Menu ======================================================================
  4829. (easy-menu-define markdown-mode-menu markdown-mode-map
  4830. "Menu for Markdown mode"
  4831. '("Markdown"
  4832. "---"
  4833. ("Movement"
  4834. ["Jump" markdown-do]
  4835. ["Follow Link" markdown-follow-thing-at-point]
  4836. ["Next Link" markdown-next-link]
  4837. ["Previous Link" markdown-previous-link]
  4838. "---"
  4839. ["Next Heading or List Item" markdown-outline-next]
  4840. ["Previous Heading or List Item" markdown-outline-previous]
  4841. ["Next at Same Level" markdown-outline-next-same-level]
  4842. ["Previous at Same Level" markdown-outline-previous-same-level]
  4843. ["Up to Parent" markdown-outline-up]
  4844. "---"
  4845. ["Forward Paragraph" markdown-forward-paragraph]
  4846. ["Backward Paragraph" markdown-backward-paragraph]
  4847. ["Forward Block" markdown-forward-block]
  4848. ["Backward Block" markdown-backward-block])
  4849. ("Show & Hide"
  4850. ["Cycle Heading Visibility" markdown-cycle
  4851. :enable (markdown-on-heading-p)]
  4852. ["Cycle Heading Visibility (Global)" markdown-shifttab]
  4853. "---"
  4854. ["Narrow to Region" narrow-to-region]
  4855. ["Narrow to Block" markdown-narrow-to-block]
  4856. ["Narrow to Section" narrow-to-defun]
  4857. ["Narrow to Subtree" markdown-narrow-to-subtree]
  4858. ["Widen" widen (buffer-narrowed-p)]
  4859. "---"
  4860. ["Toggle Markup Hiding" markdown-toggle-markup-hiding
  4861. :keys "C-c C-x C-m"
  4862. :style radio
  4863. :selected markdown-hide-markup])
  4864. "---"
  4865. ("Headings & Structure"
  4866. ["Automatic Heading" markdown-insert-header-dwim
  4867. :keys "C-c C-s h"]
  4868. ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim
  4869. :keys "C-c C-s H"]
  4870. ("Specific Heading (atx)"
  4871. ["First Level atx" markdown-insert-header-atx-1
  4872. :keys "C-c C-s 1"]
  4873. ["Second Level atx" markdown-insert-header-atx-2
  4874. :keys "C-c C-s 2"]
  4875. ["Third Level atx" markdown-insert-header-atx-3
  4876. :keys "C-c C-s 3"]
  4877. ["Fourth Level atx" markdown-insert-header-atx-4
  4878. :keys "C-c C-s 4"]
  4879. ["Fifth Level atx" markdown-insert-header-atx-5
  4880. :keys "C-c C-s 5"]
  4881. ["Sixth Level atx" markdown-insert-header-atx-6
  4882. :keys "C-c C-s 6"])
  4883. ("Specific Heading (Setext)"
  4884. ["First Level Setext" markdown-insert-header-setext-1
  4885. :keys "C-c C-s !"]
  4886. ["Second Level Setext" markdown-insert-header-setext-2
  4887. :keys "C-c C-s @"])
  4888. ["Horizontal Rule" markdown-insert-hr
  4889. :keys "C-c C-s -"]
  4890. "---"
  4891. ["Move Subtree Up" markdown-move-up
  4892. :keys "C-c <up>"]
  4893. ["Move Subtree Down" markdown-move-down
  4894. :keys "C-c <down>"]
  4895. ["Promote Subtree" markdown-promote
  4896. :keys "C-c <left>"]
  4897. ["Demote Subtree" markdown-demote
  4898. :keys "C-c <right>"])
  4899. ("Region & Mark"
  4900. ["Indent Region" markdown-indent-region]
  4901. ["Outdent Region" markdown-outdent-region]
  4902. "--"
  4903. ["Mark Paragraph" mark-paragraph]
  4904. ["Mark Block" markdown-mark-block]
  4905. ["Mark Section" mark-defun]
  4906. ["Mark Subtree" markdown-mark-subtree])
  4907. ("Tables"
  4908. ["Move Row Up" markdown-move-up
  4909. :enable (markdown-table-at-point-p)
  4910. :keys "C-c <up>"]
  4911. ["Move Row Down" markdown-move-down
  4912. :enable (markdown-table-at-point-p)
  4913. :keys "C-c <down>"]
  4914. ["Move Column Left" markdown-demote
  4915. :enable (markdown-table-at-point-p)
  4916. :keys "C-c <left>"]
  4917. ["Move Column Right" markdown-promote
  4918. :enable (markdown-table-at-point-p)
  4919. :keys "C-c <right>"]
  4920. ["Delete Row" markdown-table-delete-row
  4921. :enable (markdown-table-at-point-p)]
  4922. ["Insert Row" markdown-table-insert-row
  4923. :enable (markdown-table-at-point-p)]
  4924. ["Delete Column" markdown-table-delete-column
  4925. :enable (markdown-table-at-point-p)]
  4926. ["Insert Column" markdown-table-insert-column
  4927. :enable (markdown-table-at-point-p)]
  4928. ["Insert Table" markdown-insert-table]
  4929. "--"
  4930. ["Convert Region to Table" markdown-table-convert-region]
  4931. ["Sort Table Lines" markdown-table-sort-lines
  4932. :enable (markdown-table-at-point-p)]
  4933. ["Transpose Table" markdown-table-transpose
  4934. :enable (markdown-table-at-point-p)])
  4935. ("Lists"
  4936. ["Insert List Item" markdown-insert-list-item]
  4937. ["Move Subtree Up" markdown-move-up
  4938. :keys "C-c <up>"]
  4939. ["Move Subtree Down" markdown-move-down
  4940. :keys "C-c <down>"]
  4941. ["Indent Subtree" markdown-demote
  4942. :keys "C-c <right>"]
  4943. ["Outdent Subtree" markdown-promote
  4944. :keys "C-c <left>"]
  4945. ["Renumber List" markdown-cleanup-list-numbers]
  4946. ["Insert Task List Item" markdown-insert-gfm-checkbox
  4947. :keys "C-c C-x ["]
  4948. ["Toggle Task List Item" markdown-toggle-gfm-checkbox
  4949. :enable (markdown-gfm-task-list-item-at-point)
  4950. :keys "C-c C-d"])
  4951. ("Links & Images"
  4952. ["Insert Link" markdown-insert-link]
  4953. ["Insert Image" markdown-insert-image]
  4954. ["Insert Footnote" markdown-insert-footnote
  4955. :keys "C-c C-s f"]
  4956. ["Insert Wiki Link" markdown-insert-wiki-link
  4957. :keys "C-c C-s w"]
  4958. "---"
  4959. ["Check References" markdown-check-refs]
  4960. ["Find Unused References" markdown-unused-refs]
  4961. ["Toggle URL Hiding" markdown-toggle-url-hiding
  4962. :style radio
  4963. :selected markdown-hide-urls]
  4964. ["Toggle Inline Images" markdown-toggle-inline-images
  4965. :keys "C-c C-x C-i"
  4966. :style radio
  4967. :selected markdown-inline-image-overlays]
  4968. ["Toggle Wiki Links" markdown-toggle-wiki-links
  4969. :style radio
  4970. :selected markdown-enable-wiki-links])
  4971. ("Styles"
  4972. ["Bold" markdown-insert-bold]
  4973. ["Italic" markdown-insert-italic]
  4974. ["Code" markdown-insert-code]
  4975. ["Strikethrough" markdown-insert-strike-through]
  4976. ["Keyboard" markdown-insert-kbd]
  4977. "---"
  4978. ["Blockquote" markdown-insert-blockquote]
  4979. ["Preformatted" markdown-insert-pre]
  4980. ["GFM Code Block" markdown-insert-gfm-code-block]
  4981. ["Edit Code Block" markdown-edit-code-block
  4982. :enable (markdown-code-block-at-point-p)]
  4983. "---"
  4984. ["Blockquote Region" markdown-blockquote-region]
  4985. ["Preformatted Region" markdown-pre-region]
  4986. "---"
  4987. ["Fontify Code Blocks Natively"
  4988. markdown-toggle-fontify-code-blocks-natively
  4989. :style radio
  4990. :selected markdown-fontify-code-blocks-natively]
  4991. ["LaTeX Math Support" markdown-toggle-math
  4992. :style radio
  4993. :selected markdown-enable-math])
  4994. "---"
  4995. ("Preview & Export"
  4996. ["Compile" markdown-other-window]
  4997. ["Preview" markdown-preview]
  4998. ["Export" markdown-export]
  4999. ["Export & View" markdown-export-and-preview]
  5000. ["Open" markdown-open]
  5001. ["Live Export" markdown-live-preview-mode
  5002. :style radio
  5003. :selected markdown-live-preview-mode]
  5004. ["Kill ring save" markdown-kill-ring-save])
  5005. ("Markup Completion and Cycling"
  5006. ["Complete Markup" markdown-complete]
  5007. ["Promote Element" markdown-promote
  5008. :keys "C-c C--"]
  5009. ["Demote Element" markdown-demote
  5010. :keys "C-c C-="])
  5011. "---"
  5012. ["Kill Element" markdown-kill-thing-at-point]
  5013. "---"
  5014. ("Documentation"
  5015. ["Version" markdown-show-version]
  5016. ["Homepage" markdown-mode-info]
  5017. ["Describe Mode" (describe-function 'markdown-mode)]
  5018. ["Guide" (browse-url "https://leanpub.com/markdown-mode")])))
  5019. ;;; imenu =====================================================================
  5020. (defun markdown-imenu-create-nested-index ()
  5021. "Create and return a nested imenu index alist for the current buffer.
  5022. See `imenu-create-index-function' and `imenu--index-alist' for details."
  5023. (let* ((root '(nil . nil))
  5024. cur-alist
  5025. (cur-level 0)
  5026. (empty-heading "-")
  5027. (self-heading ".")
  5028. hashes pos level heading)
  5029. (save-excursion
  5030. ;; Headings
  5031. (goto-char (point-min))
  5032. (while (re-search-forward markdown-regex-header (point-max) t)
  5033. (unless (markdown-code-block-at-point-p)
  5034. (cond
  5035. ((match-string-no-properties 2) ;; level 1 setext
  5036. (setq heading (match-string-no-properties 1))
  5037. (setq pos (match-beginning 1)
  5038. level 1))
  5039. ((match-string-no-properties 3) ;; level 2 setext
  5040. (setq heading (match-string-no-properties 1))
  5041. (setq pos (match-beginning 1)
  5042. level 2))
  5043. ((setq hashes (markdown-trim-whitespace
  5044. (match-string-no-properties 4)))
  5045. (setq heading (match-string-no-properties 5)
  5046. pos (match-beginning 4)
  5047. level (length hashes))))
  5048. (let ((alist (list (cons heading pos))))
  5049. (cond
  5050. ((= cur-level level) ; new sibling
  5051. (setcdr cur-alist alist)
  5052. (setq cur-alist alist))
  5053. ((< cur-level level) ; first child
  5054. (dotimes (_ (- level cur-level 1))
  5055. (setq alist (list (cons empty-heading alist))))
  5056. (if cur-alist
  5057. (let* ((parent (car cur-alist))
  5058. (self-pos (cdr parent)))
  5059. (setcdr parent (cons (cons self-heading self-pos) alist)))
  5060. (setcdr root alist)) ; primogenitor
  5061. (setq cur-alist alist)
  5062. (setq cur-level level))
  5063. (t ; new sibling of an ancestor
  5064. (let ((sibling-alist (last (cdr root))))
  5065. (dotimes (_ (1- level))
  5066. (setq sibling-alist (last (cdar sibling-alist))))
  5067. (setcdr sibling-alist alist)
  5068. (setq cur-alist alist))
  5069. (setq cur-level level))))))
  5070. ;; Footnotes
  5071. (let ((fn (markdown-get-defined-footnotes)))
  5072. (if (or (zerop (length fn))
  5073. (null markdown-add-footnotes-to-imenu))
  5074. (cdr root)
  5075. (nconc (cdr root) (list (cons "Footnotes" fn))))))))
  5076. (defun markdown-imenu-create-flat-index ()
  5077. "Create and return a flat imenu index alist for the current buffer.
  5078. See `imenu-create-index-function' and `imenu--index-alist' for details."
  5079. (let* ((empty-heading "-") index heading pos)
  5080. (save-excursion
  5081. ;; Headings
  5082. (goto-char (point-min))
  5083. (while (re-search-forward markdown-regex-header (point-max) t)
  5084. (when (and (not (markdown-code-block-at-point-p (point-at-bol)))
  5085. (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin)))
  5086. (cond
  5087. ((setq heading (match-string-no-properties 1))
  5088. (setq pos (match-beginning 1)))
  5089. ((setq heading (match-string-no-properties 5))
  5090. (setq pos (match-beginning 4))))
  5091. (or (> (length heading) 0)
  5092. (setq heading empty-heading))
  5093. (setq index (append index (list (cons heading pos))))))
  5094. ;; Footnotes
  5095. (when markdown-add-footnotes-to-imenu
  5096. (nconc index (markdown-get-defined-footnotes)))
  5097. index)))
  5098. ;;; References ================================================================
  5099. (defun markdown-reference-goto-definition ()
  5100. "Jump to the definition of the reference at point or create it."
  5101. (interactive)
  5102. (when (thing-at-point-looking-at markdown-regex-link-reference)
  5103. (let* ((text (match-string-no-properties 3))
  5104. (reference (match-string-no-properties 6))
  5105. (target (downcase (if (string= reference "") text reference)))
  5106. (loc (cadr (save-match-data (markdown-reference-definition target)))))
  5107. (if loc
  5108. (goto-char loc)
  5109. (goto-char (match-beginning 0))
  5110. (markdown-insert-reference-definition target)))))
  5111. (defun markdown-reference-find-links (reference)
  5112. "Return a list of all links for REFERENCE.
  5113. REFERENCE should not include the surrounding square brackets.
  5114. Elements of the list have the form (text start line), where
  5115. text is the link text, start is the location at the beginning of
  5116. the link, and line is the line number on which the link appears."
  5117. (let* ((ref-quote (regexp-quote reference))
  5118. (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)"
  5119. ref-quote ref-quote))
  5120. links)
  5121. (save-excursion
  5122. (goto-char (point-min))
  5123. (while (re-search-forward regexp nil t)
  5124. (let* ((text (or (match-string-no-properties 1)
  5125. (match-string-no-properties 2)))
  5126. (start (match-beginning 0))
  5127. (line (markdown-line-number-at-pos)))
  5128. (cl-pushnew (list text start line) links :test #'equal))))
  5129. links))
  5130. (defmacro markdown-for-all-refs (f)
  5131. `(let ((result))
  5132. (save-excursion
  5133. (goto-char (point-min))
  5134. (while
  5135. (re-search-forward markdown-regex-link-reference nil t)
  5136. (let* ((text (match-string-no-properties 3))
  5137. (reference (match-string-no-properties 6))
  5138. (target (downcase (if (string= reference "") text reference))))
  5139. (,f text target result))))
  5140. (reverse result)))
  5141. (defmacro markdown-collect-always (_ target result)
  5142. `(cl-pushnew ,target ,result :test #'equal))
  5143. (defmacro markdown-collect-undefined (text target result)
  5144. `(unless (markdown-reference-definition target)
  5145. (let ((entry (assoc ,target ,result)))
  5146. (if (not entry)
  5147. (cl-pushnew
  5148. (cons ,target (list (cons ,text (markdown-line-number-at-pos))))
  5149. ,result :test #'equal)
  5150. (setcdr entry
  5151. (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos)))))))))
  5152. (defun markdown-get-all-refs ()
  5153. "Return a list of all Markdown references."
  5154. (markdown-for-all-refs markdown-collect-always))
  5155. (defun markdown-get-undefined-refs ()
  5156. "Return a list of undefined Markdown references.
  5157. Result is an alist of pairs (reference . occurrences), where
  5158. occurrences is itself another alist of pairs (label . line-number).
  5159. For example, an alist corresponding to [Nice editor][Emacs] at line 12,
  5160. \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is
  5161. \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))."
  5162. (markdown-for-all-refs markdown-collect-undefined))
  5163. (defun markdown-get-unused-refs ()
  5164. (cl-sort
  5165. (cl-set-difference
  5166. (markdown-get-defined-references) (markdown-get-all-refs)
  5167. :test (lambda (e1 e2) (equal (car e1) e2)))
  5168. #'< :key #'cdr))
  5169. (defmacro defun-markdown-buffer (name docstring)
  5170. "Define a function to name and return a buffer.
  5171. By convention, NAME must be a name of a string constant with
  5172. %buffer% placeholder used to name the buffer, and will also be
  5173. used as a name of the function defined.
  5174. DOCSTRING will be used as the first part of the docstring."
  5175. `(defun ,name (&optional buffer-name)
  5176. ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.")
  5177. (or buffer-name (setq buffer-name (buffer-name)))
  5178. (let ((refbuf (get-buffer-create (replace-regexp-in-string
  5179. "%buffer%" buffer-name
  5180. ,name))))
  5181. (with-current-buffer refbuf
  5182. (when view-mode
  5183. (View-exit-and-edit))
  5184. (use-local-map button-buffer-map)
  5185. (erase-buffer))
  5186. refbuf)))
  5187. (defconst markdown-reference-check-buffer
  5188. "*Undefined references for %buffer%*"
  5189. "Pattern for name of buffer for listing undefined references.
  5190. The string %buffer% will be replaced by the corresponding
  5191. `markdown-mode' buffer name.")
  5192. (defun-markdown-buffer
  5193. markdown-reference-check-buffer
  5194. "Name and return buffer for reference checking.")
  5195. (defconst markdown-unused-references-buffer
  5196. "*Unused references for %buffer%*"
  5197. "Pattern for name of buffer for listing unused references.
  5198. The string %buffer% will be replaced by the corresponding
  5199. `markdown-mode' buffer name.")
  5200. (defun-markdown-buffer
  5201. markdown-unused-references-buffer
  5202. "Name and return buffer for unused reference checking.")
  5203. (defconst markdown-reference-links-buffer
  5204. "*Reference links for %buffer%*"
  5205. "Pattern for name of buffer for listing references.
  5206. The string %buffer% will be replaced by the corresponding buffer name.")
  5207. (defun-markdown-buffer
  5208. markdown-reference-links-buffer
  5209. "Name, setup, and return a buffer for listing links.")
  5210. ;; Add an empty Markdown reference definition to buffer
  5211. ;; specified in the 'target-buffer property. The reference name is
  5212. ;; the button's label.
  5213. (define-button-type 'markdown-undefined-reference-button
  5214. 'help-echo "mouse-1, RET: create definition for undefined reference"
  5215. 'follow-link t
  5216. 'face 'bold
  5217. 'action (lambda (b)
  5218. (let ((buffer (button-get b 'target-buffer))
  5219. (line (button-get b 'target-line))
  5220. (label (button-label b)))
  5221. (switch-to-buffer-other-window buffer)
  5222. (goto-char (point-min))
  5223. (forward-line line)
  5224. (markdown-insert-reference-definition label)
  5225. (markdown-check-refs t))))
  5226. ;; Jump to line in buffer specified by 'target-buffer property.
  5227. ;; Line number is button's 'target-line property.
  5228. (define-button-type 'markdown-goto-line-button
  5229. 'help-echo "mouse-1, RET: go to line"
  5230. 'follow-link t
  5231. 'face 'italic
  5232. 'action (lambda (b)
  5233. (switch-to-buffer-other-window (button-get b 'target-buffer))
  5234. ;; use call-interactively to silence compiler
  5235. (let ((current-prefix-arg (button-get b 'target-line)))
  5236. (call-interactively 'goto-line))))
  5237. ;; Kill a line in buffer specified by 'target-buffer property.
  5238. ;; Line number is button's 'target-line property.
  5239. (define-button-type 'markdown-kill-line-button
  5240. 'help-echo "mouse-1, RET: kill line"
  5241. 'follow-link t
  5242. 'face 'italic
  5243. 'action (lambda (b)
  5244. (switch-to-buffer-other-window (button-get b 'target-buffer))
  5245. ;; use call-interactively to silence compiler
  5246. (let ((current-prefix-arg (button-get b 'target-line)))
  5247. (call-interactively 'goto-line))
  5248. (kill-line 1)
  5249. (markdown-unused-refs t)))
  5250. ;; Jumps to a particular link at location given by 'target-char
  5251. ;; property in buffer given by 'target-buffer property.
  5252. (define-button-type 'markdown-location-button
  5253. 'help-echo "mouse-1, RET: jump to location of link"
  5254. 'follow-link t
  5255. 'face 'bold
  5256. 'action (lambda (b)
  5257. (let ((target (button-get b 'target-buffer))
  5258. (loc (button-get b 'target-char)))
  5259. (kill-buffer-and-window)
  5260. (switch-to-buffer target)
  5261. (goto-char loc))))
  5262. (defun markdown-insert-undefined-reference-button (reference oldbuf)
  5263. "Insert a button for creating REFERENCE in buffer OLDBUF.
  5264. REFERENCE should be a list of the form (reference . occurrences),
  5265. as returned by `markdown-get-undefined-refs'."
  5266. (let ((label (car reference)))
  5267. ;; Create a reference button
  5268. (insert-button label
  5269. :type 'markdown-undefined-reference-button
  5270. 'target-buffer oldbuf
  5271. 'target-line (cdr (car (cdr reference))))
  5272. (insert " (")
  5273. (dolist (occurrence (cdr reference))
  5274. (let ((line (cdr occurrence)))
  5275. ;; Create a line number button
  5276. (insert-button (number-to-string line)
  5277. :type 'markdown-goto-line-button
  5278. 'target-buffer oldbuf
  5279. 'target-line line)
  5280. (insert " ")))
  5281. (delete-char -1)
  5282. (insert ")")
  5283. (newline)))
  5284. (defun markdown-insert-unused-reference-button (reference oldbuf)
  5285. "Insert a button for creating REFERENCE in buffer OLDBUF.
  5286. REFERENCE must be a pair of (ref . line-number)."
  5287. (let ((label (car reference))
  5288. (line (cdr reference)))
  5289. ;; Create a reference button
  5290. (insert-button label
  5291. :type 'markdown-goto-line-button
  5292. 'face 'bold
  5293. 'target-buffer oldbuf
  5294. 'target-line line)
  5295. (insert (format " (%d) [" line))
  5296. (insert-button "X"
  5297. :type 'markdown-kill-line-button
  5298. 'face 'bold
  5299. 'target-buffer oldbuf
  5300. 'target-line line)
  5301. (insert "]")
  5302. (newline)))
  5303. (defun markdown-insert-link-button (link oldbuf)
  5304. "Insert a button for jumping to LINK in buffer OLDBUF.
  5305. LINK should be a list of the form (text char line) containing
  5306. the link text, location, and line number."
  5307. (let ((label (cl-first link))
  5308. (char (cl-second link))
  5309. (line (cl-third link)))
  5310. ;; Create a reference button
  5311. (insert-button label
  5312. :type 'markdown-location-button
  5313. 'target-buffer oldbuf
  5314. 'target-char char)
  5315. (insert (format " (line %d)\n" line))))
  5316. (defun markdown-reference-goto-link (&optional reference)
  5317. "Jump to the location of the first use of REFERENCE."
  5318. (interactive)
  5319. (unless reference
  5320. (if (thing-at-point-looking-at markdown-regex-reference-definition)
  5321. (setq reference (match-string-no-properties 2))
  5322. (user-error "No reference definition at point")))
  5323. (let ((links (markdown-reference-find-links reference)))
  5324. (cond ((= (length links) 1)
  5325. (goto-char (cadr (car links))))
  5326. ((> (length links) 1)
  5327. (let ((oldbuf (current-buffer))
  5328. (linkbuf (markdown-reference-links-buffer)))
  5329. (with-current-buffer linkbuf
  5330. (insert "Links using reference " reference ":\n\n")
  5331. (dolist (link (reverse links))
  5332. (markdown-insert-link-button link oldbuf)))
  5333. (view-buffer-other-window linkbuf)
  5334. (goto-char (point-min))
  5335. (forward-line 2)))
  5336. (t
  5337. (error "No links for reference %s" reference)))))
  5338. (defmacro defun-markdown-ref-checker
  5339. (name docstring checker-function buffer-function none-message buffer-header insert-reference)
  5340. "Define a function NAME acting on result of CHECKER-FUNCTION.
  5341. DOCSTRING is used as a docstring for the defined function.
  5342. BUFFER-FUNCTION should name and return an auxiliary buffer to put
  5343. results in.
  5344. NONE-MESSAGE is used when CHECKER-FUNCTION returns no results.
  5345. BUFFER-HEADER is put into the auxiliary buffer first, followed by
  5346. calling INSERT-REFERENCE for each element in the list returned by
  5347. CHECKER-FUNCTION."
  5348. `(defun ,name (&optional silent)
  5349. ,(concat
  5350. docstring
  5351. "\n\nIf SILENT is non-nil, do not message anything when no
  5352. such references found.")
  5353. (interactive "P")
  5354. (unless (derived-mode-p 'markdown-mode)
  5355. (user-error "Not available in current mode"))
  5356. (let ((oldbuf (current-buffer))
  5357. (refs (,checker-function))
  5358. (refbuf (,buffer-function)))
  5359. (if (null refs)
  5360. (progn
  5361. (when (not silent)
  5362. (message ,none-message))
  5363. (kill-buffer refbuf))
  5364. (with-current-buffer refbuf
  5365. (insert ,buffer-header)
  5366. (dolist (ref refs)
  5367. (,insert-reference ref oldbuf))
  5368. (view-buffer-other-window refbuf)
  5369. (goto-char (point-min))
  5370. (forward-line 2))))))
  5371. (defun-markdown-ref-checker
  5372. markdown-check-refs
  5373. "Show all undefined Markdown references in current `markdown-mode' buffer.
  5374. Links which have empty reference definitions are considered to be
  5375. defined."
  5376. markdown-get-undefined-refs
  5377. markdown-reference-check-buffer
  5378. "No undefined references found"
  5379. "The following references are undefined:\n\n"
  5380. markdown-insert-undefined-reference-button)
  5381. (defun-markdown-ref-checker
  5382. markdown-unused-refs
  5383. "Show all unused Markdown references in current `markdown-mode' buffer."
  5384. markdown-get-unused-refs
  5385. markdown-unused-references-buffer
  5386. "No unused references found"
  5387. "The following references are unused:\n\n"
  5388. markdown-insert-unused-reference-button)
  5389. ;;; Lists =====================================================================
  5390. (defun markdown-insert-list-item (&optional arg)
  5391. "Insert a new list item.
  5392. If the point is inside unordered list, insert a bullet mark. If
  5393. the point is inside ordered list, insert the next number followed
  5394. by a period. Use the previous list item to determine the amount
  5395. of whitespace to place before and after list markers.
  5396. With a \\[universal-argument] prefix (i.e., when ARG is (4)),
  5397. decrease the indentation by one level.
  5398. With two \\[universal-argument] prefixes (i.e., when ARG is (16)),
  5399. increase the indentation by one level."
  5400. (interactive "p")
  5401. (let (bounds cur-indent marker indent new-indent new-loc)
  5402. (save-match-data
  5403. ;; Look for a list item on current or previous non-blank line
  5404. (save-excursion
  5405. (while (and (not (setq bounds (markdown-cur-list-item-bounds)))
  5406. (not (bobp))
  5407. (markdown-cur-line-blank-p))
  5408. (forward-line -1)))
  5409. (when bounds
  5410. (cond ((save-excursion
  5411. (skip-chars-backward " \t")
  5412. (looking-at-p markdown-regex-list))
  5413. (beginning-of-line)
  5414. (insert "\n")
  5415. (forward-line -1))
  5416. ((not (markdown-cur-line-blank-p))
  5417. (newline)))
  5418. (setq new-loc (point)))
  5419. ;; Look ahead for a list item on next non-blank line
  5420. (unless bounds
  5421. (save-excursion
  5422. (while (and (null bounds)
  5423. (not (eobp))
  5424. (markdown-cur-line-blank-p))
  5425. (forward-line)
  5426. (setq bounds (markdown-cur-list-item-bounds))))
  5427. (when bounds
  5428. (setq new-loc (point))
  5429. (unless (markdown-cur-line-blank-p)
  5430. (newline))))
  5431. (if (not bounds)
  5432. ;; When not in a list, start a new unordered one
  5433. (progn
  5434. (unless (markdown-cur-line-blank-p)
  5435. (insert "\n"))
  5436. (insert markdown-unordered-list-item-prefix))
  5437. ;; Compute indentation and marker for new list item
  5438. (setq cur-indent (nth 2 bounds))
  5439. (setq marker (nth 4 bounds))
  5440. ;; If current item is a GFM checkbox, insert new unchecked checkbox.
  5441. (when (nth 5 bounds)
  5442. (setq marker
  5443. (concat marker
  5444. (replace-regexp-in-string "[Xx]" " " (nth 5 bounds)))))
  5445. (cond
  5446. ;; Dedent: decrement indentation, find previous marker.
  5447. ((= arg 4)
  5448. (setq indent (max (- cur-indent markdown-list-indent-width) 0))
  5449. (let ((prev-bounds
  5450. (save-excursion
  5451. (goto-char (nth 0 bounds))
  5452. (when (markdown-up-list)
  5453. (markdown-cur-list-item-bounds)))))
  5454. (when prev-bounds
  5455. (setq marker (nth 4 prev-bounds)))))
  5456. ;; Indent: increment indentation by 4, use same marker.
  5457. ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width)))
  5458. ;; Same level: keep current indentation and marker.
  5459. (t (setq indent cur-indent)))
  5460. (setq new-indent (make-string indent 32))
  5461. (goto-char new-loc)
  5462. (cond
  5463. ;; Ordered list
  5464. ((string-match-p "[0-9]" marker)
  5465. (if (= arg 16) ;; starting a new column indented one more level
  5466. (insert (concat new-indent "1. "))
  5467. ;; Don't use previous match-data
  5468. (set-match-data nil)
  5469. ;; travel up to the last item and pick the correct number. If
  5470. ;; the argument was nil, "new-indent = cur-indent" is the same,
  5471. ;; so we don't need special treatment. Neat.
  5472. (save-excursion
  5473. (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)")))
  5474. (>= (forward-line -1) 0))))
  5475. (let* ((old-prefix (match-string 1))
  5476. (old-spacing (match-string 2))
  5477. (new-prefix (if old-prefix
  5478. (int-to-string (1+ (string-to-number old-prefix)))
  5479. "1"))
  5480. (space-adjust (- (length old-prefix) (length new-prefix)))
  5481. (new-spacing (if (and (match-string 2)
  5482. (not (string-match-p "\t" old-spacing))
  5483. (< space-adjust 0)
  5484. (> space-adjust (- 1 (length (match-string 2)))))
  5485. (substring (match-string 2) 0 space-adjust)
  5486. (or old-spacing ". "))))
  5487. (insert (concat new-indent new-prefix new-spacing)))))
  5488. ;; Unordered list, GFM task list, or ordered list with hash mark
  5489. ((string-match-p "[\\*\\+-]\\|#\\." marker)
  5490. (insert new-indent marker))))
  5491. ;; Propertize the newly inserted list item now
  5492. (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol)))))
  5493. (defun markdown-move-list-item-up ()
  5494. "Move the current list item up in the list when possible.
  5495. In nested lists, move child items with the parent item."
  5496. (interactive)
  5497. (let (cur prev old)
  5498. (when (setq cur (markdown-cur-list-item-bounds))
  5499. (setq old (point))
  5500. (goto-char (nth 0 cur))
  5501. (if (markdown-prev-list-item (nth 3 cur))
  5502. (progn
  5503. (setq prev (markdown-cur-list-item-bounds))
  5504. (condition-case nil
  5505. (progn
  5506. (transpose-regions (nth 0 prev) (nth 1 prev)
  5507. (nth 0 cur) (nth 1 cur) t)
  5508. (goto-char (+ (nth 0 prev) (- old (nth 0 cur)))))
  5509. ;; Catch error in case regions overlap.
  5510. (error (goto-char old))))
  5511. (goto-char old)))))
  5512. (defun markdown-move-list-item-down ()
  5513. "Move the current list item down in the list when possible.
  5514. In nested lists, move child items with the parent item."
  5515. (interactive)
  5516. (let (cur next old)
  5517. (when (setq cur (markdown-cur-list-item-bounds))
  5518. (setq old (point))
  5519. (if (markdown-next-list-item (nth 3 cur))
  5520. (progn
  5521. (setq next (markdown-cur-list-item-bounds))
  5522. (condition-case nil
  5523. (progn
  5524. (transpose-regions (nth 0 cur) (nth 1 cur)
  5525. (nth 0 next) (nth 1 next) nil)
  5526. (goto-char (+ old (- (nth 1 next) (nth 1 cur)))))
  5527. ;; Catch error in case regions overlap.
  5528. (error (goto-char old))))
  5529. (goto-char old)))))
  5530. (defun markdown-demote-list-item (&optional bounds)
  5531. "Indent (or demote) the current list item.
  5532. Optionally, BOUNDS of the current list item may be provided if available.
  5533. In nested lists, demote child items as well."
  5534. (interactive)
  5535. (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
  5536. (save-excursion
  5537. (let* ((item-start (set-marker (make-marker) (nth 0 bounds)))
  5538. (item-end (set-marker (make-marker) (nth 1 bounds)))
  5539. (list-start (progn (markdown-beginning-of-list)
  5540. (set-marker (make-marker) (point))))
  5541. (list-end (progn (markdown-end-of-list)
  5542. (set-marker (make-marker) (point)))))
  5543. (goto-char item-start)
  5544. (while (< (point) item-end)
  5545. (unless (markdown-cur-line-blank-p)
  5546. (insert (make-string markdown-list-indent-width ? )))
  5547. (forward-line))
  5548. (markdown-syntax-propertize-list-items list-start list-end)))))
  5549. (defun markdown-promote-list-item (&optional bounds)
  5550. "Unindent (or promote) the current list item.
  5551. Optionally, BOUNDS of the current list item may be provided if available.
  5552. In nested lists, demote child items as well."
  5553. (interactive)
  5554. (when (or bounds (setq bounds (markdown-cur-list-item-bounds)))
  5555. (save-excursion
  5556. (save-match-data
  5557. (let ((item-start (set-marker (make-marker) (nth 0 bounds)))
  5558. (item-end (set-marker (make-marker) (nth 1 bounds)))
  5559. (list-start (progn (markdown-beginning-of-list)
  5560. (set-marker (make-marker) (point))))
  5561. (list-end (progn (markdown-end-of-list)
  5562. (set-marker (make-marker) (point))))
  5563. num regexp)
  5564. (goto-char item-start)
  5565. (when (looking-at (format "^[ ]\\{1,%d\\}"
  5566. markdown-list-indent-width))
  5567. (setq num (- (match-end 0) (match-beginning 0)))
  5568. (setq regexp (format "^[ ]\\{1,%d\\}" num))
  5569. (while (and (< (point) item-end)
  5570. (re-search-forward regexp item-end t))
  5571. (replace-match "" nil nil)
  5572. (forward-line))
  5573. (markdown-syntax-propertize-list-items list-start list-end)))))))
  5574. (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item)
  5575. "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM.
  5576. PREV-ITEM is width of previous-indentation and list number
  5577. Assume that the previously found match was for a numbered item in
  5578. a list."
  5579. (let ((cpfx pfx)
  5580. (cur-item nil)
  5581. (idx 0)
  5582. (continue t)
  5583. (step t)
  5584. (sep nil))
  5585. (while (and continue (not (eobp)))
  5586. (setq step t)
  5587. (cond
  5588. ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ")
  5589. (setq cpfx (match-string-no-properties 2))
  5590. (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker
  5591. (cond
  5592. ((or (= (length cpfx) (length pfx))
  5593. (= (length cur-item) (length prev-item)))
  5594. (save-excursion
  5595. (replace-match
  5596. (concat pfx (number-to-string (setq idx (1+ idx))) ". ")))
  5597. (setq sep nil))
  5598. ;; indented a level
  5599. ((< (length pfx) (length cpfx))
  5600. (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item))
  5601. (setq step nil))
  5602. ;; exit the loop
  5603. (t
  5604. (setq step nil)
  5605. (setq continue nil))))
  5606. ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$")
  5607. (setq cpfx (match-string-no-properties 1))
  5608. (cond
  5609. ;; reset if separated before
  5610. ((string= cpfx pfx) (when sep (setq idx 0)))
  5611. ((string< cpfx pfx)
  5612. (setq step nil)
  5613. (setq continue nil))))
  5614. (t (setq sep t)))
  5615. (when step
  5616. (beginning-of-line)
  5617. (setq continue (= (forward-line) 0))))
  5618. sep))
  5619. (defun markdown-cleanup-list-numbers ()
  5620. "Update the numbering of ordered lists."
  5621. (interactive)
  5622. (save-excursion
  5623. (goto-char (point-min))
  5624. (markdown-cleanup-list-numbers-level "")))
  5625. ;;; Movement ==================================================================
  5626. (defun markdown-beginning-of-defun (&optional arg)
  5627. "`beginning-of-defun-function' for Markdown.
  5628. This is used to find the beginning of the defun and should behave
  5629. like beginning-of-defun, returning non-nil if it found the
  5630. beginning of a defun. It moves the point backward, right before a
  5631. heading which defines a defun. When ARG is non-nil, repeat that
  5632. many times. When ARG is negative, move forward to the ARG-th
  5633. following section."
  5634. (or arg (setq arg 1))
  5635. (when (< arg 0) (end-of-line))
  5636. ;; Adjust position for setext headings.
  5637. (when (and (thing-at-point-looking-at markdown-regex-header-setext)
  5638. (not (= (point) (match-beginning 0)))
  5639. (not (markdown-code-block-at-point-p)))
  5640. (goto-char (match-end 0)))
  5641. (let (found)
  5642. ;; Move backward with positive argument.
  5643. (while (and (not (bobp)) (> arg 0))
  5644. (setq found nil)
  5645. (while (and (not found)
  5646. (not (bobp))
  5647. (re-search-backward markdown-regex-header nil 'move))
  5648. (when (not (markdown-code-block-at-pos (match-beginning 0))))
  5649. (setq found (match-beginning 0)))
  5650. (setq arg (1- arg)))
  5651. ;; Move forward with negative argument.
  5652. (while (and (not (eobp)) (< arg 0))
  5653. (setq found nil)
  5654. (while (and (not found)
  5655. (not (eobp))
  5656. (re-search-forward markdown-regex-header nil 'move))
  5657. (when (not (markdown-code-block-at-pos (match-beginning 0))))
  5658. (setq found (match-beginning 0)))
  5659. (setq arg (1+ arg)))
  5660. (when found
  5661. (beginning-of-line)
  5662. t)))
  5663. (defun markdown-end-of-defun ()
  5664. "`end-of-defun-function’ for Markdown.
  5665. This is used to find the end of the defun at point.
  5666. It is called with no argument, right after calling beginning-of-defun-raw,
  5667. so it can assume that point is at the beginning of the defun body.
  5668. It should move point to the first position after the defun."
  5669. (or (eobp) (forward-char 1))
  5670. (let (found)
  5671. (while (and (not found)
  5672. (not (eobp))
  5673. (re-search-forward markdown-regex-header nil 'move))
  5674. (when (not (markdown-code-block-at-pos (match-beginning 0)))
  5675. (setq found (match-beginning 0))))
  5676. (when found
  5677. (goto-char found)
  5678. (skip-syntax-backward "-"))))
  5679. (defun markdown-beginning-of-text-block ()
  5680. "Move backward to previous beginning of a plain text block.
  5681. This function simply looks for blank lines without considering
  5682. the surrounding context in light of Markdown syntax. For that, see
  5683. `markdown-backward-block'."
  5684. (interactive)
  5685. (let ((start (point)))
  5686. (if (re-search-backward markdown-regex-block-separator nil t)
  5687. (goto-char (match-end 0))
  5688. (goto-char (point-min)))
  5689. (when (and (= start (point)) (not (bobp)))
  5690. (forward-line -1)
  5691. (if (re-search-backward markdown-regex-block-separator nil t)
  5692. (goto-char (match-end 0))
  5693. (goto-char (point-min))))))
  5694. (defun markdown-end-of-text-block ()
  5695. "Move forward to next beginning of a plain text block.
  5696. This function simply looks for blank lines without considering
  5697. the surrounding context in light of Markdown syntax. For that, see
  5698. `markdown-forward-block'."
  5699. (interactive)
  5700. (beginning-of-line)
  5701. (skip-chars-forward " \t\n")
  5702. (when (= (point) (point-min))
  5703. (forward-char))
  5704. (if (re-search-forward markdown-regex-block-separator nil t)
  5705. (goto-char (match-end 0))
  5706. (goto-char (point-max)))
  5707. (skip-chars-backward " \t\n")
  5708. (forward-line))
  5709. (defun markdown-backward-paragraph (&optional arg)
  5710. "Move the point to the start of the current paragraph.
  5711. With argument ARG, do it ARG times; a negative argument ARG = -N
  5712. means move forward N blocks."
  5713. (interactive "^p")
  5714. (or arg (setq arg 1))
  5715. (if (< arg 0)
  5716. (markdown-forward-paragraph (- arg))
  5717. (dotimes (_ arg)
  5718. ;; Skip over whitespace in between paragraphs when moving backward.
  5719. (skip-chars-backward " \t\n")
  5720. (beginning-of-line)
  5721. ;; Skip over code block endings.
  5722. (when (markdown-range-properties-exist
  5723. (point-at-bol) (point-at-eol)
  5724. '(markdown-gfm-block-end
  5725. markdown-tilde-fence-end))
  5726. (forward-line -1))
  5727. ;; Skip over blank lines inside blockquotes.
  5728. (while (and (not (eobp))
  5729. (looking-at markdown-regex-blockquote)
  5730. (= (length (match-string 3)) 0))
  5731. (forward-line -1))
  5732. ;; Proceed forward based on the type of block of paragraph.
  5733. (let (bounds skip)
  5734. (cond
  5735. ;; Blockquotes
  5736. ((looking-at markdown-regex-blockquote)
  5737. (while (and (not (bobp))
  5738. (looking-at markdown-regex-blockquote)
  5739. (> (length (match-string 3)) 0)) ;; not blank
  5740. (forward-line -1))
  5741. (forward-line))
  5742. ;; List items
  5743. ((setq bounds (markdown-cur-list-item-bounds))
  5744. (goto-char (nth 0 bounds)))
  5745. ;; Other
  5746. (t
  5747. (while (and (not (bobp))
  5748. (not skip)
  5749. (not (markdown-cur-line-blank-p))
  5750. (not (looking-at markdown-regex-blockquote))
  5751. (not (markdown-range-properties-exist
  5752. (point-at-bol) (point-at-eol)
  5753. '(markdown-gfm-block-end
  5754. markdown-tilde-fence-end))))
  5755. (setq skip (markdown-range-properties-exist
  5756. (point-at-bol) (point-at-eol)
  5757. '(markdown-gfm-block-begin
  5758. markdown-tilde-fence-begin)))
  5759. (forward-line -1))
  5760. (unless (bobp)
  5761. (forward-line 1))))))))
  5762. (defun markdown-forward-paragraph (&optional arg)
  5763. "Move forward to the next end of a paragraph.
  5764. With argument ARG, do it ARG times; a negative argument ARG = -N
  5765. means move backward N blocks."
  5766. (interactive "^p")
  5767. (or arg (setq arg 1))
  5768. (if (< arg 0)
  5769. (markdown-backward-paragraph (- arg))
  5770. (dotimes (_ arg)
  5771. ;; Skip whitespace in between paragraphs.
  5772. (when (markdown-cur-line-blank-p)
  5773. (skip-syntax-forward "-")
  5774. (beginning-of-line))
  5775. ;; Proceed forward based on the type of block.
  5776. (let (bounds skip)
  5777. (cond
  5778. ;; Blockquotes
  5779. ((looking-at markdown-regex-blockquote)
  5780. ;; Skip over blank lines inside blockquotes.
  5781. (while (and (not (eobp))
  5782. (looking-at markdown-regex-blockquote)
  5783. (= (length (match-string 3)) 0))
  5784. (forward-line))
  5785. ;; Move to end of quoted text block
  5786. (while (and (not (eobp))
  5787. (looking-at markdown-regex-blockquote)
  5788. (> (length (match-string 3)) 0)) ;; not blank
  5789. (forward-line)))
  5790. ;; List items
  5791. ((and (markdown-cur-list-item-bounds)
  5792. (setq bounds (markdown-next-list-item-bounds)))
  5793. (goto-char (nth 0 bounds)))
  5794. ;; Other
  5795. (t
  5796. (forward-line)
  5797. (while (and (not (eobp))
  5798. (not skip)
  5799. (not (markdown-cur-line-blank-p))
  5800. (not (looking-at markdown-regex-blockquote))
  5801. (not (markdown-range-properties-exist
  5802. (point-at-bol) (point-at-eol)
  5803. '(markdown-gfm-block-begin
  5804. markdown-tilde-fence-begin))))
  5805. (setq skip (markdown-range-properties-exist
  5806. (point-at-bol) (point-at-eol)
  5807. '(markdown-gfm-block-end
  5808. markdown-tilde-fence-end)))
  5809. (forward-line))))))))
  5810. (defun markdown-backward-block (&optional arg)
  5811. "Move the point to the start of the current Markdown block.
  5812. Moves across complete code blocks, list items, and blockquotes,
  5813. but otherwise stops at blank lines, headers, and horizontal
  5814. rules. With argument ARG, do it ARG times; a negative argument
  5815. ARG = -N means move forward N blocks."
  5816. (interactive "^p")
  5817. (or arg (setq arg 1))
  5818. (if (< arg 0)
  5819. (markdown-forward-block (- arg))
  5820. (dotimes (_ arg)
  5821. ;; Skip over whitespace in between blocks when moving backward,
  5822. ;; unless at a block boundary with no whitespace.
  5823. (skip-syntax-backward "-")
  5824. (beginning-of-line)
  5825. ;; Proceed forward based on the type of block.
  5826. (cond
  5827. ;; Code blocks
  5828. ((and (markdown-code-block-at-pos (point)) ;; this line
  5829. (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line
  5830. (forward-line -1)
  5831. (while (and (markdown-code-block-at-point-p) (not (bobp)))
  5832. (forward-line -1))
  5833. (forward-line))
  5834. ;; Headings
  5835. ((markdown-heading-at-point)
  5836. (goto-char (match-beginning 0)))
  5837. ;; Horizontal rules
  5838. ((looking-at markdown-regex-hr))
  5839. ;; Blockquotes
  5840. ((looking-at markdown-regex-blockquote)
  5841. (forward-line -1)
  5842. (while (and (looking-at markdown-regex-blockquote)
  5843. (not (bobp)))
  5844. (forward-line -1))
  5845. (forward-line))
  5846. ;; List items
  5847. ((markdown-cur-list-item-bounds)
  5848. (markdown-beginning-of-list))
  5849. ;; Other
  5850. (t
  5851. ;; Move forward in case it is a one line regular paragraph.
  5852. (unless (markdown-next-line-blank-p)
  5853. (forward-line))
  5854. (unless (markdown-prev-line-blank-p)
  5855. (markdown-backward-paragraph)))))))
  5856. (defun markdown-forward-block (&optional arg)
  5857. "Move forward to the next end of a Markdown block.
  5858. Moves across complete code blocks, list items, and blockquotes,
  5859. but otherwise stops at blank lines, headers, and horizontal
  5860. rules. With argument ARG, do it ARG times; a negative argument
  5861. ARG = -N means move backward N blocks."
  5862. (interactive "^p")
  5863. (or arg (setq arg 1))
  5864. (if (< arg 0)
  5865. (markdown-backward-block (- arg))
  5866. (dotimes (_ arg)
  5867. ;; Skip over whitespace in between blocks when moving forward.
  5868. (if (markdown-cur-line-blank-p)
  5869. (skip-syntax-forward "-")
  5870. (beginning-of-line))
  5871. ;; Proceed forward based on the type of block.
  5872. (cond
  5873. ;; Code blocks
  5874. ((markdown-code-block-at-point-p)
  5875. (forward-line)
  5876. (while (and (markdown-code-block-at-point-p) (not (eobp)))
  5877. (forward-line)))
  5878. ;; Headings
  5879. ((looking-at markdown-regex-header)
  5880. (goto-char (or (match-end 4) (match-end 2) (match-end 3)))
  5881. (forward-line))
  5882. ;; Horizontal rules
  5883. ((looking-at markdown-regex-hr)
  5884. (forward-line))
  5885. ;; Blockquotes
  5886. ((looking-at markdown-regex-blockquote)
  5887. (forward-line)
  5888. (while (and (looking-at markdown-regex-blockquote) (not (eobp)))
  5889. (forward-line)))
  5890. ;; List items
  5891. ((markdown-cur-list-item-bounds)
  5892. (markdown-end-of-list)
  5893. (forward-line))
  5894. ;; Other
  5895. (t (markdown-forward-paragraph))))
  5896. (skip-syntax-backward "-")
  5897. (unless (eobp)
  5898. (forward-char 1))))
  5899. (defun markdown-backward-page (&optional count)
  5900. "Move backward to boundary of the current toplevel section.
  5901. With COUNT, repeat, or go forward if negative."
  5902. (interactive "p")
  5903. (or count (setq count 1))
  5904. (if (< count 0)
  5905. (markdown-forward-page (- count))
  5906. (skip-syntax-backward "-")
  5907. (or (markdown-back-to-heading-over-code-block t t)
  5908. (goto-char (point-min)))
  5909. (when (looking-at markdown-regex-header)
  5910. (let ((level (markdown-outline-level)))
  5911. (when (> level 1) (markdown-up-heading level))
  5912. (when (> count 1)
  5913. (condition-case nil
  5914. (markdown-backward-same-level (1- count))
  5915. (error (goto-char (point-min)))))))))
  5916. (defun markdown-forward-page (&optional count)
  5917. "Move forward to boundary of the current toplevel section.
  5918. With COUNT, repeat, or go backward if negative."
  5919. (interactive "p")
  5920. (or count (setq count 1))
  5921. (if (< count 0)
  5922. (markdown-backward-page (- count))
  5923. (if (markdown-back-to-heading-over-code-block t t)
  5924. (let ((level (markdown-outline-level)))
  5925. (when (> level 1) (markdown-up-heading level))
  5926. (condition-case nil
  5927. (markdown-forward-same-level count)
  5928. (error (goto-char (point-max)))))
  5929. (markdown-next-visible-heading 1))))
  5930. (defun markdown-next-link ()
  5931. "Jump to next inline, reference, or wiki link.
  5932. If successful, return point. Otherwise, return nil.
  5933. See `markdown-wiki-link-p' and `markdown-previous-wiki-link'."
  5934. (interactive)
  5935. (let ((opoint (point)))
  5936. (when (or (markdown-link-p) (markdown-wiki-link-p))
  5937. ;; At a link already, move past it.
  5938. (goto-char (+ (match-end 0) 1)))
  5939. ;; Search for the next wiki link and move to the beginning.
  5940. (while (and (re-search-forward (markdown-make-regex-link-generic) nil t)
  5941. (markdown-code-block-at-point-p)
  5942. (< (point) (point-max))))
  5943. (if (and (not (eq (point) opoint))
  5944. (or (markdown-link-p) (markdown-wiki-link-p)))
  5945. ;; Group 1 will move past non-escape character in wiki link regexp.
  5946. ;; Go to beginning of group zero for all other link types.
  5947. (goto-char (or (match-beginning 1) (match-beginning 0)))
  5948. (goto-char opoint)
  5949. nil)))
  5950. (defun markdown-previous-link ()
  5951. "Jump to previous wiki link.
  5952. If successful, return point. Otherwise, return nil.
  5953. See `markdown-wiki-link-p' and `markdown-next-wiki-link'."
  5954. (interactive)
  5955. (let ((opoint (point)))
  5956. (while (and (re-search-backward (markdown-make-regex-link-generic) nil t)
  5957. (markdown-code-block-at-point-p)
  5958. (> (point) (point-min))))
  5959. (if (and (not (eq (point) opoint))
  5960. (or (markdown-link-p) (markdown-wiki-link-p)))
  5961. (goto-char (or (match-beginning 1) (match-beginning 0)))
  5962. (goto-char opoint)
  5963. nil)))
  5964. ;;; Outline ===================================================================
  5965. (defun markdown-move-heading-common (move-fn &optional arg adjust)
  5966. "Wrapper for `outline-mode' functions to skip false positives.
  5967. MOVE-FN is a function and ARG is its argument. For example,
  5968. headings inside preformatted code blocks may match
  5969. `outline-regexp' but should not be considered as headings.
  5970. When ADJUST is non-nil, adjust the point for interactive calls
  5971. to avoid leaving the point at invisible markup. This adjustment
  5972. generally should only be done for interactive calls, since other
  5973. functions may expect the point to be at the beginning of the
  5974. regular expression."
  5975. (let ((prev -1) (start (point)))
  5976. (if arg (funcall move-fn arg) (funcall move-fn))
  5977. (while (and (/= prev (point)) (markdown-code-block-at-point-p))
  5978. (setq prev (point))
  5979. (if arg (funcall move-fn arg) (funcall move-fn)))
  5980. ;; Adjust point for setext headings and invisible text.
  5981. (save-match-data
  5982. (when (and adjust (thing-at-point-looking-at markdown-regex-header))
  5983. (if markdown-hide-markup
  5984. ;; Move to beginning of heading text if markup is hidden.
  5985. (goto-char (or (match-beginning 1) (match-beginning 5)))
  5986. ;; Move to beginning of markup otherwise.
  5987. (goto-char (or (match-beginning 1) (match-beginning 4))))))
  5988. (if (= (point) start) nil (point))))
  5989. (defun markdown-next-visible-heading (arg)
  5990. "Move to the next visible heading line of any level.
  5991. With argument, repeats or can move backward if negative. ARG is
  5992. passed to `outline-next-visible-heading'."
  5993. (interactive "p")
  5994. (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust))
  5995. (defun markdown-previous-visible-heading (arg)
  5996. "Move to the previous visible heading line of any level.
  5997. With argument, repeats or can move backward if negative. ARG is
  5998. passed to `outline-previous-visible-heading'."
  5999. (interactive "p")
  6000. (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust))
  6001. (defun markdown-next-heading ()
  6002. "Move to the next heading line of any level."
  6003. (markdown-move-heading-common #'outline-next-heading))
  6004. (defun markdown-previous-heading ()
  6005. "Move to the previous heading line of any level."
  6006. (markdown-move-heading-common #'outline-previous-heading))
  6007. (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error)
  6008. "Move back to the beginning of the previous heading.
  6009. Returns t if the point is at a heading, the location if a heading
  6010. was found, and nil otherwise.
  6011. Only visible heading lines are considered, unless INVISIBLE-OK is
  6012. non-nil. Throw an error if there is no previous heading unless
  6013. NO-ERROR is non-nil.
  6014. Leaves match data intact for `markdown-regex-header'."
  6015. (beginning-of-line)
  6016. (or (and (markdown-heading-at-point)
  6017. (not (markdown-code-block-at-point-p)))
  6018. (let (found)
  6019. (save-excursion
  6020. (while (and (not found)
  6021. (re-search-backward markdown-regex-header nil t))
  6022. (when (and (or invisible-ok (not (outline-invisible-p)))
  6023. (not (markdown-code-block-at-point-p)))
  6024. (setq found (point))))
  6025. (if (not found)
  6026. (unless no-error (user-error "Before first heading"))
  6027. (setq found (point))))
  6028. (when found (goto-char found)))))
  6029. (defun markdown-forward-same-level (arg)
  6030. "Move forward to the ARG'th heading at same level as this one.
  6031. Stop at the first and last headings of a superior heading."
  6032. (interactive "p")
  6033. (markdown-back-to-heading-over-code-block)
  6034. (markdown-move-heading-common #'outline-forward-same-level arg 'adjust))
  6035. (defun markdown-backward-same-level (arg)
  6036. "Move backward to the ARG'th heading at same level as this one.
  6037. Stop at the first and last headings of a superior heading."
  6038. (interactive "p")
  6039. (markdown-back-to-heading-over-code-block)
  6040. (while (> arg 0)
  6041. (let ((point-to-move-to
  6042. (save-excursion
  6043. (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust))))
  6044. (if point-to-move-to
  6045. (progn
  6046. (goto-char point-to-move-to)
  6047. (setq arg (1- arg)))
  6048. (user-error "No previous same-level heading")))))
  6049. (defun markdown-up-heading (arg &optional interactive)
  6050. "Move to the visible heading line of which the present line is a subheading.
  6051. With argument, move up ARG levels. When called interactively (or
  6052. INTERACTIVE is non-nil), also push the mark."
  6053. (interactive "p\np")
  6054. (and interactive (not (eq last-command 'markdown-up-heading))
  6055. (push-mark))
  6056. (markdown-move-heading-common #'outline-up-heading arg 'adjust))
  6057. (defun markdown-back-to-heading (&optional invisible-ok)
  6058. "Move to previous heading line, or beg of this line if it's a heading.
  6059. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
  6060. (interactive)
  6061. (markdown-move-heading-common #'outline-back-to-heading invisible-ok))
  6062. (defalias 'markdown-end-of-heading 'outline-end-of-heading)
  6063. (defun markdown-on-heading-p ()
  6064. "Return non-nil if point is on a heading line."
  6065. (get-text-property (point-at-bol) 'markdown-heading))
  6066. (defun markdown-end-of-subtree (&optional invisible-OK)
  6067. "Move to the end of the current subtree.
  6068. Only visible heading lines are considered, unless INVISIBLE-OK is
  6069. non-nil.
  6070. Derived from `org-end-of-subtree'."
  6071. (markdown-back-to-heading invisible-OK)
  6072. (let ((first t)
  6073. (level (markdown-outline-level)))
  6074. (while (and (not (eobp))
  6075. (or first (> (markdown-outline-level) level)))
  6076. (setq first nil)
  6077. (markdown-next-heading))
  6078. (if (memq (preceding-char) '(?\n ?\^M))
  6079. (progn
  6080. ;; Go to end of line before heading
  6081. (forward-char -1)
  6082. (if (memq (preceding-char) '(?\n ?\^M))
  6083. ;; leave blank line before heading
  6084. (forward-char -1)))))
  6085. (point))
  6086. (defun markdown-outline-fix-visibility ()
  6087. "Hide any false positive headings that should not be shown.
  6088. For example, headings inside preformatted code blocks may match
  6089. `outline-regexp' but should not be shown as headings when cycling.
  6090. Also, the ending --- line in metadata blocks appears to be a
  6091. setext header, but should not be folded."
  6092. (save-excursion
  6093. (goto-char (point-min))
  6094. ;; Unhide any false positives in metadata blocks
  6095. (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin)
  6096. (let ((body (progn (forward-line)
  6097. (markdown-text-property-at-point
  6098. 'markdown-yaml-metadata-section))))
  6099. (when body
  6100. (let ((end (progn (goto-char (cl-second body))
  6101. (markdown-text-property-at-point
  6102. 'markdown-yaml-metadata-end))))
  6103. (outline-flag-region (point-min) (1+ (cl-second end)) nil)))))
  6104. ;; Hide any false positives in code blocks
  6105. (unless (outline-on-heading-p)
  6106. (outline-next-visible-heading 1))
  6107. (while (< (point) (point-max))
  6108. (when (markdown-code-block-at-point-p)
  6109. (outline-flag-region (1- (point-at-bol)) (point-at-eol) t))
  6110. (outline-next-visible-heading 1))))
  6111. (defvar markdown-cycle-global-status 1)
  6112. (defvar markdown-cycle-subtree-status nil)
  6113. (defun markdown-next-preface ()
  6114. (let (finish)
  6115. (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
  6116. nil 'move))
  6117. (unless (markdown-code-block-at-point-p)
  6118. (goto-char (match-beginning 0))
  6119. (setq finish t))))
  6120. (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
  6121. (forward-char -1)))
  6122. (defun markdown-show-entry ()
  6123. (save-excursion
  6124. (outline-back-to-heading t)
  6125. (outline-flag-region (1- (point))
  6126. (progn
  6127. (markdown-next-preface)
  6128. (if (= 1 (- (point-max) (point)))
  6129. (point-max)
  6130. (point)))
  6131. nil)))
  6132. ;; This function was originally derived from `org-cycle' from org.el.
  6133. (defun markdown-cycle (&optional arg)
  6134. "Visibility cycling for Markdown mode.
  6135. This function is called with a `\\[universal-argument]' or if ARG is t, perform
  6136. global visibility cycling. If the point is at an atx-style header, cycle
  6137. visibility of the corresponding subtree. Otherwise, indent the current line
  6138. or insert a tab, as appropriate, by calling `indent-for-tab-command'."
  6139. (interactive "P")
  6140. (cond
  6141. ;; Global cycling
  6142. (arg
  6143. (cond
  6144. ;; Move from overview to contents
  6145. ((and (eq last-command this-command)
  6146. (eq markdown-cycle-global-status 2))
  6147. (outline-hide-sublevels 1)
  6148. (message "CONTENTS")
  6149. (setq markdown-cycle-global-status 3)
  6150. (markdown-outline-fix-visibility))
  6151. ;; Move from contents to all
  6152. ((and (eq last-command this-command)
  6153. (eq markdown-cycle-global-status 3))
  6154. (outline-show-all)
  6155. (message "SHOW ALL")
  6156. (setq markdown-cycle-global-status 1))
  6157. ;; Defaults to overview
  6158. (t
  6159. (outline-hide-body)
  6160. (message "OVERVIEW")
  6161. (setq markdown-cycle-global-status 2)
  6162. (markdown-outline-fix-visibility))))
  6163. ;; At a heading: rotate between three different views
  6164. ((save-excursion (beginning-of-line 1) (markdown-on-heading-p))
  6165. (markdown-back-to-heading)
  6166. (let ((goal-column 0) eoh eol eos)
  6167. ;; Determine boundaries
  6168. (save-excursion
  6169. (markdown-back-to-heading)
  6170. (save-excursion
  6171. (beginning-of-line 2)
  6172. (while (and (not (eobp)) ;; this is like `next-line'
  6173. (get-char-property (1- (point)) 'invisible))
  6174. (beginning-of-line 2)) (setq eol (point)))
  6175. (markdown-end-of-heading) (setq eoh (point))
  6176. (markdown-end-of-subtree t)
  6177. (skip-chars-forward " \t\n")
  6178. (beginning-of-line 1) ; in case this is an item
  6179. (setq eos (1- (point))))
  6180. ;; Find out what to do next and set `this-command'
  6181. (cond
  6182. ;; Nothing is hidden behind this heading
  6183. ((= eos eoh)
  6184. (message "EMPTY ENTRY")
  6185. (setq markdown-cycle-subtree-status nil))
  6186. ;; Entire subtree is hidden in one line: open it
  6187. ((>= eol eos)
  6188. (markdown-show-entry)
  6189. (outline-show-children)
  6190. (message "CHILDREN")
  6191. (setq markdown-cycle-subtree-status 'children))
  6192. ;; We just showed the children, now show everything.
  6193. ((and (eq last-command this-command)
  6194. (eq markdown-cycle-subtree-status 'children))
  6195. (outline-show-subtree)
  6196. (message "SUBTREE")
  6197. (setq markdown-cycle-subtree-status 'subtree))
  6198. ;; Default action: hide the subtree.
  6199. (t
  6200. (outline-hide-subtree)
  6201. (message "FOLDED")
  6202. (setq markdown-cycle-subtree-status 'folded)))))
  6203. ;; In a table, move forward by one cell
  6204. ((markdown-table-at-point-p)
  6205. (call-interactively #'markdown-table-forward-cell))
  6206. ;; Otherwise, indent as appropriate
  6207. (t
  6208. (indent-for-tab-command))))
  6209. (defun markdown-shifttab ()
  6210. "Handle S-TAB keybinding based on context.
  6211. When in a table, move backward one cell.
  6212. Otherwise, cycle global heading visibility by calling
  6213. `markdown-cycle' with argument t."
  6214. (interactive)
  6215. (cond ((markdown-table-at-point-p)
  6216. (call-interactively #'markdown-table-backward-cell))
  6217. (t (markdown-cycle t))))
  6218. (defun markdown-outline-level ()
  6219. "Return the depth to which a statement is nested in the outline."
  6220. (cond
  6221. ((and (match-beginning 0)
  6222. (markdown-code-block-at-pos (match-beginning 0)))
  6223. 7) ;; Only 6 header levels are defined.
  6224. ((match-end 2) 1)
  6225. ((match-end 3) 2)
  6226. ((match-end 4)
  6227. (length (markdown-trim-whitespace (match-string-no-properties 4))))))
  6228. (defun markdown-promote-subtree (&optional arg)
  6229. "Promote the current subtree of ATX headings.
  6230. Note that Markdown does not support heading levels higher than
  6231. six and therefore level-six headings will not be promoted
  6232. further. If ARG is non-nil promote the heading, otherwise
  6233. demote."
  6234. (interactive "*P")
  6235. (save-excursion
  6236. (when (and (or (thing-at-point-looking-at markdown-regex-header-atx)
  6237. (re-search-backward markdown-regex-header-atx nil t))
  6238. (not (markdown-code-block-at-point-p)))
  6239. (let ((level (length (match-string 1)))
  6240. (promote-or-demote (if arg 1 -1))
  6241. (remove 't))
  6242. (markdown-cycle-atx promote-or-demote remove)
  6243. (catch 'end-of-subtree
  6244. (while (and (markdown-next-heading)
  6245. (looking-at markdown-regex-header-atx))
  6246. ;; Exit if this not a higher level heading; promote otherwise.
  6247. (if (and (looking-at markdown-regex-header-atx)
  6248. (<= (length (match-string-no-properties 1)) level))
  6249. (throw 'end-of-subtree nil)
  6250. (markdown-cycle-atx promote-or-demote remove))))))))
  6251. (defun markdown-demote-subtree ()
  6252. "Demote the current subtree of ATX headings."
  6253. (interactive)
  6254. (markdown-promote-subtree t))
  6255. (defun markdown-move-subtree-up ()
  6256. "Move the current subtree of ATX headings up."
  6257. (interactive)
  6258. (outline-move-subtree-up 1))
  6259. (defun markdown-move-subtree-down ()
  6260. "Move the current subtree of ATX headings down."
  6261. (interactive)
  6262. (outline-move-subtree-down 1))
  6263. (defun markdown-outline-next ()
  6264. "Move to next list item, when in a list, or next visible heading."
  6265. (interactive)
  6266. (let ((bounds (markdown-next-list-item-bounds)))
  6267. (if bounds
  6268. (goto-char (nth 0 bounds))
  6269. (markdown-next-visible-heading 1))))
  6270. (defun markdown-outline-previous ()
  6271. "Move to previous list item, when in a list, or previous visible heading."
  6272. (interactive)
  6273. (let ((bounds (markdown-prev-list-item-bounds)))
  6274. (if bounds
  6275. (goto-char (nth 0 bounds))
  6276. (markdown-previous-visible-heading 1))))
  6277. (defun markdown-outline-next-same-level ()
  6278. "Move to next list item or heading of same level."
  6279. (interactive)
  6280. (let ((bounds (markdown-cur-list-item-bounds)))
  6281. (if bounds
  6282. (markdown-next-list-item (nth 3 bounds))
  6283. (markdown-forward-same-level 1))))
  6284. (defun markdown-outline-previous-same-level ()
  6285. "Move to previous list item or heading of same level."
  6286. (interactive)
  6287. (let ((bounds (markdown-cur-list-item-bounds)))
  6288. (if bounds
  6289. (markdown-prev-list-item (nth 3 bounds))
  6290. (markdown-backward-same-level 1))))
  6291. (defun markdown-outline-up ()
  6292. "Move to previous list item, when in a list, or next heading."
  6293. (interactive)
  6294. (unless (markdown-up-list)
  6295. (markdown-up-heading 1)))
  6296. ;;; Marking and Narrowing =====================================================
  6297. (defun markdown-mark-paragraph ()
  6298. "Put mark at end of this block, point at beginning.
  6299. The block marked is the one that contains point or follows point.
  6300. Interactively, if this command is repeated or (in Transient Mark
  6301. mode) if the mark is active, it marks the next block after the
  6302. ones already marked."
  6303. (interactive)
  6304. (if (or (and (eq last-command this-command) (mark t))
  6305. (and transient-mark-mode mark-active))
  6306. (set-mark
  6307. (save-excursion
  6308. (goto-char (mark))
  6309. (markdown-forward-paragraph)
  6310. (point)))
  6311. (let ((beginning-of-defun-function 'markdown-backward-paragraph)
  6312. (end-of-defun-function 'markdown-forward-paragraph))
  6313. (mark-defun))))
  6314. (defun markdown-mark-block ()
  6315. "Put mark at end of this block, point at beginning.
  6316. The block marked is the one that contains point or follows point.
  6317. Interactively, if this command is repeated or (in Transient Mark
  6318. mode) if the mark is active, it marks the next block after the
  6319. ones already marked."
  6320. (interactive)
  6321. (if (or (and (eq last-command this-command) (mark t))
  6322. (and transient-mark-mode mark-active))
  6323. (set-mark
  6324. (save-excursion
  6325. (goto-char (mark))
  6326. (markdown-forward-block)
  6327. (point)))
  6328. (let ((beginning-of-defun-function 'markdown-backward-block)
  6329. (end-of-defun-function 'markdown-forward-block))
  6330. (mark-defun))))
  6331. (defun markdown-narrow-to-block ()
  6332. "Make text outside current block invisible.
  6333. The current block is the one that contains point or follows point."
  6334. (interactive)
  6335. (let ((beginning-of-defun-function 'markdown-backward-block)
  6336. (end-of-defun-function 'markdown-forward-block))
  6337. (narrow-to-defun)))
  6338. (defun markdown-mark-text-block ()
  6339. "Put mark at end of this plain text block, point at beginning.
  6340. The block marked is the one that contains point or follows point.
  6341. Interactively, if this command is repeated or (in Transient Mark
  6342. mode) if the mark is active, it marks the next block after the
  6343. ones already marked."
  6344. (interactive)
  6345. (if (or (and (eq last-command this-command) (mark t))
  6346. (and transient-mark-mode mark-active))
  6347. (set-mark
  6348. (save-excursion
  6349. (goto-char (mark))
  6350. (markdown-end-of-text-block)
  6351. (point)))
  6352. (let ((beginning-of-defun-function 'markdown-beginning-of-text-block)
  6353. (end-of-defun-function 'markdown-end-of-text-block))
  6354. (mark-defun))))
  6355. (defun markdown-mark-page ()
  6356. "Put mark at end of this top level section, point at beginning.
  6357. The top level section marked is the one that contains point or
  6358. follows point.
  6359. Interactively, if this command is repeated or (in Transient Mark
  6360. mode) if the mark is active, it marks the next page after the
  6361. ones already marked."
  6362. (interactive)
  6363. (if (or (and (eq last-command this-command) (mark t))
  6364. (and transient-mark-mode mark-active))
  6365. (set-mark
  6366. (save-excursion
  6367. (goto-char (mark))
  6368. (markdown-forward-page)
  6369. (point)))
  6370. (let ((beginning-of-defun-function 'markdown-backward-page)
  6371. (end-of-defun-function 'markdown-forward-page))
  6372. (mark-defun))))
  6373. (defun markdown-narrow-to-page ()
  6374. "Make text outside current top level section invisible.
  6375. The current section is the one that contains point or follows point."
  6376. (interactive)
  6377. (let ((beginning-of-defun-function 'markdown-backward-page)
  6378. (end-of-defun-function 'markdown-forward-page))
  6379. (narrow-to-defun)))
  6380. (defun markdown-mark-subtree ()
  6381. "Mark the current subtree.
  6382. This puts point at the start of the current subtree, and mark at the end."
  6383. (interactive)
  6384. (let ((beg))
  6385. (if (markdown-heading-at-point)
  6386. (beginning-of-line)
  6387. (markdown-previous-visible-heading 1))
  6388. (setq beg (point))
  6389. (markdown-end-of-subtree)
  6390. (push-mark (point) nil t)
  6391. (goto-char beg)))
  6392. (defun markdown-narrow-to-subtree ()
  6393. "Narrow buffer to the current subtree."
  6394. (interactive)
  6395. (save-excursion
  6396. (save-match-data
  6397. (narrow-to-region
  6398. (progn (markdown-back-to-heading-over-code-block t) (point))
  6399. (progn (markdown-end-of-subtree)
  6400. (if (and (markdown-heading-at-point) (not (eobp)))
  6401. (backward-char 1))
  6402. (point))))))
  6403. ;;; Generic Structure Editing, Completion, and Cycling Commands ===============
  6404. (defun markdown-move-up ()
  6405. "Move thing at point up.
  6406. When in a list item, call `markdown-move-list-item-up'.
  6407. When in a table, call `markdown-table-move-row-up'.
  6408. Otherwise, move the current heading subtree up with
  6409. `markdown-move-subtree-up'."
  6410. (interactive)
  6411. (cond
  6412. ((markdown-list-item-at-point-p)
  6413. (call-interactively #'markdown-move-list-item-up))
  6414. ((markdown-table-at-point-p)
  6415. (call-interactively #'markdown-table-move-row-up))
  6416. (t
  6417. (call-interactively #'markdown-move-subtree-up))))
  6418. (defun markdown-move-down ()
  6419. "Move thing at point down.
  6420. When in a list item, call `markdown-move-list-item-down'.
  6421. Otherwise, move the current heading subtree up with
  6422. `markdown-move-subtree-down'."
  6423. (interactive)
  6424. (cond
  6425. ((markdown-list-item-at-point-p)
  6426. (call-interactively #'markdown-move-list-item-down))
  6427. ((markdown-table-at-point-p)
  6428. (call-interactively #'markdown-table-move-row-down))
  6429. (t
  6430. (call-interactively #'markdown-move-subtree-down))))
  6431. (defun markdown-promote ()
  6432. "Promote or move element at point to the left.
  6433. Depending on the context, this function will promote a heading or
  6434. list item at the point, move a table column to the left, or cycle
  6435. markup."
  6436. (interactive)
  6437. (let (bounds)
  6438. (cond
  6439. ;; Promote atx heading subtree
  6440. ((thing-at-point-looking-at markdown-regex-header-atx)
  6441. (markdown-promote-subtree))
  6442. ;; Promote setext heading
  6443. ((thing-at-point-looking-at markdown-regex-header-setext)
  6444. (markdown-cycle-setext -1))
  6445. ;; Promote horizontal rule
  6446. ((thing-at-point-looking-at markdown-regex-hr)
  6447. (markdown-cycle-hr -1))
  6448. ;; Promote list item
  6449. ((setq bounds (markdown-cur-list-item-bounds))
  6450. (markdown-promote-list-item bounds))
  6451. ;; Move table column to the left
  6452. ((markdown-table-at-point-p)
  6453. (call-interactively #'markdown-table-move-column-left))
  6454. ;; Promote bold
  6455. ((thing-at-point-looking-at markdown-regex-bold)
  6456. (markdown-cycle-bold))
  6457. ;; Promote italic
  6458. ((thing-at-point-looking-at markdown-regex-italic)
  6459. (markdown-cycle-italic))
  6460. (t
  6461. (user-error "Nothing to promote at point")))))
  6462. (defun markdown-demote ()
  6463. "Demote or move element at point to the right.
  6464. Depending on the context, this function will demote a heading or
  6465. list item at the point, move a table column to the right, or cycle
  6466. or remove markup."
  6467. (interactive)
  6468. (let (bounds)
  6469. (cond
  6470. ;; Demote atx heading subtree
  6471. ((thing-at-point-looking-at markdown-regex-header-atx)
  6472. (markdown-demote-subtree))
  6473. ;; Demote setext heading
  6474. ((thing-at-point-looking-at markdown-regex-header-setext)
  6475. (markdown-cycle-setext 1))
  6476. ;; Demote horizontal rule
  6477. ((thing-at-point-looking-at markdown-regex-hr)
  6478. (markdown-cycle-hr 1))
  6479. ;; Demote list item
  6480. ((setq bounds (markdown-cur-list-item-bounds))
  6481. (markdown-demote-list-item bounds))
  6482. ;; Move table column to the right
  6483. ((markdown-table-at-point-p)
  6484. (call-interactively #'markdown-table-move-column-right))
  6485. ;; Demote bold
  6486. ((thing-at-point-looking-at markdown-regex-bold)
  6487. (markdown-cycle-bold))
  6488. ;; Demote italic
  6489. ((thing-at-point-looking-at markdown-regex-italic)
  6490. (markdown-cycle-italic))
  6491. (t
  6492. (user-error "Nothing to demote at point")))))
  6493. ;;; Commands ==================================================================
  6494. (defun markdown (&optional output-buffer-name)
  6495. "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME.
  6496. The output buffer name defaults to `markdown-output-buffer-name'.
  6497. Return the name of the output buffer used."
  6498. (interactive)
  6499. (save-window-excursion
  6500. (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command))
  6501. ((listp markdown-command) markdown-command)))
  6502. (command (car-safe commands))
  6503. (command-args (cdr-safe commands))
  6504. begin-region end-region)
  6505. (if (use-region-p)
  6506. (setq begin-region (region-beginning)
  6507. end-region (region-end))
  6508. (setq begin-region (point-min)
  6509. end-region (point-max)))
  6510. (unless output-buffer-name
  6511. (setq output-buffer-name markdown-output-buffer-name))
  6512. (when (and (stringp command) (not (executable-find command)))
  6513. (user-error "Markdown command %s is not found" command))
  6514. (let ((exit-code
  6515. (cond
  6516. ;; Handle case when `markdown-command' does not read from stdin
  6517. ((and (stringp command) markdown-command-needs-filename)
  6518. (if (not buffer-file-name)
  6519. (user-error "Must be visiting a file")
  6520. ;; Don’t use ‘shell-command’ because it’s not guaranteed to
  6521. ;; return the exit code of the process.
  6522. (let ((command (if (listp markdown-command)
  6523. (string-join markdown-command " ")
  6524. markdown-command)))
  6525. (shell-command-on-region
  6526. ;; Pass an empty region so that stdin is empty.
  6527. (point) (point)
  6528. (concat command " "
  6529. (shell-quote-argument buffer-file-name))
  6530. output-buffer-name))))
  6531. ;; Pass region to `markdown-command' via stdin
  6532. (t
  6533. (let ((buf (get-buffer-create output-buffer-name)))
  6534. (with-current-buffer buf
  6535. (setq buffer-read-only nil)
  6536. (erase-buffer))
  6537. (if (stringp command)
  6538. (if (not (null command-args))
  6539. (apply #'call-process-region begin-region end-region command nil buf nil command-args)
  6540. (call-process-region begin-region end-region command nil buf))
  6541. (funcall markdown-command begin-region end-region buf)
  6542. ;; If the ‘markdown-command’ function didn’t signal an
  6543. ;; error, assume it succeeded by binding ‘exit-code’ to 0.
  6544. 0))))))
  6545. ;; The exit code can be a signal description string, so don’t use ‘=’
  6546. ;; or ‘zerop’.
  6547. (unless (eq exit-code 0)
  6548. (user-error "%s failed with exit code %s"
  6549. markdown-command exit-code))))
  6550. output-buffer-name))
  6551. (defun markdown-standalone (&optional output-buffer-name)
  6552. "Special function to provide standalone HTML output.
  6553. Insert the output in the buffer named OUTPUT-BUFFER-NAME."
  6554. (interactive)
  6555. (setq output-buffer-name (markdown output-buffer-name))
  6556. (with-current-buffer output-buffer-name
  6557. (set-buffer output-buffer-name)
  6558. (unless (markdown-output-standalone-p)
  6559. (markdown-add-xhtml-header-and-footer output-buffer-name))
  6560. (goto-char (point-min))
  6561. (html-mode))
  6562. output-buffer-name)
  6563. (defun markdown-other-window (&optional output-buffer-name)
  6564. "Run `markdown-command' on current buffer and display in other window.
  6565. When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
  6566. that name."
  6567. (interactive)
  6568. (markdown-display-buffer-other-window
  6569. (markdown-standalone output-buffer-name)))
  6570. (defun markdown-output-standalone-p ()
  6571. "Determine whether `markdown-command' output is standalone XHTML.
  6572. Standalone XHTML output is identified by an occurrence of
  6573. `markdown-xhtml-standalone-regexp' in the first five lines of output."
  6574. (save-excursion
  6575. (goto-char (point-min))
  6576. (save-match-data
  6577. (re-search-forward
  6578. markdown-xhtml-standalone-regexp
  6579. (save-excursion (goto-char (point-min)) (forward-line 4) (point))
  6580. t))))
  6581. (defun markdown-stylesheet-link-string (stylesheet-path)
  6582. (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\""
  6583. (or (and (string-prefix-p "~" stylesheet-path)
  6584. (expand-file-name stylesheet-path))
  6585. stylesheet-path)
  6586. "\" />"))
  6587. (defun markdown-add-xhtml-header-and-footer (title)
  6588. "Wrap XHTML header and footer with given TITLE around current buffer."
  6589. (goto-char (point-min))
  6590. (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n"
  6591. "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n"
  6592. "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"
  6593. "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n"
  6594. "<head>\n<title>")
  6595. (insert title)
  6596. (insert "</title>\n")
  6597. (unless (= (length markdown-content-type) 0)
  6598. (insert
  6599. (format
  6600. "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n"
  6601. markdown-content-type
  6602. (or (and markdown-coding-system
  6603. (coding-system-get markdown-coding-system
  6604. 'mime-charset))
  6605. (coding-system-get buffer-file-coding-system
  6606. 'mime-charset)
  6607. "utf-8"))))
  6608. (if (> (length markdown-css-paths) 0)
  6609. (insert (mapconcat #'markdown-stylesheet-link-string
  6610. markdown-css-paths "\n")))
  6611. (when (> (length markdown-xhtml-header-content) 0)
  6612. (insert markdown-xhtml-header-content))
  6613. (insert "\n</head>\n\n"
  6614. "<body>\n\n")
  6615. (when (> (length markdown-xhtml-body-preamble) 0)
  6616. (insert markdown-xhtml-body-preamble "\n"))
  6617. (goto-char (point-max))
  6618. (when (> (length markdown-xhtml-body-epilogue) 0)
  6619. (insert "\n" markdown-xhtml-body-epilogue))
  6620. (insert "\n"
  6621. "</body>\n"
  6622. "</html>\n"))
  6623. (defun markdown-preview (&optional output-buffer-name)
  6624. "Run `markdown-command' on the current buffer and view output in browser.
  6625. When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with
  6626. that name."
  6627. (interactive)
  6628. (browse-url-of-buffer
  6629. (markdown-standalone (or output-buffer-name markdown-output-buffer-name))))
  6630. (defun markdown-export-file-name (&optional extension)
  6631. "Attempt to generate a filename for Markdown output.
  6632. The file extension will be EXTENSION if given, or .html by default.
  6633. If the current buffer is visiting a file, we construct a new
  6634. output filename based on that filename. Otherwise, return nil."
  6635. (when (buffer-file-name)
  6636. (unless extension
  6637. (setq extension ".html"))
  6638. (let ((candidate
  6639. (concat
  6640. (cond
  6641. ((buffer-file-name)
  6642. (file-name-sans-extension (buffer-file-name)))
  6643. (t (buffer-name)))
  6644. extension)))
  6645. (cond
  6646. ((equal candidate (buffer-file-name))
  6647. (concat candidate extension))
  6648. (t
  6649. candidate)))))
  6650. (defun markdown-export (&optional output-file)
  6651. "Run Markdown on the current buffer, save to file, and return the filename.
  6652. If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename
  6653. generated by `markdown-export-file-name', which will be constructed using the
  6654. current filename, but with the extension removed and replaced with .html."
  6655. (interactive)
  6656. (unless output-file
  6657. (setq output-file (markdown-export-file-name ".html")))
  6658. (when output-file
  6659. (let* ((init-buf (current-buffer))
  6660. (init-point (point))
  6661. (init-buf-string (buffer-string))
  6662. (output-buffer (find-file-noselect output-file))
  6663. (output-buffer-name (buffer-name output-buffer)))
  6664. (run-hooks 'markdown-before-export-hook)
  6665. (markdown-standalone output-buffer-name)
  6666. (with-current-buffer output-buffer
  6667. (run-hooks 'markdown-after-export-hook)
  6668. (save-buffer)
  6669. (when markdown-export-kill-buffer (kill-buffer)))
  6670. ;; if modified, restore initial buffer
  6671. (when (buffer-modified-p init-buf)
  6672. (erase-buffer)
  6673. (insert init-buf-string)
  6674. (save-buffer)
  6675. (goto-char init-point))
  6676. output-file)))
  6677. (defun markdown-export-and-preview ()
  6678. "Export to XHTML using `markdown-export' and browse the resulting file."
  6679. (interactive)
  6680. (browse-url-of-file (markdown-export)))
  6681. (defvar-local markdown-live-preview-buffer nil
  6682. "Buffer used to preview markdown output in `markdown-live-preview-export'.")
  6683. (defvar-local markdown-live-preview-source-buffer nil
  6684. "Source buffer from which current buffer was generated.
  6685. This is the inverse of `markdown-live-preview-buffer'.")
  6686. (defvar markdown-live-preview-currently-exporting nil)
  6687. (defun markdown-live-preview-get-filename ()
  6688. "Standardize the filename exported by `markdown-live-preview-export'."
  6689. (markdown-export-file-name ".html"))
  6690. (defun markdown-live-preview-window-eww (file)
  6691. "Preview FILE with eww.
  6692. To be used with `markdown-live-preview-window-function'."
  6693. (eww-open-file file)
  6694. (get-buffer "*eww*"))
  6695. (defun markdown-visual-lines-between-points (beg end)
  6696. (save-excursion
  6697. (goto-char beg)
  6698. (cl-loop with count = 0
  6699. while (progn (end-of-visual-line)
  6700. (and (< (point) end) (line-move-visual 1 t)))
  6701. do (cl-incf count)
  6702. finally return count)))
  6703. (defun markdown-live-preview-window-serialize (buf)
  6704. "Get window point and scroll data for all windows displaying BUF."
  6705. (when (buffer-live-p buf)
  6706. (with-current-buffer buf
  6707. (mapcar
  6708. (lambda (win)
  6709. (with-selected-window win
  6710. (let* ((start (window-start))
  6711. (pt (window-point))
  6712. (pt-or-sym (cond ((= pt (point-min)) 'min)
  6713. ((= pt (point-max)) 'max)
  6714. (t pt)))
  6715. (diff (markdown-visual-lines-between-points
  6716. start pt)))
  6717. (list win pt-or-sym diff))))
  6718. (get-buffer-window-list buf)))))
  6719. (defun markdown-get-point-back-lines (pt num-lines)
  6720. (save-excursion
  6721. (goto-char pt)
  6722. (line-move-visual (- num-lines) t)
  6723. ;; in testing, can occasionally overshoot the number of lines to traverse
  6724. (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt)))
  6725. (when (> actual-num-lines num-lines)
  6726. (line-move-visual (- actual-num-lines num-lines) t)))
  6727. (point)))
  6728. (defun markdown-live-preview-window-deserialize (window-posns)
  6729. "Apply window point and scroll data from WINDOW-POSNS.
  6730. WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'."
  6731. (cl-destructuring-bind (win pt-or-sym diff) window-posns
  6732. (when (window-live-p win)
  6733. (with-current-buffer markdown-live-preview-buffer
  6734. (set-window-buffer win (current-buffer))
  6735. (cl-destructuring-bind (actual-pt actual-diff)
  6736. (cl-case pt-or-sym
  6737. (min (list (point-min) 0))
  6738. (max (list (point-max) diff))
  6739. (t (list pt-or-sym diff)))
  6740. (set-window-start
  6741. win (markdown-get-point-back-lines actual-pt actual-diff))
  6742. (set-window-point win actual-pt))))))
  6743. (defun markdown-live-preview-export ()
  6744. "Export to XHTML using `markdown-export'.
  6745. Browse the resulting file within Emacs using
  6746. `markdown-live-preview-window-function' Return the buffer
  6747. displaying the rendered output."
  6748. (interactive)
  6749. (let ((filename (markdown-live-preview-get-filename)))
  6750. (when filename
  6751. (let* ((markdown-live-preview-currently-exporting t)
  6752. (cur-buf (current-buffer))
  6753. (export-file (markdown-export filename))
  6754. ;; get positions in all windows currently displaying output buffer
  6755. (window-data
  6756. (markdown-live-preview-window-serialize
  6757. markdown-live-preview-buffer)))
  6758. (save-window-excursion
  6759. (let ((output-buffer
  6760. (funcall markdown-live-preview-window-function export-file)))
  6761. (with-current-buffer output-buffer
  6762. (setq markdown-live-preview-source-buffer cur-buf)
  6763. (add-hook 'kill-buffer-hook
  6764. #'markdown-live-preview-remove-on-kill t t))
  6765. (with-current-buffer cur-buf
  6766. (setq markdown-live-preview-buffer output-buffer))))
  6767. (with-current-buffer cur-buf
  6768. ;; reset all windows displaying output buffer to where they were,
  6769. ;; now with the new output
  6770. (mapc #'markdown-live-preview-window-deserialize window-data)
  6771. ;; delete html editing buffer
  6772. (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf)))
  6773. (when (and export-file (file-exists-p export-file)
  6774. (eq markdown-live-preview-delete-export
  6775. 'delete-on-export))
  6776. (delete-file export-file))
  6777. markdown-live-preview-buffer)))))
  6778. (defun markdown-live-preview-remove ()
  6779. (when (buffer-live-p markdown-live-preview-buffer)
  6780. (kill-buffer markdown-live-preview-buffer))
  6781. (setq markdown-live-preview-buffer nil)
  6782. ;; if set to 'delete-on-export, the output has already been deleted
  6783. (when (eq markdown-live-preview-delete-export 'delete-on-destroy)
  6784. (let ((outfile-name (markdown-live-preview-get-filename)))
  6785. (when (and outfile-name (file-exists-p outfile-name))
  6786. (delete-file outfile-name)))))
  6787. (defun markdown-get-other-window ()
  6788. "Find another window to display preview or output content."
  6789. (cond
  6790. ((memq markdown-split-window-direction '(vertical below))
  6791. (or (window-in-direction 'below) (split-window-vertically)))
  6792. ((memq markdown-split-window-direction '(horizontal right))
  6793. (or (window-in-direction 'right) (split-window-horizontally)))
  6794. (t (split-window-sensibly (get-buffer-window)))))
  6795. (defun markdown-display-buffer-other-window (buf)
  6796. "Display preview or output buffer BUF in another window."
  6797. (if (and display-buffer-alist (eq markdown-split-window-direction 'any))
  6798. (display-buffer buf)
  6799. (let ((cur-buf (current-buffer))
  6800. (window (markdown-get-other-window)))
  6801. (set-window-buffer window buf)
  6802. (set-buffer cur-buf))))
  6803. (defun markdown-live-preview-if-markdown ()
  6804. (when (and (derived-mode-p 'markdown-mode)
  6805. markdown-live-preview-mode)
  6806. (unless markdown-live-preview-currently-exporting
  6807. (if (buffer-live-p markdown-live-preview-buffer)
  6808. (markdown-live-preview-export)
  6809. (markdown-display-buffer-other-window
  6810. (markdown-live-preview-export))))))
  6811. (defun markdown-live-preview-remove-on-kill ()
  6812. (cond ((and (derived-mode-p 'markdown-mode)
  6813. markdown-live-preview-mode)
  6814. (markdown-live-preview-remove))
  6815. (markdown-live-preview-source-buffer
  6816. (with-current-buffer markdown-live-preview-source-buffer
  6817. (setq markdown-live-preview-buffer nil))
  6818. (setq markdown-live-preview-source-buffer nil))))
  6819. (defun markdown-live-preview-switch-to-output ()
  6820. "Switch to output buffer."
  6821. (interactive)
  6822. "Turn on `markdown-live-preview-mode' if not already on, and switch to its
  6823. output buffer in another window."
  6824. (if markdown-live-preview-mode
  6825. (markdown-display-buffer-other-window (markdown-live-preview-export)))
  6826. (markdown-live-preview-mode))
  6827. (defun markdown-live-preview-re-export ()
  6828. "Re export source buffer."
  6829. (interactive)
  6830. "If the current buffer is a buffer displaying the exported version of a
  6831. `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and
  6832. update this buffer's contents."
  6833. (when markdown-live-preview-source-buffer
  6834. (with-current-buffer markdown-live-preview-source-buffer
  6835. (markdown-live-preview-export))))
  6836. (defun markdown-open ()
  6837. "Open file for the current buffer with `markdown-open-command'."
  6838. (interactive)
  6839. (unless markdown-open-command
  6840. (user-error "Variable `markdown-open-command' must be set"))
  6841. (if (stringp markdown-open-command)
  6842. (if (not buffer-file-name)
  6843. (user-error "Must be visiting a file")
  6844. (save-buffer)
  6845. (let ((exit-code (call-process markdown-open-command nil nil nil
  6846. buffer-file-name)))
  6847. ;; The exit code can be a signal description string, so don’t use ‘=’
  6848. ;; or ‘zerop’.
  6849. (unless (eq exit-code 0)
  6850. (user-error "%s failed with exit code %s"
  6851. markdown-open-command exit-code))))
  6852. (funcall markdown-open-command))
  6853. nil)
  6854. (defun markdown-kill-ring-save ()
  6855. "Run Markdown on file and store output in the kill ring."
  6856. (interactive)
  6857. (save-window-excursion
  6858. (markdown)
  6859. (with-current-buffer markdown-output-buffer-name
  6860. (kill-ring-save (point-min) (point-max)))))
  6861. ;;; Links =====================================================================
  6862. (defun markdown-backward-to-link-start ()
  6863. "Backward link start position if current position is in link title."
  6864. ;; Issue #305
  6865. (when (eq (get-text-property (point) 'face) 'markdown-link-face)
  6866. (skip-chars-backward "^[")
  6867. (forward-char -1)))
  6868. (defun markdown-link-p ()
  6869. "Return non-nil when `point' is at a non-wiki link.
  6870. See `markdown-wiki-link-p' for more information."
  6871. (save-excursion
  6872. (let ((case-fold-search nil))
  6873. (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p)))
  6874. (markdown-backward-to-link-start)
  6875. (or (thing-at-point-looking-at markdown-regex-link-inline)
  6876. (thing-at-point-looking-at markdown-regex-link-reference)
  6877. (thing-at-point-looking-at markdown-regex-uri)
  6878. (thing-at-point-looking-at markdown-regex-angle-uri))))))
  6879. (defun markdown-link-at-pos (pos)
  6880. "Return properties of link or image at position POS.
  6881. Value is a list of elements describing the link:
  6882. 0. beginning position
  6883. 1. end position
  6884. 2. link text
  6885. 3. URL
  6886. 4. reference label
  6887. 5. title text
  6888. 6. bang (nil or \"!\")"
  6889. (save-excursion
  6890. (goto-char pos)
  6891. (markdown-backward-to-link-start)
  6892. (let (begin end text url reference title bang)
  6893. (cond
  6894. ;; Inline image or link at point.
  6895. ((thing-at-point-looking-at markdown-regex-link-inline)
  6896. (setq bang (match-string-no-properties 1)
  6897. begin (match-beginning 0)
  6898. end (match-end 0)
  6899. text (match-string-no-properties 3)
  6900. url (match-string-no-properties 6))
  6901. (if (match-end 7)
  6902. (setq title (substring (match-string-no-properties 7) 1 -1))
  6903. ;; #408 URL contains close parenthesis case
  6904. (goto-char (match-beginning 5))
  6905. (let ((paren-end (scan-sexps (point) 1)))
  6906. (when (and paren-end (< end paren-end))
  6907. (setq url (buffer-substring (match-beginning 6) (1- paren-end)))))))
  6908. ;; Reference link at point.
  6909. ((or (thing-at-point-looking-at markdown-regex-link-inline)
  6910. (thing-at-point-looking-at markdown-regex-link-reference))
  6911. (setq bang (match-string-no-properties 1)
  6912. begin (match-beginning 0)
  6913. end (match-end 0)
  6914. text (match-string-no-properties 3))
  6915. (when (char-equal (char-after (match-beginning 5)) ?\[)
  6916. (setq reference (match-string-no-properties 6))))
  6917. ;; Angle bracket URI at point.
  6918. ((thing-at-point-looking-at markdown-regex-angle-uri)
  6919. (setq begin (match-beginning 0)
  6920. end (match-end 0)
  6921. url (match-string-no-properties 2)))
  6922. ;; Plain URI at point.
  6923. ((thing-at-point-looking-at markdown-regex-uri)
  6924. (setq begin (match-beginning 0)
  6925. end (match-end 0)
  6926. url (match-string-no-properties 1))))
  6927. (list begin end text url reference title bang))))
  6928. (defun markdown-link-url ()
  6929. "Return the URL part of the regular (non-wiki) link at point.
  6930. Works with both inline and reference style links, and with images.
  6931. If point is not at a link or the link reference is not defined
  6932. returns nil."
  6933. (let* ((values (markdown-link-at-pos (point)))
  6934. (text (nth 2 values))
  6935. (url (nth 3 values))
  6936. (ref (nth 4 values)))
  6937. (or url (and ref (car (markdown-reference-definition
  6938. (downcase (if (string= ref "") text ref))))))))
  6939. (defun markdown--browse-url (url)
  6940. (let* ((struct (url-generic-parse-url url))
  6941. (full (url-fullness struct))
  6942. (file url))
  6943. ;; Parse URL, determine fullness, strip query string
  6944. (setq file (car (url-path-and-query struct)))
  6945. ;; Open full URLs in browser, files in Emacs
  6946. (if full
  6947. (browse-url url)
  6948. (when (and file (> (length file) 0))
  6949. (let ((link-file (funcall markdown-translate-filename-function file)))
  6950. (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file))
  6951. (if (functionp markdown-open-image-command)
  6952. (funcall markdown-open-image-command link-file)
  6953. (process-file markdown-open-image-command nil nil nil link-file))
  6954. (find-file link-file)))))))
  6955. (defun markdown-follow-link-at-point ()
  6956. "Open the current non-wiki link.
  6957. If the link is a complete URL, open in browser with `browse-url'.
  6958. Otherwise, open with `find-file' after stripping anchor and/or query string.
  6959. Translate filenames using `markdown-filename-translate-function'."
  6960. (interactive)
  6961. (if (markdown-link-p)
  6962. (markdown--browse-url (markdown-link-url))
  6963. (user-error "Point is not at a Markdown link or URL")))
  6964. (defun markdown-fontify-inline-links (last)
  6965. "Add text properties to next inline link from point to LAST."
  6966. (when (markdown-match-generic-links last nil)
  6967. (let* ((link-start (match-beginning 3))
  6968. (link-end (match-end 3))
  6969. (url-start (match-beginning 6))
  6970. (url-end (match-end 6))
  6971. (url (match-string-no-properties 6))
  6972. (title-start (match-beginning 7))
  6973. (title-end (match-end 7))
  6974. (title (match-string-no-properties 7))
  6975. ;; Markup part
  6976. (mp (list 'face 'markdown-markup-face
  6977. 'invisible 'markdown-markup
  6978. 'rear-nonsticky t
  6979. 'font-lock-multiline t))
  6980. ;; Link part (without face)
  6981. (lp (list 'keymap markdown-mode-mouse-map
  6982. 'mouse-face 'markdown-highlight-face
  6983. 'font-lock-multiline t
  6984. 'help-echo (if title (concat title "\n" url) url)))
  6985. ;; URL part
  6986. (up (list 'keymap markdown-mode-mouse-map
  6987. 'face 'markdown-url-face
  6988. 'invisible 'markdown-markup
  6989. 'mouse-face 'markdown-highlight-face
  6990. 'font-lock-multiline t))
  6991. ;; URL composition character
  6992. (url-char (markdown--first-displayable markdown-url-compose-char))
  6993. ;; Title part
  6994. (tp (list 'face 'markdown-link-title-face
  6995. 'invisible 'markdown-markup
  6996. 'font-lock-multiline t)))
  6997. (dolist (g '(1 2 4 5 8))
  6998. (when (match-end g)
  6999. (add-text-properties (match-beginning g) (match-end g) mp)))
  7000. ;; Preserve existing faces applied to link part (e.g., inline code)
  7001. (when link-start
  7002. (add-text-properties link-start link-end lp)
  7003. (add-face-text-property link-start link-end
  7004. 'markdown-link-face 'append))
  7005. (when url-start (add-text-properties url-start url-end up))
  7006. (when title-start (add-text-properties url-end title-end tp))
  7007. (when (and markdown-hide-urls url-start)
  7008. (compose-region url-start (or title-end url-end) url-char))
  7009. t)))
  7010. (defun markdown-fontify-reference-links (last)
  7011. "Add text properties to next reference link from point to LAST."
  7012. (when (markdown-match-generic-links last t)
  7013. (let* ((link-start (match-beginning 3))
  7014. (link-end (match-end 3))
  7015. (ref-start (match-beginning 6))
  7016. (ref-end (match-end 6))
  7017. ;; Markup part
  7018. (mp (list 'face 'markdown-markup-face
  7019. 'invisible 'markdown-markup
  7020. 'rear-nonsticky t
  7021. 'font-lock-multiline t))
  7022. ;; Link part
  7023. (lp (list 'keymap markdown-mode-mouse-map
  7024. 'face 'markdown-link-face
  7025. 'mouse-face 'markdown-highlight-face
  7026. 'font-lock-multiline t
  7027. 'help-echo (lambda (_ __ pos)
  7028. (save-match-data
  7029. (save-excursion
  7030. (goto-char pos)
  7031. (or (markdown-link-url)
  7032. "Undefined reference"))))))
  7033. ;; URL composition character
  7034. (url-char (markdown--first-displayable markdown-url-compose-char))
  7035. ;; Reference part
  7036. (rp (list 'face 'markdown-reference-face
  7037. 'invisible 'markdown-markup
  7038. 'font-lock-multiline t)))
  7039. (dolist (g '(1 2 4 5 8))
  7040. (when (match-end g)
  7041. (add-text-properties (match-beginning g) (match-end g) mp)))
  7042. (when link-start (add-text-properties link-start link-end lp))
  7043. (when ref-start (add-text-properties ref-start ref-end rp)
  7044. (when (and markdown-hide-urls (> (- ref-end ref-start) 2))
  7045. (compose-region ref-start ref-end url-char)))
  7046. t)))
  7047. (defun markdown-fontify-angle-uris (last)
  7048. "Add text properties to angle URIs from point to LAST."
  7049. (when (markdown-match-angle-uris last)
  7050. (let* ((url-start (match-beginning 2))
  7051. (url-end (match-end 2))
  7052. ;; Markup part
  7053. (mp (list 'face 'markdown-markup-face
  7054. 'invisible 'markdown-markup
  7055. 'rear-nonsticky t
  7056. 'font-lock-multiline t))
  7057. ;; URI part
  7058. (up (list 'keymap markdown-mode-mouse-map
  7059. 'face 'markdown-plain-url-face
  7060. 'mouse-face 'markdown-highlight-face
  7061. 'font-lock-multiline t)))
  7062. (dolist (g '(1 3))
  7063. (add-text-properties (match-beginning g) (match-end g) mp))
  7064. (add-text-properties url-start url-end up)
  7065. t)))
  7066. (defun markdown-fontify-plain-uris (last)
  7067. "Add text properties to plain URLs from point to LAST."
  7068. (when (markdown-match-plain-uris last)
  7069. (let* ((start (match-beginning 0))
  7070. (end (match-end 0))
  7071. (props (list 'keymap markdown-mode-mouse-map
  7072. 'face 'markdown-plain-url-face
  7073. 'mouse-face 'markdown-highlight-face
  7074. 'rear-nonsticky t
  7075. 'font-lock-multiline t)))
  7076. (add-text-properties start end props)
  7077. t)))
  7078. (defun markdown-toggle-url-hiding (&optional arg)
  7079. "Toggle the display or hiding of URLs.
  7080. With a prefix argument ARG, enable URL hiding if ARG is positive,
  7081. and disable it otherwise."
  7082. (interactive (list (or current-prefix-arg 'toggle)))
  7083. (setq markdown-hide-urls
  7084. (if (eq arg 'toggle)
  7085. (not markdown-hide-urls)
  7086. (> (prefix-numeric-value arg) 0)))
  7087. (if markdown-hide-urls
  7088. (message "markdown-mode URL hiding enabled")
  7089. (message "markdown-mode URL hiding disabled"))
  7090. (markdown-reload-extensions))
  7091. ;;; Wiki Links ================================================================
  7092. (defun markdown-wiki-link-p ()
  7093. "Return non-nil if wiki links are enabled and `point' is at a true wiki link.
  7094. A true wiki link name matches `markdown-regex-wiki-link' but does
  7095. not match the current file name after conversion. This modifies
  7096. the data returned by `match-data'. Note that the potential wiki
  7097. link name must be available via `match-string'."
  7098. (when markdown-enable-wiki-links
  7099. (let ((case-fold-search nil))
  7100. (and (thing-at-point-looking-at markdown-regex-wiki-link)
  7101. (not (markdown-code-block-at-point-p))
  7102. (or (not buffer-file-name)
  7103. (not (string-equal (buffer-file-name)
  7104. (markdown-convert-wiki-link-to-filename
  7105. (markdown-wiki-link-link)))))))))
  7106. (defun markdown-wiki-link-link ()
  7107. "Return the link part of the wiki link using current match data.
  7108. The location of the link component depends on the value of
  7109. `markdown-wiki-link-alias-first'."
  7110. (if markdown-wiki-link-alias-first
  7111. (or (match-string-no-properties 5) (match-string-no-properties 3))
  7112. (match-string-no-properties 3)))
  7113. (defun markdown-wiki-link-alias ()
  7114. "Return the alias or text part of the wiki link using current match data.
  7115. The location of the alias component depends on the value of
  7116. `markdown-wiki-link-alias-first'."
  7117. (if markdown-wiki-link-alias-first
  7118. (match-string-no-properties 3)
  7119. (or (match-string-no-properties 5) (match-string-no-properties 3))))
  7120. (defun markdown-convert-wiki-link-to-filename (name)
  7121. "Generate a filename from the wiki link NAME.
  7122. Spaces in NAME are replaced with `markdown-link-space-sub-char'.
  7123. When in `gfm-mode', follow GitHub's conventions where [[Test Test]]
  7124. and [[test test]] both map to Test-test.ext. Look in the current
  7125. directory first, then in subdirectories if
  7126. `markdown-wiki-link-search-subdirectories' is non-nil, and then
  7127. in parent directories if
  7128. `markdown-wiki-link-search-parent-directories' is non-nil."
  7129. (let* ((basename (replace-regexp-in-string
  7130. "[[:space:]\n]" markdown-link-space-sub-char name))
  7131. (basename (if (derived-mode-p 'gfm-mode)
  7132. (concat (upcase (substring basename 0 1))
  7133. (downcase (substring basename 1 nil)))
  7134. basename))
  7135. directory extension default candidates dir)
  7136. (when buffer-file-name
  7137. (setq directory (file-name-directory buffer-file-name)
  7138. extension (file-name-extension buffer-file-name)))
  7139. (setq default (concat basename
  7140. (when extension (concat "." extension))))
  7141. (cond
  7142. ;; Look in current directory first.
  7143. ((or (null buffer-file-name)
  7144. (file-exists-p default))
  7145. default)
  7146. ;; Possibly search in subdirectories, next.
  7147. ((and markdown-wiki-link-search-subdirectories
  7148. (setq candidates
  7149. (directory-files-recursively
  7150. directory (concat "^" default "$"))))
  7151. (car candidates))
  7152. ;; Possibly search in parent directories as a last resort.
  7153. ((and markdown-wiki-link-search-parent-directories
  7154. (setq dir (locate-dominating-file directory default)))
  7155. (concat dir default))
  7156. ;; If nothing is found, return default in current directory.
  7157. (t default))))
  7158. (defun markdown-follow-wiki-link (name &optional other)
  7159. "Follow the wiki link NAME.
  7160. Convert the name to a file name and call `find-file'. Ensure that
  7161. the new buffer remains in `markdown-mode'. Open the link in another
  7162. window when OTHER is non-nil."
  7163. (let ((filename (markdown-convert-wiki-link-to-filename name))
  7164. (wp (when buffer-file-name
  7165. (file-name-directory buffer-file-name))))
  7166. (if (not wp)
  7167. (user-error "Must be visiting a file")
  7168. (when other (other-window 1))
  7169. (let ((default-directory wp))
  7170. (find-file filename)))
  7171. (unless (derived-mode-p 'markdown-mode)
  7172. (markdown-mode))))
  7173. (defun markdown-follow-wiki-link-at-point (&optional arg)
  7174. "Find Wiki Link at point.
  7175. With prefix argument ARG, open the file in other window.
  7176. See `markdown-wiki-link-p' and `markdown-follow-wiki-link'."
  7177. (interactive "P")
  7178. (if (markdown-wiki-link-p)
  7179. (markdown-follow-wiki-link (markdown-wiki-link-link) arg)
  7180. (user-error "Point is not at a Wiki Link")))
  7181. (defun markdown-highlight-wiki-link (from to face)
  7182. "Highlight the wiki link in the region between FROM and TO using FACE."
  7183. (put-text-property from to 'font-lock-face face))
  7184. (defun markdown-unfontify-region-wiki-links (from to)
  7185. "Remove wiki link faces from the region specified by FROM and TO."
  7186. (interactive "*r")
  7187. (let ((modified (buffer-modified-p)))
  7188. (remove-text-properties from to '(font-lock-face markdown-link-face))
  7189. (remove-text-properties from to '(font-lock-face markdown-missing-link-face))
  7190. ;; remove-text-properties marks the buffer modified in emacs 24.3,
  7191. ;; undo that if it wasn't originally marked modified
  7192. (set-buffer-modified-p modified)))
  7193. (defun markdown-fontify-region-wiki-links (from to)
  7194. "Search region given by FROM and TO for wiki links and fontify them.
  7195. If a wiki link is found check to see if the backing file exists
  7196. and highlight accordingly."
  7197. (goto-char from)
  7198. (save-match-data
  7199. (while (re-search-forward markdown-regex-wiki-link to t)
  7200. (when (not (markdown-code-block-at-point-p))
  7201. (let ((highlight-beginning (match-beginning 1))
  7202. (highlight-end (match-end 1))
  7203. (file-name
  7204. (markdown-convert-wiki-link-to-filename
  7205. (markdown-wiki-link-link))))
  7206. (if (condition-case nil (file-exists-p file-name) (error nil))
  7207. (markdown-highlight-wiki-link
  7208. highlight-beginning highlight-end 'markdown-link-face)
  7209. (markdown-highlight-wiki-link
  7210. highlight-beginning highlight-end 'markdown-missing-link-face)))))))
  7211. (defun markdown-extend-changed-region (from to)
  7212. "Extend region given by FROM and TO so that we can fontify all links.
  7213. The region is extended to the first newline before and the first
  7214. newline after."
  7215. ;; start looking for the first new line before 'from
  7216. (goto-char from)
  7217. (re-search-backward "\n" nil t)
  7218. (let ((new-from (point-min))
  7219. (new-to (point-max)))
  7220. (if (not (= (point) from))
  7221. (setq new-from (point)))
  7222. ;; do the same thing for the first new line after 'to
  7223. (goto-char to)
  7224. (re-search-forward "\n" nil t)
  7225. (if (not (= (point) to))
  7226. (setq new-to (point)))
  7227. (cl-values new-from new-to)))
  7228. (defun markdown-check-change-for-wiki-link (from to)
  7229. "Check region between FROM and TO for wiki links and re-fontify as needed."
  7230. (interactive "*r")
  7231. (let* ((modified (buffer-modified-p))
  7232. (buffer-undo-list t)
  7233. (inhibit-read-only t)
  7234. (inhibit-point-motion-hooks t)
  7235. deactivate-mark
  7236. buffer-file-truename)
  7237. (unwind-protect
  7238. (save-excursion
  7239. (save-match-data
  7240. (save-restriction
  7241. ;; Extend the region to fontify so that it starts
  7242. ;; and ends at safe places.
  7243. (cl-multiple-value-bind (new-from new-to)
  7244. (markdown-extend-changed-region from to)
  7245. (goto-char new-from)
  7246. ;; Only refontify when the range contains text with a
  7247. ;; wiki link face or if the wiki link regexp matches.
  7248. (when (or (markdown-range-property-any
  7249. new-from new-to 'font-lock-face
  7250. '(markdown-link-face markdown-missing-link-face))
  7251. (re-search-forward
  7252. markdown-regex-wiki-link new-to t))
  7253. ;; Unfontify existing fontification (start from scratch)
  7254. (markdown-unfontify-region-wiki-links new-from new-to)
  7255. ;; Now do the fontification.
  7256. (markdown-fontify-region-wiki-links new-from new-to))))))
  7257. (and (not modified)
  7258. (buffer-modified-p)
  7259. (set-buffer-modified-p nil)))))
  7260. (defun markdown-check-change-for-wiki-link-after-change (from to _)
  7261. "Check region between FROM and TO for wiki links and re-fontify as needed.
  7262. Designed to be used with the `after-change-functions' hook."
  7263. (markdown-check-change-for-wiki-link from to))
  7264. (defun markdown-fontify-buffer-wiki-links ()
  7265. "Refontify all wiki links in the buffer."
  7266. (interactive)
  7267. (markdown-check-change-for-wiki-link (point-min) (point-max)))
  7268. (defun markdown-toggle-wiki-links (&optional arg)
  7269. "Toggle support for wiki links.
  7270. With a prefix argument ARG, enable wiki link support if ARG is positive,
  7271. and disable it otherwise."
  7272. (interactive (list (or current-prefix-arg 'toggle)))
  7273. (setq markdown-enable-wiki-links
  7274. (if (eq arg 'toggle)
  7275. (not markdown-enable-wiki-links)
  7276. (> (prefix-numeric-value arg) 0)))
  7277. (if markdown-enable-wiki-links
  7278. (message "markdown-mode wiki link support enabled")
  7279. (message "markdown-mode wiki link support disabled"))
  7280. (markdown-reload-extensions))
  7281. (defun markdown-setup-wiki-link-hooks ()
  7282. "Add or remove hooks for fontifying wiki links.
  7283. These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil."
  7284. ;; Anytime text changes make sure it gets fontified correctly
  7285. (if (and markdown-enable-wiki-links
  7286. markdown-wiki-link-fontify-missing)
  7287. (add-hook 'after-change-functions
  7288. 'markdown-check-change-for-wiki-link-after-change t t)
  7289. (remove-hook 'after-change-functions
  7290. 'markdown-check-change-for-wiki-link-after-change t))
  7291. ;; If we left the buffer there is a really good chance we were
  7292. ;; creating one of the wiki link documents. Make sure we get
  7293. ;; refontified when we come back.
  7294. (if (and markdown-enable-wiki-links
  7295. markdown-wiki-link-fontify-missing)
  7296. (progn
  7297. (add-hook 'window-configuration-change-hook
  7298. 'markdown-fontify-buffer-wiki-links t t)
  7299. (markdown-fontify-buffer-wiki-links))
  7300. (remove-hook 'window-configuration-change-hook
  7301. 'markdown-fontify-buffer-wiki-links t)
  7302. (markdown-unfontify-region-wiki-links (point-min) (point-max))))
  7303. ;;; Following & Doing =========================================================
  7304. (defun markdown-follow-thing-at-point (arg)
  7305. "Follow thing at point if possible, such as a reference link or wiki link.
  7306. Opens inline and reference links in a browser. Opens wiki links
  7307. to other files in the current window, or the another window if
  7308. ARG is non-nil.
  7309. See `markdown-follow-link-at-point' and
  7310. `markdown-follow-wiki-link-at-point'."
  7311. (interactive "P")
  7312. (cond ((markdown-link-p)
  7313. (markdown--browse-url (markdown-link-url)))
  7314. ((markdown-wiki-link-p)
  7315. (markdown-follow-wiki-link-at-point arg))
  7316. (t
  7317. (let* ((values (markdown-link-at-pos (point)))
  7318. (url (nth 3 values)))
  7319. (unless url
  7320. (user-error "Nothing to follow at point"))
  7321. (markdown--browse-url url)))))
  7322. (defun markdown-do ()
  7323. "Do something sensible based on context at point.
  7324. Jumps between reference links and definitions; between footnote
  7325. markers and footnote text."
  7326. (interactive)
  7327. (cond
  7328. ;; Footnote definition
  7329. ((markdown-footnote-text-positions)
  7330. (markdown-footnote-return))
  7331. ;; Footnote marker
  7332. ((markdown-footnote-marker-positions)
  7333. (markdown-footnote-goto-text))
  7334. ;; Reference link
  7335. ((thing-at-point-looking-at markdown-regex-link-reference)
  7336. (markdown-reference-goto-definition))
  7337. ;; Reference definition
  7338. ((thing-at-point-looking-at markdown-regex-reference-definition)
  7339. (markdown-reference-goto-link (match-string-no-properties 2)))
  7340. ;; GFM task list item
  7341. ((markdown-gfm-task-list-item-at-point)
  7342. (markdown-toggle-gfm-checkbox))
  7343. ;; Align table
  7344. ((markdown-table-at-point-p)
  7345. (call-interactively #'markdown-table-align))
  7346. ;; Otherwise
  7347. (t
  7348. (markdown-insert-gfm-checkbox))))
  7349. ;;; Miscellaneous =============================================================
  7350. (defun markdown-compress-whitespace-string (str)
  7351. "Compress whitespace in STR and return result.
  7352. Leading and trailing whitespace is removed. Sequences of multiple
  7353. spaces, tabs, and newlines are replaced with single spaces."
  7354. (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" ""
  7355. (replace-regexp-in-string "[ \t\n]+" " " str)))
  7356. (defun markdown--substitute-command-keys (string)
  7357. "Like `substitute-command-keys' but, but prefers control characters.
  7358. First pass STRING to `substitute-command-keys' and then
  7359. substitute `C-i` for `TAB` and `C-m` for `RET`."
  7360. (replace-regexp-in-string
  7361. "\\<TAB\\>" "C-i"
  7362. (replace-regexp-in-string
  7363. "\\<RET\\>" "C-m" (substitute-command-keys string) t) t))
  7364. (defun markdown-line-number-at-pos (&optional pos)
  7365. "Return (narrowed) buffer line number at position POS.
  7366. If POS is nil, use current buffer location.
  7367. This is an exact copy of `line-number-at-pos' for use in emacs21."
  7368. (let ((opoint (or pos (point))) start)
  7369. (save-excursion
  7370. (goto-char (point-min))
  7371. (setq start (point))
  7372. (goto-char opoint)
  7373. (forward-line 0)
  7374. (1+ (count-lines start (point))))))
  7375. (defun markdown-inside-link-p ()
  7376. "Return t if point is within a link."
  7377. (save-match-data
  7378. (thing-at-point-looking-at (markdown-make-regex-link-generic))))
  7379. (defun markdown-line-is-reference-definition-p ()
  7380. "Return whether the current line is a (non-footnote) reference definition."
  7381. (save-excursion
  7382. (move-beginning-of-line 1)
  7383. (and (looking-at-p markdown-regex-reference-definition)
  7384. (not (looking-at-p "[ \t]*\\[^")))))
  7385. (defun markdown-adaptive-fill-function ()
  7386. "Return prefix for filling paragraph or nil if not determined."
  7387. (cond
  7388. ;; List item inside blockquote
  7389. ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+")
  7390. (replace-regexp-in-string
  7391. "[0-9\\.*+-]" " " (match-string-no-properties 0)))
  7392. ;; Blockquote
  7393. ((looking-at markdown-regex-blockquote)
  7394. (buffer-substring-no-properties (match-beginning 0) (match-end 2)))
  7395. ;; List items
  7396. ((looking-at markdown-regex-list)
  7397. (match-string-no-properties 0))
  7398. ;; Footnote definition
  7399. ((looking-at-p markdown-regex-footnote-definition)
  7400. " ") ; four spaces
  7401. ;; No match
  7402. (t nil)))
  7403. (defun markdown-fill-paragraph (&optional justify)
  7404. "Fill paragraph at or after point.
  7405. This function is like \\[fill-paragraph], but it skips Markdown
  7406. code blocks. If the point is in a code block, or just before one,
  7407. do not fill. Otherwise, call `fill-paragraph' as usual. If
  7408. JUSTIFY is non-nil, justify text as well. Since this function
  7409. handles filling itself, it always returns t so that
  7410. `fill-paragraph' doesn't run."
  7411. (interactive "P")
  7412. (unless (or (markdown-code-block-at-point-p)
  7413. (save-excursion
  7414. (back-to-indentation)
  7415. (skip-syntax-forward "-")
  7416. (markdown-code-block-at-point-p)))
  7417. (let ((fill-prefix (save-excursion
  7418. (goto-char (line-beginning-position))
  7419. (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)")
  7420. (match-string-no-properties 1)))))
  7421. (fill-paragraph justify)))
  7422. t)
  7423. (defun markdown-fill-forward-paragraph (&optional arg)
  7424. "Function used by `fill-paragraph' to move over ARG paragraphs.
  7425. This is a `fill-forward-paragraph-function' for `markdown-mode'.
  7426. It is called with a single argument specifying the number of
  7427. paragraphs to move. Just like `forward-paragraph', it should
  7428. return the number of paragraphs left to move."
  7429. (or arg (setq arg 1))
  7430. (if (> arg 0)
  7431. ;; With positive ARG, move across ARG non-code-block paragraphs,
  7432. ;; one at a time. When passing a code block, don't decrement ARG.
  7433. (while (and (not (eobp))
  7434. (> arg 0)
  7435. (= (forward-paragraph 1) 0)
  7436. (or (markdown-code-block-at-pos (point-at-bol 0))
  7437. (setq arg (1- arg)))))
  7438. ;; Move backward by one paragraph with negative ARG (always -1).
  7439. (let ((start (point)))
  7440. (setq arg (forward-paragraph arg))
  7441. (while (and (not (eobp))
  7442. (progn (move-to-left-margin) (not (eobp)))
  7443. (looking-at-p paragraph-separate))
  7444. (forward-line 1))
  7445. (cond
  7446. ;; Move point past whitespace following list marker.
  7447. ((looking-at markdown-regex-list)
  7448. (goto-char (match-end 0)))
  7449. ;; Move point past whitespace following pipe at beginning of line
  7450. ;; to handle Pandoc line blocks.
  7451. ((looking-at "^|\\s-*")
  7452. (goto-char (match-end 0)))
  7453. ;; Return point if the paragraph passed was a code block.
  7454. ((markdown-code-block-at-pos (point-at-bol 2))
  7455. (goto-char start)))))
  7456. arg)
  7457. (defun markdown--inhibit-electric-quote ()
  7458. "Function added to `electric-quote-inhibit-functions'.
  7459. Return non-nil if the quote has been inserted inside a code block
  7460. or span."
  7461. (let ((pos (1- (point))))
  7462. (or (markdown-inline-code-at-pos pos)
  7463. (markdown-code-block-at-pos pos))))
  7464. ;;; Extension Framework =======================================================
  7465. (defun markdown-reload-extensions ()
  7466. "Check settings, update font-lock keywords and hooks, and re-fontify buffer."
  7467. (interactive)
  7468. (when (derived-mode-p 'markdown-mode)
  7469. ;; Refontify buffer
  7470. (font-lock-flush)
  7471. ;; Add or remove hooks related to extensions
  7472. (markdown-setup-wiki-link-hooks)))
  7473. (defun markdown-handle-local-variables ()
  7474. "Run in `hack-local-variables-hook' to update font lock rules.
  7475. Checks to see if there is actually a markdown-mode file local variable
  7476. before regenerating font-lock rules for extensions."
  7477. (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist)
  7478. (assoc 'markdown-enable-math file-local-variables-alist))
  7479. (when (assoc 'markdown-enable-math file-local-variables-alist)
  7480. (markdown-toggle-math markdown-enable-math))
  7481. (markdown-reload-extensions)))
  7482. ;;; Math Support ==============================================================
  7483. (defconst markdown-mode-font-lock-keywords-math
  7484. (list
  7485. ;; Equation reference (eq:foo)
  7486. '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face)
  7487. (2 markdown-reference-face)
  7488. (3 markdown-markup-face)))
  7489. ;; Equation reference \eqref{foo}
  7490. '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face)
  7491. (2 markdown-reference-face)
  7492. (3 markdown-markup-face))))
  7493. "Font lock keywords to add and remove when toggling math support.")
  7494. (defun markdown-toggle-math (&optional arg)
  7495. "Toggle support for inline and display LaTeX math expressions.
  7496. With a prefix argument ARG, enable math mode if ARG is positive,
  7497. and disable it otherwise. If called from Lisp, enable the mode
  7498. if ARG is omitted or nil."
  7499. (interactive (list (or current-prefix-arg 'toggle)))
  7500. (setq markdown-enable-math
  7501. (if (eq arg 'toggle)
  7502. (not markdown-enable-math)
  7503. (> (prefix-numeric-value arg) 0)))
  7504. (if markdown-enable-math
  7505. (progn
  7506. (font-lock-add-keywords
  7507. 'markdown-mode markdown-mode-font-lock-keywords-math)
  7508. (message "markdown-mode math support enabled"))
  7509. (font-lock-remove-keywords
  7510. 'markdown-mode markdown-mode-font-lock-keywords-math)
  7511. (message "markdown-mode math support disabled"))
  7512. (markdown-reload-extensions))
  7513. ;;; GFM Checkboxes ============================================================
  7514. (define-button-type 'markdown-gfm-checkbox-button
  7515. 'follow-link t
  7516. 'face 'markdown-gfm-checkbox-face
  7517. 'mouse-face 'markdown-highlight-face
  7518. 'action #'markdown-toggle-gfm-checkbox-button)
  7519. (defun markdown-gfm-task-list-item-at-point (&optional bounds)
  7520. "Return non-nil if there is a GFM task list item at the point.
  7521. Optionally, the list item BOUNDS may be given if available, as
  7522. returned by `markdown-cur-list-item-bounds'. When a task list item
  7523. is found, the return value is the same value returned by
  7524. `markdown-cur-list-item-bounds'."
  7525. (unless bounds
  7526. (setq bounds (markdown-cur-list-item-bounds)))
  7527. (> (length (nth 5 bounds)) 0))
  7528. (defun markdown-insert-gfm-checkbox ()
  7529. "Add GFM checkbox at point.
  7530. Returns t if added.
  7531. Returns nil if non-applicable."
  7532. (interactive)
  7533. (let ((bounds (markdown-cur-list-item-bounds)))
  7534. (if bounds
  7535. (unless (cl-sixth bounds)
  7536. (let ((pos (+ (cl-first bounds) (cl-fourth bounds)))
  7537. (markup "[ ] "))
  7538. (if (< pos (point))
  7539. (save-excursion
  7540. (goto-char pos)
  7541. (insert markup))
  7542. (goto-char pos)
  7543. (insert markup))
  7544. (syntax-propertize (+ (cl-second bounds) 4))
  7545. t))
  7546. (unless (save-excursion
  7547. (back-to-indentation)
  7548. (or (markdown-list-item-at-point-p)
  7549. (markdown-heading-at-point)
  7550. (markdown-in-comment-p)
  7551. (markdown-code-block-at-point-p)))
  7552. (let ((pos (save-excursion
  7553. (back-to-indentation)
  7554. (point)))
  7555. (markup (concat (or (save-excursion
  7556. (beginning-of-line 0)
  7557. (cl-fifth (markdown-cur-list-item-bounds)))
  7558. markdown-unordered-list-item-prefix)
  7559. "[ ] ")))
  7560. (if (< pos (point))
  7561. (save-excursion
  7562. (goto-char pos)
  7563. (insert markup))
  7564. (goto-char pos)
  7565. (insert markup))
  7566. (syntax-propertize (point-at-eol))
  7567. t)))))
  7568. (defun markdown-toggle-gfm-checkbox ()
  7569. "Toggle GFM checkbox at point.
  7570. Returns the resulting status as a string, either \"[x]\" or \"[ ]\".
  7571. Returns nil if there is no task list item at the point."
  7572. (interactive)
  7573. (save-match-data
  7574. (save-excursion
  7575. (let ((bounds (markdown-cur-list-item-bounds)))
  7576. (when bounds
  7577. ;; Move to beginning of task list item
  7578. (goto-char (cl-first bounds))
  7579. ;; Advance to column of first non-whitespace after marker
  7580. (forward-char (cl-fourth bounds))
  7581. (cond ((looking-at "\\[ \\]")
  7582. (replace-match
  7583. (if markdown-gfm-uppercase-checkbox "[X]" "[x]")
  7584. nil t)
  7585. (match-string-no-properties 0))
  7586. ((looking-at "\\[[xX]\\]")
  7587. (replace-match "[ ]" nil t)
  7588. (match-string-no-properties 0))))))))
  7589. (defun markdown-toggle-gfm-checkbox-button (button)
  7590. "Toggle GFM checkbox BUTTON on click."
  7591. (save-match-data
  7592. (save-excursion
  7593. (goto-char (button-start button))
  7594. (markdown-toggle-gfm-checkbox))))
  7595. (defun markdown-make-gfm-checkboxes-buttons (start end)
  7596. "Make GFM checkboxes buttons in region between START and END."
  7597. (save-excursion
  7598. (goto-char start)
  7599. (let ((case-fold-search t))
  7600. (save-excursion
  7601. (while (re-search-forward markdown-regex-gfm-checkbox end t)
  7602. (make-button (match-beginning 1) (match-end 1)
  7603. :type 'markdown-gfm-checkbox-button))))))
  7604. ;; Called when any modification is made to buffer text.
  7605. (defun markdown-gfm-checkbox-after-change-function (beg end _)
  7606. "Add to `after-change-functions' to setup GFM checkboxes as buttons.
  7607. BEG and END are the limits of scanned region."
  7608. (save-excursion
  7609. (save-match-data
  7610. ;; Rescan between start of line from `beg' and start of line after `end'.
  7611. (markdown-make-gfm-checkboxes-buttons
  7612. (progn (goto-char beg) (beginning-of-line) (point))
  7613. (progn (goto-char end) (forward-line 1) (point))))))
  7614. (defun markdown-remove-gfm-checkbox-overlays ()
  7615. "Remove all GFM checkbox overlays in buffer."
  7616. (save-excursion
  7617. (save-restriction
  7618. (widen)
  7619. (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face))))
  7620. ;;; Display inline image ======================================================
  7621. (defvar-local markdown-inline-image-overlays nil)
  7622. (defun markdown-remove-inline-images ()
  7623. "Remove inline image overlays from image links in the buffer.
  7624. This can be toggled with `markdown-toggle-inline-images'
  7625. or \\[markdown-toggle-inline-images]."
  7626. (interactive)
  7627. (mapc #'delete-overlay markdown-inline-image-overlays)
  7628. (setq markdown-inline-image-overlays nil))
  7629. (defcustom markdown-display-remote-images nil
  7630. "If non-nil, download and display remote images.
  7631. See also `markdown-inline-image-overlays'.
  7632. Only image URLs specified with a protocol listed in
  7633. `markdown-remote-image-protocols' are displayed."
  7634. :group 'markdown
  7635. :type 'boolean)
  7636. (defcustom markdown-remote-image-protocols '("https")
  7637. "List of protocols to use to download remote images.
  7638. See also `markdown-display-remote-images'."
  7639. :group 'markdown
  7640. :type '(repeat string))
  7641. (defvar markdown--remote-image-cache
  7642. (make-hash-table :test 'equal)
  7643. "A map from URLs to image paths.")
  7644. (defun markdown--get-remote-image (url)
  7645. "Retrieve the image path for a given URL."
  7646. (or (gethash url markdown--remote-image-cache)
  7647. (let ((dl-path (make-temp-file "markdown-mode--image")))
  7648. (require 'url)
  7649. (url-copy-file url dl-path t)
  7650. (puthash url dl-path markdown--remote-image-cache))))
  7651. (defun markdown-display-inline-images ()
  7652. "Add inline image overlays to image links in the buffer.
  7653. This can be toggled with `markdown-toggle-inline-images'
  7654. or \\[markdown-toggle-inline-images]."
  7655. (interactive)
  7656. (unless (display-images-p)
  7657. (error "Cannot show images"))
  7658. (save-excursion
  7659. (save-restriction
  7660. (widen)
  7661. (goto-char (point-min))
  7662. (while (re-search-forward markdown-regex-link-inline nil t)
  7663. (let ((start (match-beginning 0))
  7664. (imagep (match-beginning 1))
  7665. (end (match-end 0))
  7666. (file (match-string-no-properties 6)))
  7667. (when (and imagep
  7668. (not (zerop (length file))))
  7669. (unless (file-exists-p file)
  7670. (let* ((download-file (funcall markdown-translate-filename-function file))
  7671. (valid-url (ignore-errors
  7672. (member (downcase (url-type (url-generic-parse-url download-file)))
  7673. markdown-remote-image-protocols))))
  7674. (if (and markdown-display-remote-images valid-url)
  7675. (setq file (markdown--get-remote-image download-file))
  7676. (when (not valid-url)
  7677. ;; strip query parameter
  7678. (setq file (replace-regexp-in-string "?.+\\'" "" file))))))
  7679. (when (file-exists-p file)
  7680. (let* ((abspath (if (file-name-absolute-p file)
  7681. file
  7682. (concat default-directory file)))
  7683. (image
  7684. (if (and markdown-max-image-size
  7685. (image-type-available-p 'imagemagick))
  7686. (create-image
  7687. abspath 'imagemagick nil
  7688. :max-width (car markdown-max-image-size)
  7689. :max-height (cdr markdown-max-image-size))
  7690. (create-image abspath))))
  7691. (when image
  7692. (let ((ov (make-overlay start end)))
  7693. (overlay-put ov 'display image)
  7694. (overlay-put ov 'face 'default)
  7695. (push ov markdown-inline-image-overlays)))))))))))
  7696. (defun markdown-toggle-inline-images ()
  7697. "Toggle inline image overlays in the buffer."
  7698. (interactive)
  7699. (if markdown-inline-image-overlays
  7700. (markdown-remove-inline-images)
  7701. (markdown-display-inline-images)))
  7702. ;;; GFM Code Block Fontification ==============================================
  7703. (defcustom markdown-fontify-code-blocks-natively nil
  7704. "When non-nil, fontify code in code blocks using the native major mode.
  7705. This only works for fenced code blocks where the language is
  7706. specified where we can automatically determine the appropriate
  7707. mode to use. The language to mode mapping may be customized by
  7708. setting the variable `markdown-code-lang-modes'."
  7709. :group 'markdown
  7710. :type 'boolean
  7711. :safe 'booleanp
  7712. :package-version '(markdown-mode . "2.3"))
  7713. (defcustom markdown-fontify-code-block-default-mode nil
  7714. "Default mode to use to fontify code blocks.
  7715. This mode is used when automatic detection fails, such as for GFM
  7716. code blocks with no language specified."
  7717. :group 'markdown
  7718. :type '(choice function (const :tag "None" nil))
  7719. :package-version '(markdown-mode . "2.4"))
  7720. (defun markdown-toggle-fontify-code-blocks-natively (&optional arg)
  7721. "Toggle the native fontification of code blocks.
  7722. With a prefix argument ARG, enable if ARG is positive,
  7723. and disable otherwise."
  7724. (interactive (list (or current-prefix-arg 'toggle)))
  7725. (setq markdown-fontify-code-blocks-natively
  7726. (if (eq arg 'toggle)
  7727. (not markdown-fontify-code-blocks-natively)
  7728. (> (prefix-numeric-value arg) 0)))
  7729. (if markdown-fontify-code-blocks-natively
  7730. (message "markdown-mode native code block fontification enabled")
  7731. (message "markdown-mode native code block fontification disabled"))
  7732. (markdown-reload-extensions))
  7733. ;; This is based on `org-src-lang-modes' from org-src.el
  7734. (defcustom markdown-code-lang-modes
  7735. '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
  7736. ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
  7737. ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
  7738. ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
  7739. ("bash" . sh-mode))
  7740. "Alist mapping languages to their major mode.
  7741. The key is the language name, the value is the major mode. For
  7742. many languages this is simple, but for language where this is not
  7743. the case, this variable provides a way to simplify things on the
  7744. user side. For example, there is no ocaml-mode in Emacs, but the
  7745. mode to use is `tuareg-mode'."
  7746. :group 'markdown
  7747. :type '(repeat
  7748. (cons
  7749. (string "Language name")
  7750. (symbol "Major mode")))
  7751. :package-version '(markdown-mode . "2.3"))
  7752. (defun markdown-get-lang-mode (lang)
  7753. "Return major mode that should be used for LANG.
  7754. LANG is a string, and the returned major mode is a symbol."
  7755. (cl-find-if
  7756. 'fboundp
  7757. (list (cdr (assoc lang markdown-code-lang-modes))
  7758. (cdr (assoc (downcase lang) markdown-code-lang-modes))
  7759. (intern (concat lang "-mode"))
  7760. (intern (concat (downcase lang) "-mode")))))
  7761. (defun markdown-fontify-code-blocks-generic (matcher last)
  7762. "Add text properties to next code block from point to LAST.
  7763. Use matching function MATCHER."
  7764. (when (funcall matcher last)
  7765. (save-excursion
  7766. (save-match-data
  7767. (let* ((start (match-beginning 0))
  7768. (end (match-end 0))
  7769. ;; Find positions outside opening and closing backquotes.
  7770. (bol-prev (progn (goto-char start)
  7771. (if (bolp) (point-at-bol 0) (point-at-bol))))
  7772. (eol-next (progn (goto-char end)
  7773. (if (bolp) (point-at-bol 2) (point-at-bol 3))))
  7774. lang)
  7775. (if (and markdown-fontify-code-blocks-natively
  7776. (or (setq lang (markdown-code-block-lang))
  7777. markdown-fontify-code-block-default-mode))
  7778. (markdown-fontify-code-block-natively lang start end)
  7779. (add-text-properties start end '(face markdown-pre-face)))
  7780. ;; Set background for block as well as opening and closing lines.
  7781. (font-lock-append-text-property
  7782. bol-prev eol-next 'face 'markdown-code-face)
  7783. ;; Set invisible property for lines before and after, including newline.
  7784. (add-text-properties bol-prev start '(invisible markdown-markup))
  7785. (add-text-properties end eol-next '(invisible markdown-markup)))))
  7786. t))
  7787. (defun markdown-fontify-gfm-code-blocks (last)
  7788. "Add text properties to next GFM code block from point to LAST."
  7789. (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last))
  7790. (defun markdown-fontify-fenced-code-blocks (last)
  7791. "Add text properties to next tilde fenced code block from point to LAST."
  7792. (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last))
  7793. ;; Based on `org-src-font-lock-fontify-block' from org-src.el.
  7794. (defun markdown-fontify-code-block-natively (lang start end)
  7795. "Fontify given GFM or fenced code block.
  7796. This function is called by Emacs for automatic fontification when
  7797. `markdown-fontify-code-blocks-natively' is non-nil. LANG is the
  7798. language used in the block. START and END specify the block
  7799. position."
  7800. (let ((lang-mode (if lang (markdown-get-lang-mode lang)
  7801. markdown-fontify-code-block-default-mode)))
  7802. (when (fboundp lang-mode)
  7803. (let ((string (buffer-substring-no-properties start end))
  7804. (modified (buffer-modified-p))
  7805. (markdown-buffer (current-buffer)) pos next)
  7806. (remove-text-properties start end '(face nil))
  7807. (with-current-buffer
  7808. (get-buffer-create
  7809. (concat " markdown-code-fontification:" (symbol-name lang-mode)))
  7810. ;; Make sure that modification hooks are not inhibited in
  7811. ;; the org-src-fontification buffer in case we're called
  7812. ;; from `jit-lock-function' (Bug#25132).
  7813. (let ((inhibit-modification-hooks nil))
  7814. (delete-region (point-min) (point-max))
  7815. (insert string " ")) ;; so there's a final property change
  7816. (unless (eq major-mode lang-mode) (funcall lang-mode))
  7817. (font-lock-ensure)
  7818. (setq pos (point-min))
  7819. (while (setq next (next-single-property-change pos 'face))
  7820. (let ((val (get-text-property pos 'face)))
  7821. (when val
  7822. (put-text-property
  7823. (+ start (1- pos)) (1- (+ start next)) 'face
  7824. val markdown-buffer)))
  7825. (setq pos next)))
  7826. (add-text-properties
  7827. start end
  7828. '(font-lock-fontified t fontified t font-lock-multiline t))
  7829. (set-buffer-modified-p modified)))))
  7830. (require 'edit-indirect nil t)
  7831. (defvar edit-indirect-guess-mode-function)
  7832. (defvar edit-indirect-after-commit-functions)
  7833. (defun markdown--edit-indirect-after-commit-function (beg end)
  7834. "Corrective logic run on code block content from lines BEG to END.
  7835. Restores code block indentation from BEG to END, and ensures trailing newlines
  7836. at the END of code blocks."
  7837. ;; ensure trailing newlines
  7838. (goto-char end)
  7839. (unless (eq (char-before) ?\n)
  7840. (insert "\n"))
  7841. ;; restore code block indentation
  7842. (goto-char (- beg 1))
  7843. (let ((block-indentation (current-indentation)))
  7844. (when (> block-indentation 0)
  7845. (indent-rigidly beg end block-indentation))))
  7846. (defun markdown-edit-code-block ()
  7847. "Edit Markdown code block in an indirect buffer."
  7848. (interactive)
  7849. (save-excursion
  7850. (if (fboundp 'edit-indirect-region)
  7851. (let* ((bounds (markdown-get-enclosing-fenced-block-construct))
  7852. (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2)))
  7853. (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1))))
  7854. (if (and begin end)
  7855. (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation)))
  7856. (lang (markdown-code-block-lang))
  7857. (mode (or (and lang (markdown-get-lang-mode lang))
  7858. markdown-edit-code-block-default-mode))
  7859. (edit-indirect-guess-mode-function
  7860. (lambda (_parent-buffer _beg _end)
  7861. (funcall mode)))
  7862. (indirect-buf (edit-indirect-region begin end 'display-buffer)))
  7863. (when (> indentation 0) ;; un-indent in edit-indirect buffer
  7864. (with-current-buffer indirect-buf
  7865. (indent-rigidly (point-min) (point-max) (- indentation)))))
  7866. (user-error "Not inside a GFM or tilde fenced code block")))
  7867. (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ")
  7868. (progn (package-refresh-contents)
  7869. (package-install 'edit-indirect)
  7870. (markdown-edit-code-block))))))
  7871. ;;; Table Editing =============================================================
  7872. ;; These functions were originally adapted from `org-table.el'.
  7873. ;; General helper functions
  7874. (defmacro markdown--with-gensyms (symbols &rest body)
  7875. (declare (debug (sexp body)) (indent 1))
  7876. `(let ,(mapcar (lambda (s)
  7877. `(,s (make-symbol (concat "--" (symbol-name ',s)))))
  7878. symbols)
  7879. ,@body))
  7880. (defun markdown--split-string (string &optional separators)
  7881. "Splits STRING into substrings at SEPARATORS.
  7882. SEPARATORS is a regular expression. If nil it defaults to
  7883. `split-string-default-separators'. This version returns no empty
  7884. strings if there are matches at the beginning and end of string."
  7885. (let ((start 0) notfirst list)
  7886. (while (and (string-match
  7887. (or separators split-string-default-separators)
  7888. string
  7889. (if (and notfirst
  7890. (= start (match-beginning 0))
  7891. (< start (length string)))
  7892. (1+ start) start))
  7893. (< (match-beginning 0) (length string)))
  7894. (setq notfirst t)
  7895. (or (eq (match-beginning 0) 0)
  7896. (and (eq (match-beginning 0) (match-end 0))
  7897. (eq (match-beginning 0) start))
  7898. (push (substring string start (match-beginning 0)) list))
  7899. (setq start (match-end 0)))
  7900. (or (eq start (length string))
  7901. (push (substring string start) list))
  7902. (nreverse list)))
  7903. (defun markdown--string-width (s)
  7904. "Return width of string S.
  7905. This version ignores characters with invisibility property
  7906. `markdown-markup'."
  7907. (let (b)
  7908. (when (or (eq t buffer-invisibility-spec)
  7909. (member 'markdown-markup buffer-invisibility-spec))
  7910. (while (setq b (text-property-any
  7911. 0 (length s)
  7912. 'invisible 'markdown-markup s))
  7913. (setq s (concat
  7914. (substring s 0 b)
  7915. (substring s (or (next-single-property-change
  7916. b 'invisible s)
  7917. (length s))))))))
  7918. (string-width s))
  7919. (defun markdown--remove-invisible-markup (s)
  7920. "Remove Markdown markup from string S.
  7921. This version removes characters with invisibility property
  7922. `markdown-markup'."
  7923. (let (b)
  7924. (while (setq b (text-property-any
  7925. 0 (length s)
  7926. 'invisible 'markdown-markup s))
  7927. (setq s (concat
  7928. (substring s 0 b)
  7929. (substring s (or (next-single-property-change
  7930. b 'invisible s)
  7931. (length s)))))))
  7932. s)
  7933. ;; Functions for maintaining tables
  7934. (defvar markdown-table-at-point-p-function nil
  7935. "Function to decide if point is inside a table.
  7936. The indirection serves to differentiate between standard markdown
  7937. tables and gfm tables which are less strict about the markup.")
  7938. (defconst markdown-table-line-regexp "^[ \t]*|"
  7939. "Regexp matching any line inside a table.")
  7940. (defconst markdown-table-hline-regexp "^[ \t]*|[-:]"
  7941. "Regexp matching hline inside a table.")
  7942. (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]"
  7943. "Regexp matching dline inside a table.")
  7944. (defun markdown-table-at-point-p ()
  7945. "Return non-nil when point is inside a table."
  7946. (if (functionp markdown-table-at-point-p-function)
  7947. (funcall markdown-table-at-point-p-function)
  7948. (markdown--table-at-point-p)))
  7949. (defun markdown--table-at-point-p ()
  7950. "Return non-nil when point is inside a table."
  7951. (save-excursion
  7952. (beginning-of-line)
  7953. (and (looking-at-p markdown-table-line-regexp)
  7954. (not (markdown-code-block-at-point-p)))))
  7955. (defconst gfm-table-line-regexp "^.?*|"
  7956. "Regexp matching any line inside a table.")
  7957. (defconst gfm-table-hline-regexp "^-+\\(|-\\)+"
  7958. "Regexp matching hline inside a table.")
  7959. ;; GFM simplified tables syntax is as follows:
  7960. ;; - A header line for the column names, this is any text
  7961. ;; separated by `|'.
  7962. ;; - Followed by a string -|-|- ..., the number of dashes is optional
  7963. ;; but must be higher than 1. The number of separators should match
  7964. ;; the number of columns.
  7965. ;; - Followed by the rows of data, which has the same format as the
  7966. ;; header line.
  7967. ;; Example:
  7968. ;;
  7969. ;; foo | bar
  7970. ;; ------|---------
  7971. ;; bar | baz
  7972. ;; bar | baz
  7973. (defun gfm--table-at-point-p ()
  7974. "Return non-nil when point is inside a gfm-compatible table."
  7975. (or (markdown--table-at-point-p)
  7976. (save-excursion
  7977. (beginning-of-line)
  7978. (when (looking-at-p gfm-table-line-regexp)
  7979. ;; we might be at the first line of the table, check if the
  7980. ;; line below is the hline
  7981. (or (save-excursion
  7982. (forward-line 1)
  7983. (looking-at-p gfm-table-hline-regexp))
  7984. ;; go up to find the header
  7985. (catch 'done
  7986. (while (looking-at-p gfm-table-line-regexp)
  7987. (cond
  7988. ((looking-at-p gfm-table-hline-regexp)
  7989. (throw 'done t))
  7990. ((bobp)
  7991. (throw 'done nil)))
  7992. (forward-line -1))
  7993. nil))))))
  7994. (defun markdown-table-hline-at-point-p ()
  7995. "Return non-nil when point is on a hline in a table.
  7996. This function assumes point is on a table."
  7997. (save-excursion
  7998. (beginning-of-line)
  7999. (looking-at-p markdown-table-hline-regexp)))
  8000. (defun markdown-table-begin ()
  8001. "Find the beginning of the table and return its position.
  8002. This function assumes point is on a table."
  8003. (save-excursion
  8004. (while (and (not (bobp))
  8005. (markdown-table-at-point-p))
  8006. (forward-line -1))
  8007. (unless (or (eobp)
  8008. (markdown-table-at-point-p))
  8009. (forward-line 1))
  8010. (point)))
  8011. (defun markdown-table-end ()
  8012. "Find the end of the table and return its position.
  8013. This function assumes point is on a table."
  8014. (save-excursion
  8015. (while (and (not (eobp))
  8016. (markdown-table-at-point-p))
  8017. (forward-line 1))
  8018. (point)))
  8019. (defun markdown-table-get-dline ()
  8020. "Return index of the table data line at point.
  8021. This function assumes point is on a table."
  8022. (let ((pos (point)) (end (markdown-table-end)) (cnt 0))
  8023. (save-excursion
  8024. (goto-char (markdown-table-begin))
  8025. (while (and (re-search-forward
  8026. markdown-table-dline-regexp end t)
  8027. (setq cnt (1+ cnt))
  8028. (< (point-at-eol) pos))))
  8029. cnt))
  8030. (defun markdown--thing-at-wiki-link (pos)
  8031. (when markdown-enable-wiki-links
  8032. (save-excursion
  8033. (save-match-data
  8034. (goto-char pos)
  8035. (thing-at-point-looking-at markdown-regex-wiki-link)))))
  8036. (defun markdown-table-get-column ()
  8037. "Return table column at point.
  8038. This function assumes point is on a table."
  8039. (let ((pos (point)) (cnt 0))
  8040. (save-excursion
  8041. (beginning-of-line)
  8042. (while (search-forward "|" pos t)
  8043. (unless (markdown--thing-at-wiki-link (match-beginning 0))
  8044. (setq cnt (1+ cnt)))))
  8045. cnt))
  8046. (defun markdown-table-get-cell (&optional n)
  8047. "Return the content of the cell in column N of current row.
  8048. N defaults to column at point. This function assumes point is on
  8049. a table."
  8050. (and n (markdown-table-goto-column n))
  8051. (skip-chars-backward "^|\n") (backward-char 1)
  8052. (if (looking-at "|[^|\r\n]*")
  8053. (let* ((pos (match-beginning 0))
  8054. (val (buffer-substring (1+ pos) (match-end 0))))
  8055. (goto-char (min (point-at-eol) (+ 2 pos)))
  8056. ;; Trim whitespaces
  8057. (setq val (replace-regexp-in-string "\\`[ \t]+" "" val)
  8058. val (replace-regexp-in-string "[ \t]+\\'" "" val)))
  8059. (forward-char 1) ""))
  8060. (defun markdown-table-goto-dline (n)
  8061. "Go to the Nth data line in the table at point.
  8062. Return t when the line exists, nil otherwise. This function
  8063. assumes point is on a table."
  8064. (goto-char (markdown-table-begin))
  8065. (let ((end (markdown-table-end)) (cnt 0))
  8066. (while (and (re-search-forward
  8067. markdown-table-dline-regexp end t)
  8068. (< (setq cnt (1+ cnt)) n)))
  8069. (= cnt n)))
  8070. (defun markdown-table-goto-column (n &optional on-delim)
  8071. "Go to the Nth column in the table line at point.
  8072. With optional argument ON-DELIM, stop with point before the left
  8073. delimiter of the cell. If there are less than N cells, just go
  8074. beyond the last delimiter. This function assumes point is on a
  8075. table."
  8076. (beginning-of-line 1)
  8077. (when (> n 0)
  8078. (while (and (> n 0) (search-forward "|" (point-at-eol) t))
  8079. (unless (markdown--thing-at-wiki-link (match-beginning 0))
  8080. (cl-decf n)))
  8081. (if on-delim
  8082. (backward-char 1)
  8083. (when (looking-at " ") (forward-char 1)))))
  8084. (defmacro markdown-table-save-cell (&rest body)
  8085. "Save cell at point, execute BODY and restore cell.
  8086. This function assumes point is on a table."
  8087. (declare (debug (body)))
  8088. (markdown--with-gensyms (line column)
  8089. `(let ((,line (copy-marker (line-beginning-position)))
  8090. (,column (markdown-table-get-column)))
  8091. (unwind-protect
  8092. (progn ,@body)
  8093. (goto-char ,line)
  8094. (markdown-table-goto-column ,column)
  8095. (set-marker ,line nil)))))
  8096. (defun markdown-table-blank-line (s)
  8097. "Convert a table line S into a line with blank cells."
  8098. (if (string-match "^[ \t]*|-" s)
  8099. (setq s (mapconcat
  8100. (lambda (x) (if (member x '(?| ?+)) "|" " "))
  8101. s ""))
  8102. (with-temp-buffer
  8103. (insert s)
  8104. (goto-char (point-min))
  8105. (when (re-search-forward "|" nil t)
  8106. (let ((cur (point))
  8107. ret)
  8108. (while (re-search-forward "|" nil t)
  8109. (when (and (not (eql (char-before (match-beginning 0)) ?\\))
  8110. (not (markdown--thing-at-wiki-link (match-beginning 0))))
  8111. (push (make-string (- (match-beginning 0) cur) ? ) ret)
  8112. (setq cur (match-end 0))))
  8113. (format "|%s|" (string-join (nreverse ret) "|")))))))
  8114. (defun markdown-table-colfmt (fmtspec)
  8115. "Process column alignment specifier FMTSPEC for tables."
  8116. (when (stringp fmtspec)
  8117. (mapcar (lambda (x)
  8118. (cond ((string-match-p "^:.*:$" x) 'c)
  8119. ((string-match-p "^:" x) 'l)
  8120. ((string-match-p ":$" x) 'r)
  8121. (t 'd)))
  8122. (markdown--split-string fmtspec "\\s-*|\\s-*"))))
  8123. (defun markdown--first-column-p (bar-pos)
  8124. (save-excursion
  8125. (save-match-data
  8126. (goto-char bar-pos)
  8127. (looking-back "^\\s-*" (line-beginning-position)))))
  8128. (defun markdown--table-line-to-columns (line)
  8129. (with-temp-buffer
  8130. (insert line)
  8131. (goto-char (point-min))
  8132. (let ((cur (point))
  8133. ret)
  8134. (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)
  8135. (if (markdown--first-column-p (match-beginning 1))
  8136. (setq cur (match-end 0))
  8137. (cond ((eql (char-before (match-beginning 1)) ?\\)
  8138. ;; keep spaces
  8139. (goto-char (match-end 1)))
  8140. ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing
  8141. (t
  8142. (push (buffer-substring-no-properties cur (match-beginning 0)) ret)
  8143. (setq cur (match-end 0))))))
  8144. (when (< cur (length line))
  8145. (push (buffer-substring-no-properties cur (point-max)) ret))
  8146. (nreverse ret))))
  8147. (defun markdown-table-align ()
  8148. "Align table at point.
  8149. This function assumes point is on a table."
  8150. (interactive)
  8151. (let ((begin (markdown-table-begin))
  8152. (end (copy-marker (markdown-table-end))))
  8153. (markdown-table-save-cell
  8154. (goto-char begin)
  8155. (let* (fmtspec
  8156. ;; Store table indent
  8157. (indent (progn (looking-at "[ \t]*") (match-string 0)))
  8158. ;; Split table in lines and save column format specifier
  8159. (lines (mapcar (lambda (l)
  8160. (if (string-match-p "\\`[ \t]*|[-:]" l)
  8161. (progn (setq fmtspec (or fmtspec l)) nil) l))
  8162. (markdown--split-string (buffer-substring begin end) "\n")))
  8163. ;; Split lines in cells
  8164. (cells (mapcar (lambda (l) (markdown--table-line-to-columns l))
  8165. (remq nil lines)))
  8166. ;; Calculate maximum number of cells in a line
  8167. (maxcells (if cells
  8168. (apply #'max (mapcar #'length cells))
  8169. (user-error "Empty table")))
  8170. ;; Empty cells to fill short lines
  8171. (emptycells (make-list maxcells ""))
  8172. maxwidths)
  8173. ;; Calculate maximum width for each column
  8174. (dotimes (i maxcells)
  8175. (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells)))
  8176. (push (apply #'max 1 (mapcar #'markdown--string-width column))
  8177. maxwidths)))
  8178. (setq maxwidths (nreverse maxwidths))
  8179. ;; Process column format specifier
  8180. (setq fmtspec (markdown-table-colfmt fmtspec))
  8181. ;; Compute formats needed for output of table lines
  8182. (let ((hfmt (concat indent "|"))
  8183. (rfmt (concat indent "|"))
  8184. hfmt1 rfmt1 fmt)
  8185. (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|")))
  8186. (setq fmt (pop fmtspec))
  8187. (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |"))
  8188. ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |"))
  8189. ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |"))
  8190. (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |")))
  8191. (setq rfmt (concat rfmt (format rfmt1 width)))
  8192. (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-)))))
  8193. ;; Replace modified lines only
  8194. (dolist (line lines)
  8195. (let ((line (if line
  8196. (apply #'format rfmt (append (pop cells) emptycells))
  8197. hfmt))
  8198. (previous (buffer-substring (point) (line-end-position))))
  8199. (if (equal previous line)
  8200. (forward-line)
  8201. (insert line "\n")
  8202. (delete-region (point) (line-beginning-position 2))))))
  8203. (set-marker end nil)))))
  8204. (defun markdown-table-insert-row (&optional arg)
  8205. "Insert a new row above the row at point into the table.
  8206. With optional argument ARG, insert below the current row."
  8207. (interactive "P")
  8208. (unless (markdown-table-at-point-p)
  8209. (user-error "Not at a table"))
  8210. (let* ((line (buffer-substring
  8211. (line-beginning-position) (line-end-position)))
  8212. (new (markdown-table-blank-line line)))
  8213. (beginning-of-line (if arg 2 1))
  8214. (unless (bolp) (insert "\n"))
  8215. (insert-before-markers new "\n")
  8216. (beginning-of-line 0)
  8217. (re-search-forward "| ?" (line-end-position) t)))
  8218. (defun markdown-table-delete-row ()
  8219. "Delete row or horizontal line at point from the table."
  8220. (interactive)
  8221. (unless (markdown-table-at-point-p)
  8222. (user-error "Not at a table"))
  8223. (let ((col (current-column)))
  8224. (kill-region (point-at-bol)
  8225. (min (1+ (point-at-eol)) (point-max)))
  8226. (unless (markdown-table-at-point-p) (beginning-of-line 0))
  8227. (move-to-column col)))
  8228. (defun markdown-table-move-row (&optional up)
  8229. "Move table line at point down.
  8230. With optional argument UP, move it up."
  8231. (interactive "P")
  8232. (unless (markdown-table-at-point-p)
  8233. (user-error "Not at a table"))
  8234. (let* ((col (current-column)) (pos (point))
  8235. (tonew (if up 0 2)) txt)
  8236. (beginning-of-line tonew)
  8237. (unless (markdown-table-at-point-p)
  8238. (goto-char pos) (user-error "Cannot move row further"))
  8239. (goto-char pos) (beginning-of-line 1) (setq pos (point))
  8240. (setq txt (buffer-substring (point) (1+ (point-at-eol))))
  8241. (delete-region (point) (1+ (point-at-eol)))
  8242. (beginning-of-line tonew)
  8243. (insert txt) (beginning-of-line 0)
  8244. (move-to-column col)))
  8245. (defun markdown-table-move-row-up ()
  8246. "Move table row at point up."
  8247. (interactive)
  8248. (markdown-table-move-row 'up))
  8249. (defun markdown-table-move-row-down ()
  8250. "Move table row at point down."
  8251. (interactive)
  8252. (markdown-table-move-row nil))
  8253. (defun markdown-table-insert-column ()
  8254. "Insert a new table column."
  8255. (interactive)
  8256. (unless (markdown-table-at-point-p)
  8257. (user-error "Not at a table"))
  8258. (let* ((col (max 1 (markdown-table-get-column)))
  8259. (begin (markdown-table-begin))
  8260. (end (copy-marker (markdown-table-end))))
  8261. (markdown-table-save-cell
  8262. (goto-char begin)
  8263. (while (< (point) end)
  8264. (markdown-table-goto-column col t)
  8265. (if (markdown-table-hline-at-point-p)
  8266. (insert "|---")
  8267. (insert "| "))
  8268. (forward-line)))
  8269. (set-marker end nil)
  8270. (markdown-table-align)))
  8271. (defun markdown-table-delete-column ()
  8272. "Delete column at point from table."
  8273. (interactive)
  8274. (unless (markdown-table-at-point-p)
  8275. (user-error "Not at a table"))
  8276. (let ((col (markdown-table-get-column))
  8277. (begin (markdown-table-begin))
  8278. (end (copy-marker (markdown-table-end))))
  8279. (markdown-table-save-cell
  8280. (goto-char begin)
  8281. (while (< (point) end)
  8282. (markdown-table-goto-column col t)
  8283. (and (looking-at "|[^|\n]+|")
  8284. (replace-match "|"))
  8285. (forward-line)))
  8286. (set-marker end nil)
  8287. (markdown-table-goto-column (max 1 (1- col)))
  8288. (markdown-table-align)))
  8289. (defun markdown-table-move-column (&optional left)
  8290. "Move table column at point to the right.
  8291. With optional argument LEFT, move it to the left."
  8292. (interactive "P")
  8293. (unless (markdown-table-at-point-p)
  8294. (user-error "Not at a table"))
  8295. (let* ((col (markdown-table-get-column))
  8296. (col1 (if left (1- col) col))
  8297. (colpos (if left (1- col) (1+ col)))
  8298. (begin (markdown-table-begin))
  8299. (end (copy-marker (markdown-table-end))))
  8300. (when (and left (= col 1))
  8301. (user-error "Cannot move column further left"))
  8302. (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
  8303. (user-error "Cannot move column further right"))
  8304. (markdown-table-save-cell
  8305. (goto-char begin)
  8306. (while (< (point) end)
  8307. (markdown-table-goto-column col1 t)
  8308. (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
  8309. (replace-match "|\\2|\\1|"))
  8310. (forward-line)))
  8311. (set-marker end nil)
  8312. (markdown-table-goto-column colpos)
  8313. (markdown-table-align)))
  8314. (defun markdown-table-move-column-left ()
  8315. "Move table column at point to the left."
  8316. (interactive)
  8317. (markdown-table-move-column 'left))
  8318. (defun markdown-table-move-column-right ()
  8319. "Move table column at point to the right."
  8320. (interactive)
  8321. (markdown-table-move-column nil))
  8322. (defun markdown-table-next-row ()
  8323. "Go to the next row (same column) in the table.
  8324. Create new table lines if required."
  8325. (interactive)
  8326. (unless (markdown-table-at-point-p)
  8327. (user-error "Not at a table"))
  8328. (if (or (looking-at "[ \t]*$")
  8329. (save-excursion (skip-chars-backward " \t") (bolp)))
  8330. (newline)
  8331. (markdown-table-align)
  8332. (let ((col (markdown-table-get-column)))
  8333. (beginning-of-line 2)
  8334. (if (or (not (markdown-table-at-point-p))
  8335. (markdown-table-hline-at-point-p))
  8336. (progn
  8337. (beginning-of-line 0)
  8338. (markdown-table-insert-row 'below)))
  8339. (markdown-table-goto-column col)
  8340. (skip-chars-backward "^|\n\r")
  8341. (when (looking-at " ") (forward-char 1)))))
  8342. (defun markdown-table-forward-cell ()
  8343. "Go to the next cell in the table.
  8344. Create new table lines if required."
  8345. (interactive)
  8346. (unless (markdown-table-at-point-p)
  8347. (user-error "Not at a table"))
  8348. (markdown-table-align)
  8349. (let ((end (markdown-table-end)))
  8350. (when (markdown-table-hline-at-point-p) (end-of-line 1))
  8351. (condition-case nil
  8352. (progn
  8353. (re-search-forward "\\(?:^\\|[^\\]\\)|" end)
  8354. (when (looking-at "[ \t]*$")
  8355. (re-search-forward "\\(?:^\\|[^\\]:\\)|" end))
  8356. (when (and (looking-at "[-:]")
  8357. (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t))
  8358. (goto-char (match-beginning 1)))
  8359. (if (looking-at "[-:]")
  8360. (progn
  8361. (beginning-of-line 0)
  8362. (markdown-table-insert-row 'below))
  8363. (when (looking-at " ") (forward-char 1))))
  8364. (error (markdown-table-insert-row 'below)))))
  8365. (defun markdown-table-backward-cell ()
  8366. "Go to the previous cell in the table."
  8367. (interactive)
  8368. (unless (markdown-table-at-point-p)
  8369. (user-error "Not at a table"))
  8370. (markdown-table-align)
  8371. (when (markdown-table-hline-at-point-p) (end-of-line 1))
  8372. (condition-case nil
  8373. (progn
  8374. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))
  8375. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
  8376. (error (user-error "Cannot move to previous table cell")))
  8377. (while (looking-at "|\\([-:]\\|[ \t]*$\\)")
  8378. (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)))
  8379. (when (looking-at "| ?") (goto-char (match-end 0))))
  8380. (defun markdown-table-transpose ()
  8381. "Transpose table at point.
  8382. Horizontal separator lines will be eliminated."
  8383. (interactive)
  8384. (unless (markdown-table-at-point-p)
  8385. (user-error "Not at a table"))
  8386. (let* ((table (buffer-substring-no-properties
  8387. (markdown-table-begin) (markdown-table-end)))
  8388. ;; Convert table to Lisp structure
  8389. (table (delq nil
  8390. (mapcar
  8391. (lambda (x)
  8392. (unless (string-match-p
  8393. markdown-table-hline-regexp x)
  8394. (markdown--table-line-to-columns x)))
  8395. (markdown--split-string table "[ \t]*\n[ \t]*"))))
  8396. (dline_old (markdown-table-get-dline))
  8397. (col_old (markdown-table-get-column))
  8398. (contents (mapcar (lambda (_)
  8399. (let ((tp table))
  8400. (mapcar
  8401. (lambda (_)
  8402. (prog1
  8403. (pop (car tp))
  8404. (setq tp (cdr tp))))
  8405. table)))
  8406. (car table))))
  8407. (goto-char (markdown-table-begin))
  8408. (save-excursion
  8409. (re-search-forward "|") (backward-char)
  8410. (delete-region (point) (markdown-table-end))
  8411. (insert (mapconcat
  8412. (lambda(x)
  8413. (concat "| " (mapconcat 'identity x " | " ) " |\n"))
  8414. contents "")))
  8415. (markdown-table-goto-dline col_old)
  8416. (markdown-table-goto-column dline_old))
  8417. (markdown-table-align))
  8418. (defun markdown-table-sort-lines (&optional sorting-type)
  8419. "Sort table lines according to the column at point.
  8420. The position of point indicates the column to be used for
  8421. sorting, and the range of lines is the range between the nearest
  8422. horizontal separator lines, or the entire table of no such lines
  8423. exist. If point is before the first column, user will be prompted
  8424. for the sorting column. If there is an active region, the mark
  8425. specifies the first line and the sorting column, while point
  8426. should be in the last line to be included into the sorting.
  8427. The command then prompts for the sorting type which can be
  8428. alphabetically or numerically. Sorting in reverse order is also
  8429. possible.
  8430. If SORTING-TYPE is specified when this function is called from a
  8431. Lisp program, no prompting will take place. SORTING-TYPE must be
  8432. a character, any of (?a ?A ?n ?N) where the capital letters
  8433. indicate that sorting should be done in reverse order."
  8434. (interactive)
  8435. (unless (markdown-table-at-point-p)
  8436. (user-error "Not at a table"))
  8437. ;; Set sorting type and column used for sorting
  8438. (let ((column (let ((c (markdown-table-get-column)))
  8439. (cond ((> c 0) c)
  8440. ((called-interactively-p 'any)
  8441. (read-number "Use column N for sorting: "))
  8442. (t 1))))
  8443. (sorting-type
  8444. (or sorting-type
  8445. (read-char-exclusive
  8446. "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))
  8447. (save-restriction
  8448. ;; Narrow buffer to appropriate sorting area
  8449. (if (region-active-p)
  8450. (narrow-to-region
  8451. (save-excursion
  8452. (progn
  8453. (goto-char (region-beginning)) (line-beginning-position)))
  8454. (save-excursion
  8455. (progn
  8456. (goto-char (region-end)) (line-end-position))))
  8457. (let ((start (markdown-table-begin))
  8458. (end (markdown-table-end)))
  8459. (narrow-to-region
  8460. (save-excursion
  8461. (if (re-search-backward
  8462. markdown-table-hline-regexp start t)
  8463. (line-beginning-position 2)
  8464. start))
  8465. (if (save-excursion (re-search-forward
  8466. markdown-table-hline-regexp end t))
  8467. (match-beginning 0)
  8468. end))))
  8469. ;; Determine arguments for `sort-subr'
  8470. (let* ((extract-key-from-cell
  8471. (cl-case sorting-type
  8472. ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity)
  8473. ((?n ?N) #'string-to-number)
  8474. (t (user-error "Invalid sorting type: %c" sorting-type))))
  8475. (predicate
  8476. (cl-case sorting-type
  8477. ((?n ?N) #'<)
  8478. ((?a ?A) #'string<))))
  8479. ;; Sort selected area
  8480. (goto-char (point-min))
  8481. (sort-subr (memq sorting-type '(?A ?N))
  8482. (lambda ()
  8483. (forward-line)
  8484. (while (and (not (eobp))
  8485. (not (looking-at
  8486. markdown-table-dline-regexp)))
  8487. (forward-line)))
  8488. #'end-of-line
  8489. (lambda ()
  8490. (funcall extract-key-from-cell
  8491. (markdown-table-get-cell column)))
  8492. nil
  8493. predicate)
  8494. (goto-char (point-min))))))
  8495. (defun markdown-table-convert-region (begin end &optional separator)
  8496. "Convert region from BEGIN to END to table with SEPARATOR.
  8497. If every line contains at least one TAB character, the function
  8498. assumes that the material is tab separated (TSV). If every line
  8499. contains a comma, comma-separated values (CSV) are assumed. If
  8500. not, lines are split at whitespace into cells.
  8501. You can use a prefix argument to force a specific separator:
  8502. \\[universal-argument] once forces CSV, \\[universal-argument]
  8503. twice forces TAB, and \\[universal-argument] three times will
  8504. prompt for a regular expression to match the separator, and a
  8505. numeric argument N indicates that at least N consecutive
  8506. spaces, or alternatively a TAB should be used as the separator."
  8507. (interactive "r\nP")
  8508. (let* ((begin (min begin end)) (end (max begin end)) re)
  8509. (goto-char begin) (beginning-of-line 1)
  8510. (setq begin (point-marker))
  8511. (goto-char end)
  8512. (if (bolp) (backward-char 1) (end-of-line 1))
  8513. (setq end (point-marker))
  8514. (when (equal separator '(64))
  8515. (setq separator (read-regexp "Regexp for cell separator: ")))
  8516. (unless separator
  8517. ;; Get the right cell separator
  8518. (goto-char begin)
  8519. (setq separator
  8520. (cond
  8521. ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
  8522. ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
  8523. (t 1))))
  8524. (goto-char begin)
  8525. (if (equal separator '(4))
  8526. ;; Parse CSV
  8527. (while (< (point) end)
  8528. (cond
  8529. ((looking-at "^") (insert "| "))
  8530. ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
  8531. ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
  8532. (replace-match "\\1") (if (looking-at "\"") (insert "\"")))
  8533. ((looking-at "[^,\n]+") (goto-char (match-end 0)))
  8534. ((looking-at "[ \t]*,") (replace-match " | "))
  8535. (t (beginning-of-line 2))))
  8536. (setq re
  8537. (cond
  8538. ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
  8539. ((equal separator '(16)) "^\\|\t")
  8540. ((integerp separator)
  8541. (if (< separator 1)
  8542. (user-error "Cell separator must contain one or more spaces")
  8543. (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
  8544. ((stringp separator) (format "^ *\\|%s" separator))
  8545. (t (error "Invalid cell separator"))))
  8546. (while (re-search-forward re end t) (replace-match "| " t t)))
  8547. (goto-char begin)
  8548. (markdown-table-align)))
  8549. (defun markdown-insert-table (&optional rows columns align)
  8550. "Insert an empty pipe table.
  8551. Optional arguments ROWS, COLUMNS, and ALIGN specify number of
  8552. rows and columns and the column alignment."
  8553. (interactive)
  8554. (let* ((rows (or rows (string-to-number (read-string "Row size: "))))
  8555. (columns (or columns (string-to-number (read-string "Column size: "))))
  8556. (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): ")))
  8557. (align (cond ((equal align "l") ":--")
  8558. ((equal align "r") "--:")
  8559. ((equal align "c") ":-:")
  8560. (t "---")))
  8561. (pos (point))
  8562. (indent (make-string (current-column) ?\ ))
  8563. (line (concat
  8564. (apply 'concat indent "|"
  8565. (make-list columns " |")) "\n"))
  8566. (hline (apply 'concat indent "|"
  8567. (make-list columns (concat align "|")))))
  8568. (if (string-match
  8569. "^[ \t]*$" (buffer-substring-no-properties
  8570. (point-at-bol) (point)))
  8571. (beginning-of-line 1)
  8572. (newline))
  8573. (dotimes (_ rows) (insert line))
  8574. (goto-char pos)
  8575. (if (> rows 1)
  8576. (progn
  8577. (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos)))
  8578. (markdown-table-forward-cell)))
  8579. ;;; ElDoc Support =============================================================
  8580. (defun markdown-eldoc-function ()
  8581. "Return a helpful string when appropriate based on context.
  8582. * Report URL when point is at a hidden URL.
  8583. * Report language name when point is a code block with hidden markup."
  8584. (cond
  8585. ;; Hidden URL or reference for inline link
  8586. ((and (or (thing-at-point-looking-at markdown-regex-link-inline)
  8587. (thing-at-point-looking-at markdown-regex-link-reference))
  8588. (or markdown-hide-urls markdown-hide-markup))
  8589. (let* ((imagep (string-equal (match-string 1) "!"))
  8590. (edit-keys (markdown--substitute-command-keys
  8591. (if imagep
  8592. "\\[markdown-insert-image]"
  8593. "\\[markdown-insert-link]")))
  8594. (edit-str (propertize edit-keys 'face 'font-lock-constant-face))
  8595. (referencep (string-equal (match-string 5) "["))
  8596. (object (if referencep "reference" "URL")))
  8597. (format "Hidden %s (%s to edit): %s" object edit-str
  8598. (if referencep
  8599. (concat
  8600. (propertize "[" 'face 'markdown-markup-face)
  8601. (propertize (match-string-no-properties 6)
  8602. 'face 'markdown-reference-face)
  8603. (propertize "]" 'face 'markdown-markup-face))
  8604. (propertize (match-string-no-properties 6)
  8605. 'face 'markdown-url-face)))))
  8606. ;; Hidden language name for fenced code blocks
  8607. ((and (markdown-code-block-at-point-p)
  8608. (not (get-text-property (point) 'markdown-pre))
  8609. markdown-hide-markup)
  8610. (let ((lang (save-excursion (markdown-code-block-lang))))
  8611. (unless lang (setq lang "[unspecified]"))
  8612. (format "Hidden code block language: %s (%s to toggle markup)"
  8613. (propertize lang 'face 'markdown-language-keyword-face)
  8614. (markdown--substitute-command-keys
  8615. "\\[markdown-toggle-markup-hiding]"))))))
  8616. ;;; Mode Definition ==========================================================
  8617. (defun markdown-show-version ()
  8618. "Show the version number in the minibuffer."
  8619. (interactive)
  8620. (message "markdown-mode, version %s" markdown-mode-version))
  8621. (defun markdown-mode-info ()
  8622. "Open the `markdown-mode' homepage."
  8623. (interactive)
  8624. (browse-url "https://jblevins.org/projects/markdown-mode/"))
  8625. ;;;###autoload
  8626. (define-derived-mode markdown-mode text-mode "Markdown"
  8627. "Major mode for editing Markdown files."
  8628. ;; Natural Markdown tab width
  8629. (setq tab-width 4)
  8630. ;; Comments
  8631. (setq-local comment-start "<!-- ")
  8632. (setq-local comment-end " -->")
  8633. (setq-local comment-start-skip "<!--[ \t]*")
  8634. (setq-local comment-column 0)
  8635. (setq-local comment-auto-fill-only-comments nil)
  8636. (setq-local comment-use-syntax t)
  8637. ;; Sentence
  8638. (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*")
  8639. ;; Syntax
  8640. (add-hook 'syntax-propertize-extend-region-functions
  8641. #'markdown-syntax-propertize-extend-region)
  8642. (add-hook 'jit-lock-after-change-extend-region-functions
  8643. #'markdown-font-lock-extend-region-function t t)
  8644. (setq-local syntax-propertize-function #'markdown-syntax-propertize)
  8645. (syntax-propertize (point-max)) ;; Propertize before hooks run, etc.
  8646. ;; Font lock.
  8647. (setq font-lock-defaults
  8648. '(markdown-mode-font-lock-keywords
  8649. nil nil nil nil
  8650. (font-lock-multiline . t)
  8651. (font-lock-syntactic-face-function . markdown-syntactic-face)
  8652. (font-lock-extra-managed-props
  8653. . (composition display invisible rear-nonsticky
  8654. keymap help-echo mouse-face))))
  8655. (if markdown-hide-markup
  8656. (add-to-invisibility-spec 'markdown-markup)
  8657. (remove-from-invisibility-spec 'markdown-markup))
  8658. ;; Wiki links
  8659. (markdown-setup-wiki-link-hooks)
  8660. ;; Math mode
  8661. (when markdown-enable-math (markdown-toggle-math t))
  8662. ;; Add a buffer-local hook to reload after file-local variables are read
  8663. (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t)
  8664. ;; For imenu support
  8665. (setq imenu-create-index-function
  8666. (if markdown-nested-imenu-heading-index
  8667. #'markdown-imenu-create-nested-index
  8668. #'markdown-imenu-create-flat-index))
  8669. ;; Defun movement
  8670. (setq-local beginning-of-defun-function #'markdown-beginning-of-defun)
  8671. (setq-local end-of-defun-function #'markdown-end-of-defun)
  8672. ;; Paragraph filling
  8673. (setq-local fill-paragraph-function #'markdown-fill-paragraph)
  8674. (setq-local paragraph-start
  8675. ;; Should match start of lines that start or separate paragraphs
  8676. (mapconcat #'identity
  8677. '(
  8678. "\f" ; starts with a literal line-feed
  8679. "[ \t\f]*$" ; space-only line
  8680. "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
  8681. "[ \t]*[*+-][ \t]+" ; unordered list item
  8682. "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item
  8683. "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def
  8684. "[ \t]*:[ \t]+" ; definition
  8685. "^|" ; table or Pandoc line block
  8686. )
  8687. "\\|"))
  8688. (setq-local paragraph-separate
  8689. ;; Should match lines that separate paragraphs without being
  8690. ;; part of any paragraph:
  8691. (mapconcat #'identity
  8692. '("[ \t\f]*$" ; space-only line
  8693. "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote
  8694. ;; The following is not ideal, but the Fill customization
  8695. ;; options really only handle paragraph-starting prefixes,
  8696. ;; not paragraph-ending suffixes:
  8697. ".* $" ; line ending in two spaces
  8698. "^#+"
  8699. "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def
  8700. "\\|"))
  8701. (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'")
  8702. (setq-local adaptive-fill-regexp "\\s-*")
  8703. (setq-local adaptive-fill-function #'markdown-adaptive-fill-function)
  8704. (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph)
  8705. ;; Outline mode
  8706. (setq-local outline-regexp markdown-regex-header)
  8707. (setq-local outline-level #'markdown-outline-level)
  8708. ;; Cause use of ellipses for invisible text.
  8709. (add-to-invisibility-spec '(outline . t))
  8710. ;; ElDoc support
  8711. (add-function :before-until (local 'eldoc-documentation-function)
  8712. #'markdown-eldoc-function)
  8713. ;; Inhibiting line-breaking:
  8714. ;; Separating out each condition into a separate function so that users can
  8715. ;; override if desired (with remove-hook)
  8716. (add-hook 'fill-nobreak-predicate
  8717. #'markdown-line-is-reference-definition-p nil t)
  8718. (add-hook 'fill-nobreak-predicate
  8719. #'markdown-pipe-at-bol-p nil t)
  8720. ;; Indentation
  8721. (setq-local indent-line-function markdown-indent-function)
  8722. (setq-local indent-region-function #'markdown--indent-region)
  8723. ;; Flyspell
  8724. (setq-local flyspell-generic-check-word-predicate
  8725. #'markdown-flyspell-check-word-p)
  8726. ;; Electric quoting
  8727. (add-hook 'electric-quote-inhibit-functions
  8728. #'markdown--inhibit-electric-quote nil :local)
  8729. ;; Make checkboxes buttons
  8730. (when markdown-make-gfm-checkboxes-buttons
  8731. (markdown-make-gfm-checkboxes-buttons (point-min) (point-max))
  8732. (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t)
  8733. (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t))
  8734. ;; edit-indirect
  8735. (add-hook 'edit-indirect-after-commit-functions
  8736. #'markdown--edit-indirect-after-commit-function
  8737. nil 'local)
  8738. ;; Marginalized headings
  8739. (when markdown-marginalize-headers
  8740. (add-hook 'window-configuration-change-hook
  8741. #'markdown-marginalize-update-current nil t))
  8742. ;; add live preview export hook
  8743. (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t)
  8744. (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t))
  8745. ;;;###autoload
  8746. (add-to-list 'auto-mode-alist
  8747. '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode))
  8748. ;;; GitHub Flavored Markdown Mode ============================================
  8749. (defun gfm--electric-pair-fence-code-block ()
  8750. (when (and electric-pair-mode
  8751. (not markdown-gfm-use-electric-backquote)
  8752. (eql last-command-event ?`)
  8753. (let ((count 0))
  8754. (while (eql (char-before (- (point) count)) ?`)
  8755. (cl-incf count))
  8756. (= count 3))
  8757. (eql (char-after) ?`))
  8758. (save-excursion (insert (make-string 2 ?`)))))
  8759. (defvar gfm-mode-hook nil
  8760. "Hook run when entering GFM mode.")
  8761. ;;;###autoload
  8762. (define-derived-mode gfm-mode markdown-mode "GFM"
  8763. "Major mode for editing GitHub Flavored Markdown files."
  8764. (setq markdown-link-space-sub-char "-")
  8765. (setq markdown-wiki-link-search-subdirectories t)
  8766. (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p)
  8767. (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t)
  8768. (markdown-gfm-parse-buffer-for-languages))
  8769. ;;; Viewing modes =============================================================
  8770. (defcustom markdown-hide-markup-in-view-modes t
  8771. "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'."
  8772. :group 'markdown
  8773. :type 'boolean
  8774. :safe 'booleanp)
  8775. (defvar markdown-view-mode-map
  8776. (let ((map (make-sparse-keymap)))
  8777. (define-key map (kbd "p") #'markdown-outline-previous)
  8778. (define-key map (kbd "n") #'markdown-outline-next)
  8779. (define-key map (kbd "f") #'markdown-outline-next-same-level)
  8780. (define-key map (kbd "b") #'markdown-outline-previous-same-level)
  8781. (define-key map (kbd "u") #'markdown-outline-up)
  8782. (define-key map (kbd "DEL") #'scroll-down-command)
  8783. (define-key map (kbd "SPC") #'scroll-up-command)
  8784. (define-key map (kbd ">") #'end-of-buffer)
  8785. (define-key map (kbd "<") #'beginning-of-buffer)
  8786. (define-key map (kbd "q") #'kill-this-buffer)
  8787. (define-key map (kbd "?") #'describe-mode)
  8788. map)
  8789. "Keymap for `markdown-view-mode'.")
  8790. (defun markdown--filter-visible (beg end &optional delete)
  8791. (let ((result "")
  8792. (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face)))
  8793. (while (< beg end)
  8794. (when (markdown--face-p beg invisible-faces)
  8795. (cl-incf beg)
  8796. (while (and (markdown--face-p beg invisible-faces) (< beg end))
  8797. (cl-incf beg)))
  8798. (let ((next (next-single-char-property-change beg 'invisible)))
  8799. (unless (get-char-property beg 'invisible)
  8800. (setq result (concat result (buffer-substring beg (min end next)))))
  8801. (setq beg next)))
  8802. (prog1 result
  8803. (when delete
  8804. (let ((inhibit-read-only t))
  8805. (delete-region beg end))))))
  8806. ;;;###autoload
  8807. (define-derived-mode markdown-view-mode markdown-mode "Markdown-View"
  8808. "Major mode for viewing Markdown content."
  8809. (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
  8810. (add-to-invisibility-spec 'markdown-markup)
  8811. (setq-local filter-buffer-substring-function #'markdown--filter-visible)
  8812. (read-only-mode 1))
  8813. (defvar gfm-view-mode-map
  8814. markdown-view-mode-map
  8815. "Keymap for `gfm-view-mode'.")
  8816. ;;;###autoload
  8817. (define-derived-mode gfm-view-mode gfm-mode "GFM-View"
  8818. "Major mode for viewing GitHub Flavored Markdown content."
  8819. (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes)
  8820. (setq-local markdown-fontify-code-blocks-natively t)
  8821. (setq-local filter-buffer-substring-function #'markdown--filter-visible)
  8822. (add-to-invisibility-spec 'markdown-markup)
  8823. (read-only-mode 1))
  8824. ;;; Live Preview Mode ========================================================
  8825. ;;;###autoload
  8826. (define-minor-mode markdown-live-preview-mode
  8827. "Toggle native previewing on save for a specific markdown file."
  8828. :lighter " MD-Preview"
  8829. (if markdown-live-preview-mode
  8830. (if (markdown-live-preview-get-filename)
  8831. (markdown-display-buffer-other-window (markdown-live-preview-export))
  8832. (markdown-live-preview-mode -1)
  8833. (user-error "Buffer %s does not visit a file" (current-buffer)))
  8834. (markdown-live-preview-remove)))
  8835. (provide 'markdown-mode)
  8836. ;; Local Variables:
  8837. ;; indent-tabs-mode: nil
  8838. ;; coding: utf-8
  8839. ;; End:
  8840. ;;; markdown-mode.el ends here