diff options
Diffstat (limited to '.emacs.d/lisp')
| -rw-r--r-- | .emacs.d/lisp/markdown-mode.el | 9666 |
1 files changed, 9666 insertions, 0 deletions
diff --git a/.emacs.d/lisp/markdown-mode.el b/.emacs.d/lisp/markdown-mode.el new file mode 100644 index 0000000..a1e37e0 --- /dev/null +++ b/.emacs.d/lisp/markdown-mode.el | |||
| @@ -0,0 +1,9666 @@ | |||
| 1 | ;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2007-2020 Jason R. Blevins and markdown-mode | ||
| 4 | ;; contributors (see the commit log for details). | ||
| 5 | |||
| 6 | ;; Author: Jason R. Blevins <jblevins@xbeta.org> | ||
| 7 | ;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> | ||
| 8 | ;; Created: May 24, 2007 | ||
| 9 | ;; Version: 2.5-dev | ||
| 10 | ;; Package-Requires: ((emacs "25.1")) | ||
| 11 | ;; Keywords: Markdown, GitHub Flavored Markdown, itex | ||
| 12 | ;; URL: https://jblevins.org/projects/markdown-mode/ | ||
| 13 | |||
| 14 | ;; This file is not part of GNU Emacs. | ||
| 15 | |||
| 16 | ;; This program is free software; you can redistribute it and/or modify | ||
| 17 | ;; it under the terms of the GNU General Public License as published by | ||
| 18 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 19 | ;; (at your option) any later version. | ||
| 20 | |||
| 21 | ;; This program is distributed in the hope that it will be useful, | ||
| 22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 24 | ;; GNU General Public License for more details. | ||
| 25 | |||
| 26 | ;; You should have received a copy of the GNU General Public License | ||
| 27 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 28 | |||
| 29 | ;;; Commentary: | ||
| 30 | |||
| 31 | ;; See the README.md file for details. | ||
| 32 | |||
| 33 | |||
| 34 | ;;; Code: | ||
| 35 | |||
| 36 | (require 'easymenu) | ||
| 37 | (require 'outline) | ||
| 38 | (require 'thingatpt) | ||
| 39 | (require 'cl-lib) | ||
| 40 | (require 'url-parse) | ||
| 41 | (require 'button) | ||
| 42 | (require 'color) | ||
| 43 | (require 'rx) | ||
| 44 | (require 'subr-x) | ||
| 45 | |||
| 46 | (defvar jit-lock-start) | ||
| 47 | (defvar jit-lock-end) | ||
| 48 | (defvar flyspell-generic-check-word-predicate) | ||
| 49 | (defvar electric-pair-pairs) | ||
| 50 | |||
| 51 | |||
| 52 | ;;; Constants ================================================================= | ||
| 53 | |||
| 54 | (defconst markdown-mode-version "2.5-dev" | ||
| 55 | "Markdown mode version number.") | ||
| 56 | |||
| 57 | (defconst markdown-output-buffer-name "*markdown-output*" | ||
| 58 | "Name of temporary buffer for markdown command output.") | ||
| 59 | |||
| 60 | |||
| 61 | ;;; Global Variables ========================================================== | ||
| 62 | |||
| 63 | (defvar markdown-reference-label-history nil | ||
| 64 | "History of used reference labels.") | ||
| 65 | |||
| 66 | (defvar markdown-live-preview-mode nil | ||
| 67 | "Sentinel variable for command `markdown-live-preview-mode'.") | ||
| 68 | |||
| 69 | (defvar markdown-gfm-language-history nil | ||
| 70 | "History list of languages used in the current buffer in GFM code blocks.") | ||
| 71 | |||
| 72 | |||
| 73 | ;;; Customizable Variables ==================================================== | ||
| 74 | |||
| 75 | (defvar markdown-mode-hook nil | ||
| 76 | "Hook run when entering Markdown mode.") | ||
| 77 | |||
| 78 | (defvar markdown-before-export-hook nil | ||
| 79 | "Hook run before running Markdown to export XHTML output. | ||
| 80 | The hook may modify the buffer, which will be restored to it's | ||
| 81 | original state after exporting is complete.") | ||
| 82 | |||
| 83 | (defvar markdown-after-export-hook nil | ||
| 84 | "Hook run after XHTML output has been saved. | ||
| 85 | Any changes to the output buffer made by this hook will be saved.") | ||
| 86 | |||
| 87 | (defgroup markdown nil | ||
| 88 | "Major mode for editing text files in Markdown format." | ||
| 89 | :prefix "markdown-" | ||
| 90 | :group 'text | ||
| 91 | :link '(url-link "https://jblevins.org/projects/markdown-mode/")) | ||
| 92 | |||
| 93 | (defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc") | ||
| 94 | when (executable-find cmd) | ||
| 95 | return (file-name-nondirectory it)))) | ||
| 96 | (or command "markdown")) | ||
| 97 | "Command to run markdown." | ||
| 98 | :group 'markdown | ||
| 99 | :type '(choice (string :tag "Shell command") (repeat (string)) function)) | ||
| 100 | |||
| 101 | (defcustom markdown-command-needs-filename nil | ||
| 102 | "Set to non-nil if `markdown-command' does not accept input from stdin. | ||
| 103 | Instead, it will be passed a filename as the final command line | ||
| 104 | option. As a result, you will only be able to run Markdown from | ||
| 105 | buffers which are visiting a file." | ||
| 106 | :group 'markdown | ||
| 107 | :type 'boolean) | ||
| 108 | |||
| 109 | (defcustom markdown-open-command nil | ||
| 110 | "Command used for opening Markdown files directly. | ||
| 111 | For example, a standalone Markdown previewer. This command will | ||
| 112 | be called with a single argument: the filename of the current | ||
| 113 | buffer. It can also be a function, which will be called without | ||
| 114 | arguments." | ||
| 115 | :group 'markdown | ||
| 116 | :type '(choice file function (const :tag "None" nil))) | ||
| 117 | |||
| 118 | (defcustom markdown-open-image-command nil | ||
| 119 | "Command used for opening image files directly at `markdown-follow-link-at-point'." | ||
| 120 | :group 'markdown | ||
| 121 | :type '(choice file function (const :tag "None" nil))) | ||
| 122 | |||
| 123 | (defcustom markdown-hr-strings | ||
| 124 | '("-------------------------------------------------------------------------------" | ||
| 125 | "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" | ||
| 126 | "---------------------------------------" | ||
| 127 | "* * * * * * * * * * * * * * * * * * * *" | ||
| 128 | "---------" | ||
| 129 | "* * * * *") | ||
| 130 | "Strings to use when inserting horizontal rules. | ||
| 131 | The first string in the list will be the default when inserting a | ||
| 132 | horizontal rule. Strings should be listed in decreasing order of | ||
| 133 | prominence (as in headings from level one to six) for use with | ||
| 134 | promotion and demotion functions." | ||
| 135 | :group 'markdown | ||
| 136 | :type '(repeat string)) | ||
| 137 | |||
| 138 | (defcustom markdown-bold-underscore nil | ||
| 139 | "Use two underscores when inserting bold text instead of two asterisks." | ||
| 140 | :group 'markdown | ||
| 141 | :type 'boolean) | ||
| 142 | |||
| 143 | (defcustom markdown-italic-underscore nil | ||
| 144 | "Use underscores when inserting italic text instead of asterisks." | ||
| 145 | :group 'markdown | ||
| 146 | :type 'boolean) | ||
| 147 | |||
| 148 | (defcustom markdown-marginalize-headers nil | ||
| 149 | "When non-nil, put opening atx header markup in a left margin. | ||
| 150 | |||
| 151 | This setting goes well with `markdown-asymmetric-header'. But | ||
| 152 | sadly it conflicts with `linum-mode' since they both use the | ||
| 153 | same margin." | ||
| 154 | :group 'markdown | ||
| 155 | :type 'boolean | ||
| 156 | :safe 'booleanp | ||
| 157 | :package-version '(markdown-mode . "2.4")) | ||
| 158 | |||
| 159 | (defcustom markdown-marginalize-headers-margin-width 6 | ||
| 160 | "Character width of margin used for marginalized headers. | ||
| 161 | The default value is based on there being six heading levels | ||
| 162 | defined by Markdown and HTML. Increasing this produces extra | ||
| 163 | whitespace on the left. Decreasing it may be preferred when | ||
| 164 | fewer than six nested heading levels are used." | ||
| 165 | :group 'markdown | ||
| 166 | :type 'natnump | ||
| 167 | :safe 'natnump | ||
| 168 | :package-version '(markdown-mode . "2.4")) | ||
| 169 | |||
| 170 | (defcustom markdown-asymmetric-header nil | ||
| 171 | "Determines if atx header style will be asymmetric. | ||
| 172 | Set to a non-nil value to use asymmetric header styling, placing | ||
| 173 | header markup only at the beginning of the line. By default, | ||
| 174 | balanced markup will be inserted at the beginning and end of the | ||
| 175 | line around the header title." | ||
| 176 | :group 'markdown | ||
| 177 | :type 'boolean) | ||
| 178 | |||
| 179 | (defcustom markdown-indent-function 'markdown-indent-line | ||
| 180 | "Function to use to indent." | ||
| 181 | :group 'markdown | ||
| 182 | :type 'function) | ||
| 183 | |||
| 184 | (defcustom markdown-indent-on-enter t | ||
| 185 | "Determines indentation behavior when pressing \\[newline]. | ||
| 186 | Possible settings are nil, t, and 'indent-and-new-item. | ||
| 187 | |||
| 188 | When non-nil, pressing \\[newline] will call `newline-and-indent' | ||
| 189 | to indent the following line according to the context using | ||
| 190 | `markdown-indent-function'. In this case, note that | ||
| 191 | \\[electric-newline-and-maybe-indent] can still be used to insert | ||
| 192 | a newline without indentation. | ||
| 193 | |||
| 194 | When set to 'indent-and-new-item and the point is in a list item | ||
| 195 | when \\[newline] is pressed, the list will be continued on the next | ||
| 196 | line, where a new item will be inserted. | ||
| 197 | |||
| 198 | When set to nil, simply call `newline' as usual. In this case, | ||
| 199 | you can still indent lines using \\[markdown-cycle] and continue | ||
| 200 | lists with \\[markdown-insert-list-item]. | ||
| 201 | |||
| 202 | Note that this assumes the variable `electric-indent-mode' is | ||
| 203 | non-nil (enabled). When it is *disabled*, the behavior of | ||
| 204 | \\[newline] and `\\[electric-newline-and-maybe-indent]' are | ||
| 205 | reversed." | ||
| 206 | :group 'markdown | ||
| 207 | :type '(choice (const :tag "Don't automatically indent" nil) | ||
| 208 | (const :tag "Automatically indent" t) | ||
| 209 | (const :tag "Automatically indent and insert new list items" indent-and-new-item))) | ||
| 210 | |||
| 211 | (defcustom markdown-enable-wiki-links nil | ||
| 212 | "Syntax highlighting for wiki links. | ||
| 213 | Set this to a non-nil value to turn on wiki link support by default. | ||
| 214 | Support can be toggled later using the `markdown-toggle-wiki-links' | ||
| 215 | function or \\[markdown-toggle-wiki-links]." | ||
| 216 | :group 'markdown | ||
| 217 | :type 'boolean | ||
| 218 | :safe 'booleanp | ||
| 219 | :package-version '(markdown-mode . "2.2")) | ||
| 220 | |||
| 221 | (defcustom markdown-wiki-link-alias-first t | ||
| 222 | "When non-nil, treat aliased wiki links like [[alias text|PageName]]. | ||
| 223 | Otherwise, they will be treated as [[PageName|alias text]]." | ||
| 224 | :group 'markdown | ||
| 225 | :type 'boolean | ||
| 226 | :safe 'booleanp) | ||
| 227 | |||
| 228 | (defcustom markdown-wiki-link-search-subdirectories nil | ||
| 229 | "When non-nil, search for wiki link targets in subdirectories. | ||
| 230 | This is the default search behavior for GitHub and is | ||
| 231 | automatically set to t in `gfm-mode'." | ||
| 232 | :group 'markdown | ||
| 233 | :type 'boolean | ||
| 234 | :safe 'booleanp | ||
| 235 | :package-version '(markdown-mode . "2.2")) | ||
| 236 | |||
| 237 | (defcustom markdown-wiki-link-search-parent-directories nil | ||
| 238 | "When non-nil, search for wiki link targets in parent directories. | ||
| 239 | This is the default search behavior of Ikiwiki." | ||
| 240 | :group 'markdown | ||
| 241 | :type 'boolean | ||
| 242 | :safe 'booleanp | ||
| 243 | :package-version '(markdown-mode . "2.2")) | ||
| 244 | |||
| 245 | (defcustom markdown-wiki-link-fontify-missing nil | ||
| 246 | "When non-nil, change wiki link face according to existence of target files. | ||
| 247 | This is expensive because it requires checking for the file each time the buffer | ||
| 248 | changes or the user switches windows. It is disabled by default because it may | ||
| 249 | cause lag when typing on slower machines." | ||
| 250 | :group 'markdown | ||
| 251 | :type 'boolean | ||
| 252 | :safe 'booleanp | ||
| 253 | :package-version '(markdown-mode . "2.2")) | ||
| 254 | |||
| 255 | (defcustom markdown-uri-types | ||
| 256 | '("acap" "cid" "data" "dav" "fax" "file" "ftp" | ||
| 257 | "gopher" "http" "https" "imap" "ldap" "mailto" | ||
| 258 | "mid" "message" "modem" "news" "nfs" "nntp" | ||
| 259 | "pop" "prospero" "rtsp" "service" "sip" "tel" | ||
| 260 | "telnet" "tip" "urn" "vemmi" "wais") | ||
| 261 | "Link types for syntax highlighting of URIs." | ||
| 262 | :group 'markdown | ||
| 263 | :type '(repeat (string :tag "URI scheme"))) | ||
| 264 | |||
| 265 | (defcustom markdown-url-compose-char | ||
| 266 | '(?∞ ?… ?⋯ ?# ?★ ?⚓) | ||
| 267 | "Placeholder character for hidden URLs. | ||
| 268 | This may be a single character or a list of characters. In case | ||
| 269 | of a list, the first one that satisfies `char-displayable-p' will | ||
| 270 | be used." | ||
| 271 | :type '(choice | ||
| 272 | (character :tag "Single URL replacement character") | ||
| 273 | (repeat :tag "List of possible URL replacement characters" | ||
| 274 | character)) | ||
| 275 | :package-version '(markdown-mode . "2.3")) | ||
| 276 | |||
| 277 | (defcustom markdown-blockquote-display-char | ||
| 278 | '("▌" "┃" ">") | ||
| 279 | "String to display when hiding blockquote markup. | ||
| 280 | This may be a single string or a list of string. In case of a | ||
| 281 | list, the first one that satisfies `char-displayable-p' will be | ||
| 282 | used." | ||
| 283 | :type 'string | ||
| 284 | :type '(choice | ||
| 285 | (string :tag "Single blockquote display string") | ||
| 286 | (repeat :tag "List of possible blockquote display strings" string)) | ||
| 287 | :package-version '(markdown-mode . "2.3")) | ||
| 288 | |||
| 289 | (defcustom markdown-hr-display-char | ||
| 290 | '(?─ ?━ ?-) | ||
| 291 | "Character for hiding horizontal rule markup. | ||
| 292 | This may be a single character or a list of characters. In case | ||
| 293 | of a list, the first one that satisfies `char-displayable-p' will | ||
| 294 | be used." | ||
| 295 | :group 'markdown | ||
| 296 | :type '(choice | ||
| 297 | (character :tag "Single HR display character") | ||
| 298 | (repeat :tag "List of possible HR display characters" character)) | ||
| 299 | :package-version '(markdown-mode . "2.3")) | ||
| 300 | |||
| 301 | (defcustom markdown-definition-display-char | ||
| 302 | '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) | ||
| 303 | "Character for replacing definition list markup. | ||
| 304 | This may be a single character or a list of characters. In case | ||
| 305 | of a list, the first one that satisfies `char-displayable-p' will | ||
| 306 | be used." | ||
| 307 | :type '(choice | ||
| 308 | (character :tag "Single definition list character") | ||
| 309 | (repeat :tag "List of possible definition list characters" character)) | ||
| 310 | :package-version '(markdown-mode . "2.3")) | ||
| 311 | |||
| 312 | (defcustom markdown-enable-math nil | ||
| 313 | "Syntax highlighting for inline LaTeX and itex expressions. | ||
| 314 | Set this to a non-nil value to turn on math support by default. | ||
| 315 | Math support can be enabled, disabled, or toggled later using | ||
| 316 | `markdown-toggle-math' or \\[markdown-toggle-math]." | ||
| 317 | :group 'markdown | ||
| 318 | :type 'boolean | ||
| 319 | :safe 'booleanp) | ||
| 320 | (make-variable-buffer-local 'markdown-enable-math) | ||
| 321 | |||
| 322 | (defcustom markdown-enable-html t | ||
| 323 | "Enable font-lock support for HTML tags and attributes." | ||
| 324 | :group 'markdown | ||
| 325 | :type 'boolean | ||
| 326 | :safe 'booleanp | ||
| 327 | :package-version '(markdown-mode . "2.4")) | ||
| 328 | |||
| 329 | (defcustom markdown-css-paths nil | ||
| 330 | "List of URLs of CSS files to link to in the output XHTML." | ||
| 331 | :group 'markdown | ||
| 332 | :type '(repeat (string :tag "CSS File Path"))) | ||
| 333 | |||
| 334 | (defcustom markdown-content-type "text/html" | ||
| 335 | "Content type string for the http-equiv header in XHTML output. | ||
| 336 | When set to an empty string, this attribute is omitted. Defaults to | ||
| 337 | `text/html'." | ||
| 338 | :group 'markdown | ||
| 339 | :type 'string) | ||
| 340 | |||
| 341 | (defcustom markdown-coding-system nil | ||
| 342 | "Character set string for the http-equiv header in XHTML output. | ||
| 343 | Defaults to `buffer-file-coding-system' (and falling back to | ||
| 344 | `utf-8' when not available). Common settings are `iso-8859-1' | ||
| 345 | and `iso-latin-1'. Use `list-coding-systems' for more choices." | ||
| 346 | :group 'markdown | ||
| 347 | :type 'coding-system) | ||
| 348 | |||
| 349 | (defcustom markdown-export-kill-buffer t | ||
| 350 | "Kill output buffer after HTML export. | ||
| 351 | When non-nil, kill the HTML output buffer after | ||
| 352 | exporting with `markdown-export'." | ||
| 353 | :group 'markdown | ||
| 354 | :type 'boolean | ||
| 355 | :safe 'booleanp | ||
| 356 | :package-version '(markdown-mode . "2.4")) | ||
| 357 | |||
| 358 | (defcustom markdown-xhtml-header-content "" | ||
| 359 | "Additional content to include in the XHTML <head> block." | ||
| 360 | :group 'markdown | ||
| 361 | :type 'string) | ||
| 362 | |||
| 363 | (defcustom markdown-xhtml-body-preamble "" | ||
| 364 | "Content to include in the XHTML <body> block, before the output." | ||
| 365 | :group 'markdown | ||
| 366 | :type 'string | ||
| 367 | :safe 'stringp | ||
| 368 | :package-version '(markdown-mode . "2.4")) | ||
| 369 | |||
| 370 | (defcustom markdown-xhtml-body-epilogue "" | ||
| 371 | "Content to include in the XHTML <body> block, after the output." | ||
| 372 | :group 'markdown | ||
| 373 | :type 'string | ||
| 374 | :safe 'stringp | ||
| 375 | :package-version '(markdown-mode . "2.4")) | ||
| 376 | |||
| 377 | (defcustom markdown-xhtml-standalone-regexp | ||
| 378 | "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" | ||
| 379 | "Regexp indicating whether `markdown-command' output is standalone XHTML." | ||
| 380 | :group 'markdown | ||
| 381 | :type 'regexp) | ||
| 382 | |||
| 383 | (defcustom markdown-link-space-sub-char "_" | ||
| 384 | "Character to use instead of spaces when mapping wiki links to filenames." | ||
| 385 | :group 'markdown | ||
| 386 | :type 'string) | ||
| 387 | |||
| 388 | (defcustom markdown-reference-location 'header | ||
| 389 | "Position where new reference definitions are inserted in the document." | ||
| 390 | :group 'markdown | ||
| 391 | :type '(choice (const :tag "At the end of the document" end) | ||
| 392 | (const :tag "Immediately after the current block" immediately) | ||
| 393 | (const :tag "At the end of the subtree" subtree) | ||
| 394 | (const :tag "Before next header" header))) | ||
| 395 | |||
| 396 | (defcustom markdown-footnote-location 'end | ||
| 397 | "Position where new footnotes are inserted in the document." | ||
| 398 | :group 'markdown | ||
| 399 | :type '(choice (const :tag "At the end of the document" end) | ||
| 400 | (const :tag "Immediately after the current block" immediately) | ||
| 401 | (const :tag "At the end of the subtree" subtree) | ||
| 402 | (const :tag "Before next header" header))) | ||
| 403 | |||
| 404 | (defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) | ||
| 405 | "Display specification for footnote markers and inline footnotes. | ||
| 406 | By default, footnote text is reduced in size and raised. Set to | ||
| 407 | nil to disable this." | ||
| 408 | :group 'markdown | ||
| 409 | :type '(choice (sexp :tag "Display specification") | ||
| 410 | (const :tag "Don't set display property" nil)) | ||
| 411 | :package-version '(markdown-mode . "2.4")) | ||
| 412 | |||
| 413 | (defcustom markdown-sub-superscript-display | ||
| 414 | '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) | ||
| 415 | "Display specification for subscript and superscripts. | ||
| 416 | The car is used for subscript, the cdr is used for superscripts." | ||
| 417 | :group 'markdown | ||
| 418 | :type '(cons (choice (sexp :tag "Subscript form") | ||
| 419 | (const :tag "No lowering" nil)) | ||
| 420 | (choice (sexp :tag "Superscript form") | ||
| 421 | (const :tag "No raising" nil))) | ||
| 422 | :package-version '(markdown-mode . "2.4")) | ||
| 423 | |||
| 424 | (defcustom markdown-unordered-list-item-prefix " * " | ||
| 425 | "String inserted before unordered list items." | ||
| 426 | :group 'markdown | ||
| 427 | :type 'string) | ||
| 428 | |||
| 429 | (defcustom markdown-nested-imenu-heading-index t | ||
| 430 | "Use nested or flat imenu heading index. | ||
| 431 | A nested index may provide more natural browsing from the menu, | ||
| 432 | but a flat list may allow for faster keyboard navigation via tab | ||
| 433 | completion." | ||
| 434 | :group 'markdown | ||
| 435 | :type 'boolean | ||
| 436 | :safe 'booleanp | ||
| 437 | :package-version '(markdown-mode . "2.2")) | ||
| 438 | |||
| 439 | (defcustom markdown-add-footnotes-to-imenu t | ||
| 440 | "Add footnotes to end of imenu heading index." | ||
| 441 | :group 'markdown | ||
| 442 | :type 'boolean | ||
| 443 | :safe 'booleanp | ||
| 444 | :package-version '(markdown-mode . "2.4")) | ||
| 445 | |||
| 446 | (defcustom markdown-make-gfm-checkboxes-buttons t | ||
| 447 | "When non-nil, make GFM checkboxes into buttons." | ||
| 448 | :group 'markdown | ||
| 449 | :type 'boolean) | ||
| 450 | |||
| 451 | (defcustom markdown-use-pandoc-style-yaml-metadata nil | ||
| 452 | "When non-nil, allow YAML metadata anywhere in the document." | ||
| 453 | :group 'markdown | ||
| 454 | :type 'boolean) | ||
| 455 | |||
| 456 | (defcustom markdown-split-window-direction 'any | ||
| 457 | "Preference for splitting windows for static and live preview. | ||
| 458 | The default value is 'any, which instructs Emacs to use | ||
| 459 | `split-window-sensibly' to automatically choose how to split | ||
| 460 | windows based on the values of `split-width-threshold' and | ||
| 461 | `split-height-threshold' and the available windows. To force | ||
| 462 | vertically split (left and right) windows, set this to 'vertical | ||
| 463 | or 'right. To force horizontally split (top and bottom) windows, | ||
| 464 | set this to 'horizontal or 'below. | ||
| 465 | |||
| 466 | If this value is 'any and `display-buffer-alist' is set then | ||
| 467 | `display-buffer' is used for open buffer function" | ||
| 468 | :group 'markdown | ||
| 469 | :type '(choice (const :tag "Automatic" any) | ||
| 470 | (const :tag "Right (vertical)" right) | ||
| 471 | (const :tag "Below (horizontal)" below)) | ||
| 472 | :package-version '(markdown-mode . "2.2")) | ||
| 473 | |||
| 474 | (defcustom markdown-live-preview-window-function | ||
| 475 | 'markdown-live-preview-window-eww | ||
| 476 | "Function to display preview of Markdown output within Emacs. | ||
| 477 | Function must update the buffer containing the preview and return | ||
| 478 | the buffer." | ||
| 479 | :group 'markdown | ||
| 480 | :type 'function) | ||
| 481 | |||
| 482 | (defcustom markdown-live-preview-delete-export 'delete-on-destroy | ||
| 483 | "Delete exported HTML file when using `markdown-live-preview-export'. | ||
| 484 | If set to 'delete-on-export, delete on every export. When set to | ||
| 485 | 'delete-on-destroy delete when quitting from command | ||
| 486 | `markdown-live-preview-mode'. Never delete if set to nil." | ||
| 487 | :group 'markdown | ||
| 488 | :type '(choice | ||
| 489 | (const :tag "Delete on every export" delete-on-export) | ||
| 490 | (const :tag "Delete when quitting live preview" delete-on-destroy) | ||
| 491 | (const :tag "Never delete" nil))) | ||
| 492 | |||
| 493 | (defcustom markdown-list-indent-width 4 | ||
| 494 | "Depth of indentation for markdown lists. | ||
| 495 | Used in `markdown-demote-list-item' and | ||
| 496 | `markdown-promote-list-item'." | ||
| 497 | :group 'markdown | ||
| 498 | :type 'integer) | ||
| 499 | |||
| 500 | (defcustom markdown-enable-prefix-prompts t | ||
| 501 | "Display prompts for certain prefix commands. | ||
| 502 | Set to nil to disable these prompts." | ||
| 503 | :group 'markdown | ||
| 504 | :type 'boolean | ||
| 505 | :safe 'booleanp | ||
| 506 | :package-version '(markdown-mode . "2.3")) | ||
| 507 | |||
| 508 | (defcustom markdown-gfm-additional-languages nil | ||
| 509 | "Extra languages made available when inserting GFM code blocks. | ||
| 510 | Language strings must have be trimmed of whitespace and not | ||
| 511 | contain any curly braces. They may be of arbitrary | ||
| 512 | capitalization, though." | ||
| 513 | :group 'markdown | ||
| 514 | :type '(repeat (string :validate markdown-validate-language-string))) | ||
| 515 | |||
| 516 | (defcustom markdown-gfm-use-electric-backquote t | ||
| 517 | "Use `markdown-electric-backquote' when backquote is hit three times." | ||
| 518 | :group 'markdown | ||
| 519 | :type 'boolean) | ||
| 520 | |||
| 521 | (defcustom markdown-gfm-downcase-languages t | ||
| 522 | "If non-nil, downcase suggested languages. | ||
| 523 | This applies to insertions done with | ||
| 524 | `markdown-electric-backquote'." | ||
| 525 | :group 'markdown | ||
| 526 | :type 'boolean) | ||
| 527 | |||
| 528 | (defcustom markdown-edit-code-block-default-mode 'normal-mode | ||
| 529 | "Default mode to use for editing code blocks. | ||
| 530 | This mode is used when automatic detection fails, such as for GFM | ||
| 531 | code blocks with no language specified." | ||
| 532 | :group 'markdown | ||
| 533 | :type '(choice function (const :tag "None" nil)) | ||
| 534 | :package-version '(markdown-mode . "2.4")) | ||
| 535 | |||
| 536 | (defcustom markdown-gfm-uppercase-checkbox nil | ||
| 537 | "If non-nil, use [X] for completed checkboxes, [x] otherwise." | ||
| 538 | :group 'markdown | ||
| 539 | :type 'boolean | ||
| 540 | :safe 'booleanp) | ||
| 541 | |||
| 542 | (defcustom markdown-hide-urls nil | ||
| 543 | "Hide URLs of inline links and reference tags of reference links. | ||
| 544 | Such URLs will be replaced by a single customizable | ||
| 545 | character, defined by `markdown-url-compose-char', but are still part | ||
| 546 | of the buffer. Links can be edited interactively with | ||
| 547 | \\[markdown-insert-link] or, for example, by deleting the final | ||
| 548 | parenthesis to remove the invisibility property. You can also | ||
| 549 | hover your mouse pointer over the link text to see the URL. | ||
| 550 | Set this to a non-nil value to turn this feature on by default. | ||
| 551 | You can interactively set the value of this variable by calling | ||
| 552 | `markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], | ||
| 553 | or from the menu Markdown > Links & Images menu." | ||
| 554 | :group 'markdown | ||
| 555 | :type 'boolean | ||
| 556 | :safe 'booleanp | ||
| 557 | :package-version '(markdown-mode . "2.3")) | ||
| 558 | (make-variable-buffer-local 'markdown-hide-urls) | ||
| 559 | |||
| 560 | (defcustom markdown-translate-filename-function #'identity | ||
| 561 | "Function to use to translate filenames when following links. | ||
| 562 | \\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] | ||
| 563 | call this function with the filename as only argument whenever | ||
| 564 | they encounter a filename (instead of a URL) to be visited and | ||
| 565 | use its return value instead of the filename in the link. For | ||
| 566 | example, if absolute filenames are actually relative to a server | ||
| 567 | root directory, you can set | ||
| 568 | `markdown-translate-filename-function' to a function that | ||
| 569 | prepends the root directory to the given filename." | ||
| 570 | :group 'markdown | ||
| 571 | :type 'function | ||
| 572 | :risky t | ||
| 573 | :package-version '(markdown-mode . "2.4")) | ||
| 574 | |||
| 575 | (defcustom markdown-max-image-size nil | ||
| 576 | "Maximum width and height for displayed inline images. | ||
| 577 | This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). | ||
| 578 | When nil, use the actual size. Otherwise, use ImageMagick to | ||
| 579 | resize larger images to be of the given maximum dimensions. This | ||
| 580 | requires Emacs to be built with ImageMagick support." | ||
| 581 | :group 'markdown | ||
| 582 | :package-version '(markdown-mode . "2.4") | ||
| 583 | :type '(choice | ||
| 584 | (const :tag "Use actual image width" nil) | ||
| 585 | (cons (choice (sexp :tag "Maximum width in pixels") | ||
| 586 | (const :tag "No maximum width" nil)) | ||
| 587 | (choice (sexp :tag "Maximum height in pixels") | ||
| 588 | (const :tag "No maximum height" nil))))) | ||
| 589 | |||
| 590 | (defcustom markdown-mouse-follow-link t | ||
| 591 | "Non-nil means mouse on a link will follow the link. | ||
| 592 | This variable must be set before loading markdown-mode." | ||
| 593 | :group 'markdown | ||
| 594 | :type 'bool | ||
| 595 | :safe 'booleanp | ||
| 596 | :package-version '(markdown-mode . "2.5")) | ||
| 597 | |||
| 598 | |||
| 599 | ;;; Markdown-Specific `rx' Macro ============================================== | ||
| 600 | |||
| 601 | ;; Based on python-rx from python.el. | ||
| 602 | (eval-and-compile | ||
| 603 | (defconst markdown-rx-constituents | ||
| 604 | `((newline . ,(rx "\n")) | ||
| 605 | ;; Note: #405 not consider markdown-list-indent-width however this is never used | ||
| 606 | (indent . ,(rx (or (repeat 4 " ") "\t"))) | ||
| 607 | (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end)))) | ||
| 608 | (numeral . ,(rx (and (one-or-more (any "0-9#")) "."))) | ||
| 609 | (bullet . ,(rx (any "*+:-"))) | ||
| 610 | (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".") | ||
| 611 | (any "*+:-")))) | ||
| 612 | (checkbox . ,(rx "[" (any " xX") "]"))) | ||
| 613 | "Markdown-specific sexps for `markdown-rx'") | ||
| 614 | |||
| 615 | (defun markdown-rx-to-string (form &optional no-group) | ||
| 616 | "Markdown mode specialized `rx-to-string' function. | ||
| 617 | This variant supports named Markdown expressions in FORM. | ||
| 618 | NO-GROUP non-nil means don't put shy groups around the result." | ||
| 619 | (let ((rx-constituents (append markdown-rx-constituents rx-constituents))) | ||
| 620 | (rx-to-string form no-group))) | ||
| 621 | |||
| 622 | (defmacro markdown-rx (&rest regexps) | ||
| 623 | "Markdown mode specialized rx macro. | ||
| 624 | This variant of `rx' supports common Markdown named REGEXPS." | ||
| 625 | (cond ((null regexps) | ||
| 626 | (error "No regexp")) | ||
| 627 | ((cdr regexps) | ||
| 628 | (markdown-rx-to-string `(and ,@regexps) t)) | ||
| 629 | (t | ||
| 630 | (markdown-rx-to-string (car regexps) t))))) | ||
| 631 | |||
| 632 | |||
| 633 | ;;; Regular Expressions ======================================================= | ||
| 634 | |||
| 635 | (defconst markdown-regex-comment-start | ||
| 636 | "<!--" | ||
| 637 | "Regular expression matches HTML comment opening.") | ||
| 638 | |||
| 639 | (defconst markdown-regex-comment-end | ||
| 640 | "--[ \t]*>" | ||
| 641 | "Regular expression matches HTML comment closing.") | ||
| 642 | |||
| 643 | (defconst markdown-regex-link-inline | ||
| 644 | "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" | ||
| 645 | "Regular expression for a [text](file) or an image link . | ||
| 646 | Group 1 matches the leading exclamation point (optional). | ||
| 647 | Group 2 matches the opening square bracket. | ||
| 648 | Group 3 matches the text inside the square brackets. | ||
| 649 | Group 4 matches the closing square bracket. | ||
| 650 | Group 5 matches the opening parenthesis. | ||
| 651 | Group 6 matches the URL. | ||
| 652 | Group 7 matches the title (optional). | ||
| 653 | Group 8 matches the closing parenthesis.") | ||
| 654 | |||
| 655 | (defconst markdown-regex-link-reference | ||
| 656 | "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)[ ]?\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" | ||
| 657 | "Regular expression for a reference link [text][id]. | ||
| 658 | Group 1 matches the leading exclamation point (optional). | ||
| 659 | Group 2 matches the opening square bracket for the link text. | ||
| 660 | Group 3 matches the text inside the square brackets. | ||
| 661 | Group 4 matches the closing square bracket for the link text. | ||
| 662 | Group 5 matches the opening square bracket for the reference label. | ||
| 663 | Group 6 matches the reference label. | ||
| 664 | Group 7 matches the closing square bracket for the reference label.") | ||
| 665 | |||
| 666 | (defconst markdown-regex-reference-definition | ||
| 667 | "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" | ||
| 668 | "Regular expression for a reference definition. | ||
| 669 | Group 1 matches the opening square bracket. | ||
| 670 | Group 2 matches the reference label. | ||
| 671 | Group 3 matches the closing square bracket. | ||
| 672 | Group 4 matches the colon. | ||
| 673 | Group 5 matches the URL. | ||
| 674 | Group 6 matches the title attribute (optional).") | ||
| 675 | |||
| 676 | (defconst markdown-regex-footnote | ||
| 677 | "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" | ||
| 678 | "Regular expression for a footnote marker [^fn]. | ||
| 679 | Group 1 matches the opening square bracket and carat. | ||
| 680 | Group 2 matches only the label, without the surrounding markup. | ||
| 681 | Group 3 matches the closing square bracket.") | ||
| 682 | |||
| 683 | (defconst markdown-regex-header | ||
| 684 | "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]*#*\\)\\)$" | ||
| 685 | "Regexp identifying Markdown headings. | ||
| 686 | Group 1 matches the text of a setext heading. | ||
| 687 | Group 2 matches the underline of a level-1 setext heading. | ||
| 688 | Group 3 matches the underline of a level-2 setext heading. | ||
| 689 | Group 4 matches the opening hash marks of an atx heading and whitespace. | ||
| 690 | Group 5 matches the text, without surrounding whitespace, of an atx heading. | ||
| 691 | Group 6 matches the closing whitespace and hash marks of an atx heading.") | ||
| 692 | |||
| 693 | (defconst markdown-regex-header-setext | ||
| 694 | "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" | ||
| 695 | "Regular expression for generic setext-style (underline) headers.") | ||
| 696 | |||
| 697 | (defconst markdown-regex-header-atx | ||
| 698 | "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" | ||
| 699 | "Regular expression for generic atx-style (hash mark) headers.") | ||
| 700 | |||
| 701 | (defconst markdown-regex-hr | ||
| 702 | (rx line-start | ||
| 703 | (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) | ||
| 704 | (and (repeat 3 (and "-" (? " "))) (* (any "- "))) | ||
| 705 | (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) | ||
| 706 | line-end) | ||
| 707 | "Regular expression for matching Markdown horizontal rules.") | ||
| 708 | |||
| 709 | (defconst markdown-regex-code | ||
| 710 | "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" | ||
| 711 | "Regular expression for matching inline code fragments. | ||
| 712 | |||
| 713 | Group 1 matches the entire code fragment including the backquotes. | ||
| 714 | Group 2 matches the opening backquotes. | ||
| 715 | Group 3 matches the code fragment itself, without backquotes. | ||
| 716 | Group 4 matches the closing backquotes. | ||
| 717 | |||
| 718 | The leading, unnumbered group ensures that the leading backquote | ||
| 719 | character is not escaped. | ||
| 720 | The last group, also unnumbered, requires that the character | ||
| 721 | following the code fragment is not a backquote. | ||
| 722 | Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, | ||
| 723 | but not two newlines in a row.") | ||
| 724 | |||
| 725 | (defconst markdown-regex-kbd | ||
| 726 | "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" | ||
| 727 | "Regular expression for matching <kbd> tags. | ||
| 728 | Groups 1 and 3 match the opening and closing tags. | ||
| 729 | Group 2 matches the key sequence.") | ||
| 730 | |||
| 731 | (defconst markdown-regex-gfm-code-block-open | ||
| 732 | "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" | ||
| 733 | "Regular expression matching opening of GFM code blocks. | ||
| 734 | Group 1 matches the opening three backquotes and any following whitespace. | ||
| 735 | Group 2 matches the opening brace (optional) and surrounding whitespace. | ||
| 736 | Group 3 matches the language identifier (optional). | ||
| 737 | Group 4 matches the info string (optional). | ||
| 738 | Group 5 matches the closing brace (optional), whitespace, and newline. | ||
| 739 | Groups need to agree with `markdown-regex-tilde-fence-begin'.") | ||
| 740 | |||
| 741 | (defconst markdown-regex-gfm-code-block-close | ||
| 742 | "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" | ||
| 743 | "Regular expression matching closing of GFM code blocks. | ||
| 744 | Group 1 matches the closing three backquotes. | ||
| 745 | Group 2 matches any whitespace and the final newline.") | ||
| 746 | |||
| 747 | (defconst markdown-regex-pre | ||
| 748 | "^\\( \\|\t\\).*$" | ||
| 749 | "Regular expression for matching preformatted text sections.") | ||
| 750 | |||
| 751 | (defconst markdown-regex-list | ||
| 752 | (markdown-rx line-start | ||
| 753 | ;; 1. Leading whitespace | ||
| 754 | (group (* blank)) | ||
| 755 | ;; 2. List marker: a numeral, bullet, or colon | ||
| 756 | (group list-marker) | ||
| 757 | ;; 3. Trailing whitespace | ||
| 758 | (group (+ blank)) | ||
| 759 | ;; 4. Optional checkbox for GFM task list items | ||
| 760 | (opt (group (and checkbox (* blank))))) | ||
| 761 | "Regular expression for matching list items.") | ||
| 762 | |||
| 763 | (defconst markdown-regex-bold | ||
| 764 | "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" | ||
| 765 | "Regular expression for matching bold text. | ||
| 766 | Group 1 matches the character before the opening asterisk or | ||
| 767 | underscore, if any, ensuring that it is not a backslash escape. | ||
| 768 | Group 2 matches the entire expression, including delimiters. | ||
| 769 | Groups 3 and 5 matches the opening and closing delimiters. | ||
| 770 | Group 4 matches the text inside the delimiters.") | ||
| 771 | |||
| 772 | (defconst markdown-regex-italic | ||
| 773 | "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" | ||
| 774 | "Regular expression for matching italic text. | ||
| 775 | The leading unnumbered matches the character before the opening | ||
| 776 | asterisk or underscore, if any, ensuring that it is not a | ||
| 777 | backslash escape. | ||
| 778 | Group 1 matches the entire expression, including delimiters. | ||
| 779 | Groups 2 and 4 matches the opening and closing delimiters. | ||
| 780 | Group 3 matches the text inside the delimiters.") | ||
| 781 | |||
| 782 | (defconst markdown-regex-strike-through | ||
| 783 | "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" | ||
| 784 | "Regular expression for matching strike-through text. | ||
| 785 | Group 1 matches the character before the opening tilde, if any, | ||
| 786 | ensuring that it is not a backslash escape. | ||
| 787 | Group 2 matches the entire expression, including delimiters. | ||
| 788 | Groups 3 and 5 matches the opening and closing delimiters. | ||
| 789 | Group 4 matches the text inside the delimiters.") | ||
| 790 | |||
| 791 | (defconst markdown-regex-gfm-italic | ||
| 792 | "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" | ||
| 793 | "Regular expression for matching italic text in GitHub Flavored Markdown. | ||
| 794 | Underscores in words are not treated as special. | ||
| 795 | Group 1 matches the entire expression, including delimiters. | ||
| 796 | Groups 2 and 4 matches the opening and closing delimiters. | ||
| 797 | Group 3 matches the text inside the delimiters.") | ||
| 798 | |||
| 799 | (defconst markdown-regex-blockquote | ||
| 800 | "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" | ||
| 801 | "Regular expression for matching blockquote lines. | ||
| 802 | Also accounts for a potential capital letter preceding the angle | ||
| 803 | bracket, for use with Leanpub blocks (asides, warnings, info | ||
| 804 | blocks, etc.). | ||
| 805 | Group 1 matches the leading angle bracket. | ||
| 806 | Group 2 matches the separating whitespace. | ||
| 807 | Group 3 matches the text.") | ||
| 808 | |||
| 809 | (defconst markdown-regex-line-break | ||
| 810 | "[^ \n\t][ \t]*\\( \\)$" | ||
| 811 | "Regular expression for matching line breaks.") | ||
| 812 | |||
| 813 | (defconst markdown-regex-wiki-link | ||
| 814 | "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" | ||
| 815 | "Regular expression for matching wiki links. | ||
| 816 | This matches typical bracketed [[WikiLinks]] as well as 'aliased' | ||
| 817 | wiki links of the form [[PageName|link text]]. | ||
| 818 | The meanings of the first and second components depend | ||
| 819 | on the value of `markdown-wiki-link-alias-first'. | ||
| 820 | |||
| 821 | Group 1 matches the entire link. | ||
| 822 | Group 2 matches the opening square brackets. | ||
| 823 | Group 3 matches the first component of the wiki link. | ||
| 824 | Group 4 matches the pipe separator, when present. | ||
| 825 | Group 5 matches the second component of the wiki link, when present. | ||
| 826 | Group 6 matches the closing square brackets.") | ||
| 827 | |||
| 828 | (defconst markdown-regex-uri | ||
| 829 | (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)") | ||
| 830 | "Regular expression for matching inline URIs.") | ||
| 831 | |||
| 832 | (defconst markdown-regex-angle-uri | ||
| 833 | (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)") | ||
| 834 | "Regular expression for matching inline URIs in angle brackets.") | ||
| 835 | |||
| 836 | (defconst markdown-regex-email | ||
| 837 | "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" | ||
| 838 | "Regular expression for matching inline email addresses.") | ||
| 839 | |||
| 840 | (defsubst markdown-make-regex-link-generic () | ||
| 841 | "Make regular expression for matching any recognized link." | ||
| 842 | (concat "\\(?:" markdown-regex-link-inline | ||
| 843 | (when markdown-enable-wiki-links | ||
| 844 | (concat "\\|" markdown-regex-wiki-link)) | ||
| 845 | "\\|" markdown-regex-link-reference | ||
| 846 | "\\|" markdown-regex-angle-uri "\\)")) | ||
| 847 | |||
| 848 | (defconst markdown-regex-gfm-checkbox | ||
| 849 | " \\(\\[[ xX]\\]\\) " | ||
| 850 | "Regular expression for matching GFM checkboxes. | ||
| 851 | Group 1 matches the text to become a button.") | ||
| 852 | |||
| 853 | (defconst markdown-regex-blank-line | ||
| 854 | "^[[:blank:]]*$" | ||
| 855 | "Regular expression that matches a blank line.") | ||
| 856 | |||
| 857 | (defconst markdown-regex-block-separator | ||
| 858 | "\n[\n\t\f ]*\n" | ||
| 859 | "Regular expression for matching block boundaries.") | ||
| 860 | |||
| 861 | (defconst markdown-regex-block-separator-noindent | ||
| 862 | (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") | ||
| 863 | "Regexp for block separators before lines with no indentation.") | ||
| 864 | |||
| 865 | (defconst markdown-regex-math-inline-single | ||
| 866 | "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" | ||
| 867 | "Regular expression for itex $..$ math mode expressions. | ||
| 868 | Groups 1 and 3 match the opening and closing dollar signs. | ||
| 869 | Group 2 matches the mathematical expression contained within.") | ||
| 870 | |||
| 871 | (defconst markdown-regex-math-inline-double | ||
| 872 | "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" | ||
| 873 | "Regular expression for itex $$..$$ math mode expressions. | ||
| 874 | Groups 1 and 3 match opening and closing dollar signs. | ||
| 875 | Group 2 matches the mathematical expression contained within.") | ||
| 876 | |||
| 877 | (defconst markdown-regex-math-display | ||
| 878 | (rx line-start (* blank) | ||
| 879 | (group (group (repeat 1 2 "\\")) "[") | ||
| 880 | (group (*? anything)) | ||
| 881 | (group (backref 2) "]") | ||
| 882 | line-end) | ||
| 883 | "Regular expression for \[..\] or \\[..\\] display math. | ||
| 884 | Groups 1 and 4 match the opening and closing markup. | ||
| 885 | Group 3 matches the mathematical expression contained within. | ||
| 886 | Group 2 matches the opening slashes, and is used internally to | ||
| 887 | match the closing slashes.") | ||
| 888 | |||
| 889 | (defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) | ||
| 890 | "Return regexp matching a tilde code fence at least NUM-TILDES long. | ||
| 891 | END-OF-LINE is the regexp construct to indicate end of line; $ if | ||
| 892 | missing." | ||
| 893 | (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" | ||
| 894 | (or end-of-line "$"))) | ||
| 895 | |||
| 896 | (defconst markdown-regex-tilde-fence-begin | ||
| 897 | (markdown-make-tilde-fence-regex | ||
| 898 | 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") | ||
| 899 | "Regular expression for matching tilde-fenced code blocks. | ||
| 900 | Group 1 matches the opening tildes. | ||
| 901 | Group 2 matches (optional) opening brace and surrounding whitespace. | ||
| 902 | Group 3 matches the language identifier (optional). | ||
| 903 | Group 4 matches the info string (optional). | ||
| 904 | Group 5 matches the closing brace (optional) and any surrounding whitespace. | ||
| 905 | Groups need to agree with `markdown-regex-gfm-code-block-open'.") | ||
| 906 | |||
| 907 | (defconst markdown-regex-declarative-metadata | ||
| 908 | "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" | ||
| 909 | "Regular expression for matching declarative metadata statements. | ||
| 910 | This matches MultiMarkdown metadata as well as YAML and TOML | ||
| 911 | assignments such as the following: | ||
| 912 | |||
| 913 | variable: value | ||
| 914 | |||
| 915 | or | ||
| 916 | |||
| 917 | variable = value") | ||
| 918 | |||
| 919 | (defconst markdown-regex-pandoc-metadata | ||
| 920 | "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" | ||
| 921 | "Regular expression for matching Pandoc metadata.") | ||
| 922 | |||
| 923 | (defconst markdown-regex-yaml-metadata-border | ||
| 924 | "\\(-\\{3\\}\\)$" | ||
| 925 | "Regular expression for matching YAML metadata.") | ||
| 926 | |||
| 927 | (defconst markdown-regex-yaml-pandoc-metadata-end-border | ||
| 928 | "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" | ||
| 929 | "Regular expression for matching YAML metadata end borders.") | ||
| 930 | |||
| 931 | (defsubst markdown-get-yaml-metadata-start-border () | ||
| 932 | "Return YAML metadata start border depending upon whether Pandoc is used." | ||
| 933 | (concat | ||
| 934 | (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") | ||
| 935 | markdown-regex-yaml-metadata-border)) | ||
| 936 | |||
| 937 | (defsubst markdown-get-yaml-metadata-end-border (_) | ||
| 938 | "Return YAML metadata end border depending upon whether Pandoc is used." | ||
| 939 | (if markdown-use-pandoc-style-yaml-metadata | ||
| 940 | markdown-regex-yaml-pandoc-metadata-end-border | ||
| 941 | markdown-regex-yaml-metadata-border)) | ||
| 942 | |||
| 943 | (defconst markdown-regex-inline-attributes | ||
| 944 | "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" | ||
| 945 | "Regular expression for matching inline identifiers or attribute lists. | ||
| 946 | Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") | ||
| 947 | |||
| 948 | (defconst markdown-regex-leanpub-sections | ||
| 949 | (concat | ||
| 950 | "^\\({\\)\\(" | ||
| 951 | (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) | ||
| 952 | "\\)\\(}\\)[ \t]*\n") | ||
| 953 | "Regular expression for Leanpub section markers and related syntax.") | ||
| 954 | |||
| 955 | (defconst markdown-regex-sub-superscript | ||
| 956 | "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[[:alnum:]]+\\)\\(?4:\\2\\)\\)" | ||
| 957 | "The regular expression matching a sub- or superscript. | ||
| 958 | The leading un-numbered group matches the character before the | ||
| 959 | opening tilde or carat, if any, ensuring that it is not a | ||
| 960 | backslash escape, carat, or tilde. | ||
| 961 | Group 1 matches the entire expression, including markup. | ||
| 962 | Group 2 matches the opening markup--a tilde or carat. | ||
| 963 | Group 3 matches the text inside the delimiters. | ||
| 964 | Group 4 matches the closing markup--a tilde or carat.") | ||
| 965 | |||
| 966 | (defconst markdown-regex-include | ||
| 967 | "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" | ||
| 968 | "Regular expression matching common forms of include syntax. | ||
| 969 | Marked 2, Leanpub, and other processors support some of these forms: | ||
| 970 | |||
| 971 | <<[sections/section1.md] | ||
| 972 | <<(folder/filename) | ||
| 973 | <<[Code title](folder/filename) | ||
| 974 | <<{folder/raw_file.html} | ||
| 975 | |||
| 976 | Group 1 matches the opening two angle brackets. | ||
| 977 | Groups 2-4 match the opening square bracket, the text inside, | ||
| 978 | and the closing square bracket, respectively. | ||
| 979 | Groups 5-7 match the opening parenthesis, the text inside, and | ||
| 980 | the closing parenthesis. | ||
| 981 | Groups 8-10 match the opening brace, the text inside, and the brace.") | ||
| 982 | |||
| 983 | (defconst markdown-regex-pandoc-inline-footnote | ||
| 984 | "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" | ||
| 985 | "Regular expression for Pandoc inline footnote^[footnote text]. | ||
| 986 | Group 1 matches the opening caret. | ||
| 987 | Group 2 matches the opening square bracket. | ||
| 988 | Group 3 matches the footnote text, without the surrounding markup. | ||
| 989 | Group 4 matches the closing square bracket.") | ||
| 990 | |||
| 991 | (defconst markdown-regex-html-attr | ||
| 992 | "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" | ||
| 993 | "Regular expression for matching HTML attributes and values. | ||
| 994 | Group 1 matches the attribute name. | ||
| 995 | Group 2 matches the following whitespace, equals sign, and value, if any. | ||
| 996 | Group 3 matches the equals sign, if any. | ||
| 997 | Group 4 matches single-, double-, or un-quoted attribute values.") | ||
| 998 | |||
| 999 | (defconst markdown-regex-html-tag | ||
| 1000 | (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr | ||
| 1001 | "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") | ||
| 1002 | "Regular expression for matching HTML tags. | ||
| 1003 | Groups 1 and 9 match the beginning and ending angle brackets and slashes. | ||
| 1004 | Group 2 matches the tag name. | ||
| 1005 | Group 3 matches all attributes and whitespace following the tag name.") | ||
| 1006 | |||
| 1007 | (defconst markdown-regex-html-entity | ||
| 1008 | "\\(&#?[[:alnum:]]+;\\)" | ||
| 1009 | "Regular expression for matching HTML entities.") | ||
| 1010 | |||
| 1011 | |||
| 1012 | ;;; Syntax ==================================================================== | ||
| 1013 | |||
| 1014 | (defvar markdown--syntax-properties | ||
| 1015 | (list 'markdown-tilde-fence-begin nil | ||
| 1016 | 'markdown-tilde-fence-end nil | ||
| 1017 | 'markdown-fenced-code nil | ||
| 1018 | 'markdown-yaml-metadata-begin nil | ||
| 1019 | 'markdown-yaml-metadata-end nil | ||
| 1020 | 'markdown-yaml-metadata-section nil | ||
| 1021 | 'markdown-gfm-block-begin nil | ||
| 1022 | 'markdown-gfm-block-end nil | ||
| 1023 | 'markdown-gfm-code nil | ||
| 1024 | 'markdown-list-item nil | ||
| 1025 | 'markdown-pre nil | ||
| 1026 | 'markdown-blockquote nil | ||
| 1027 | 'markdown-hr nil | ||
| 1028 | 'markdown-comment nil | ||
| 1029 | 'markdown-heading nil | ||
| 1030 | 'markdown-heading-1-setext nil | ||
| 1031 | 'markdown-heading-2-setext nil | ||
| 1032 | 'markdown-heading-1-atx nil | ||
| 1033 | 'markdown-heading-2-atx nil | ||
| 1034 | 'markdown-heading-3-atx nil | ||
| 1035 | 'markdown-heading-4-atx nil | ||
| 1036 | 'markdown-heading-5-atx nil | ||
| 1037 | 'markdown-heading-6-atx nil | ||
| 1038 | 'markdown-metadata-key nil | ||
| 1039 | 'markdown-metadata-value nil | ||
| 1040 | 'markdown-metadata-markup nil) | ||
| 1041 | "Property list of all Markdown syntactic properties.") | ||
| 1042 | |||
| 1043 | (defsubst markdown-in-comment-p (&optional pos) | ||
| 1044 | "Return non-nil if POS is in a comment. | ||
| 1045 | If POS is not given, use point instead." | ||
| 1046 | (get-text-property (or pos (point)) 'markdown-comment)) | ||
| 1047 | |||
| 1048 | (defun markdown--face-p (pos faces) | ||
| 1049 | "Return non-nil if face of POS contain FACES." | ||
| 1050 | (let ((face-prop (get-text-property pos 'face))) | ||
| 1051 | (if (listp face-prop) | ||
| 1052 | (cl-loop for face in face-prop | ||
| 1053 | thereis (memq face faces)) | ||
| 1054 | (memq face-prop faces)))) | ||
| 1055 | |||
| 1056 | (defun markdown-syntax-propertize-extend-region (start end) | ||
| 1057 | "Extend START to END region to include an entire block of text. | ||
| 1058 | This helps improve syntax analysis for block constructs. | ||
| 1059 | Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. | ||
| 1060 | Function is called repeatedly until it returns nil. For details, see | ||
| 1061 | `syntax-propertize-extend-region-functions'." | ||
| 1062 | (save-match-data | ||
| 1063 | (save-excursion | ||
| 1064 | (let* ((new-start (progn (goto-char start) | ||
| 1065 | (skip-chars-forward "\n") | ||
| 1066 | (if (re-search-backward "\n\n" nil t) | ||
| 1067 | (min start (match-end 0)) | ||
| 1068 | (point-min)))) | ||
| 1069 | (new-end (progn (goto-char end) | ||
| 1070 | (skip-chars-backward "\n") | ||
| 1071 | (if (re-search-forward "\n\n" nil t) | ||
| 1072 | (max end (match-beginning 0)) | ||
| 1073 | (point-max)))) | ||
| 1074 | (code-match (markdown-code-block-at-pos new-start)) | ||
| 1075 | (new-start (or (and code-match (cl-first code-match)) new-start)) | ||
| 1076 | (code-match (and (< end (point-max)) (markdown-code-block-at-pos end))) | ||
| 1077 | (new-end (or (and code-match (cl-second code-match)) new-end))) | ||
| 1078 | (unless (and (eq new-start start) (eq new-end end)) | ||
| 1079 | (cons new-start (min new-end (point-max)))))))) | ||
| 1080 | |||
| 1081 | (defun markdown-font-lock-extend-region-function (start end _) | ||
| 1082 | "Used in `jit-lock-after-change-extend-region-functions'. | ||
| 1083 | Delegates to `markdown-syntax-propertize-extend-region'. START | ||
| 1084 | and END are the previous region to refontify." | ||
| 1085 | (let ((res (markdown-syntax-propertize-extend-region start end))) | ||
| 1086 | (when res | ||
| 1087 | ;; syntax-propertize-function is not called when character at | ||
| 1088 | ;; (point-max) is deleted, but font-lock-extend-region-functions | ||
| 1089 | ;; are called. Force a syntax property update in that case. | ||
| 1090 | (when (= end (point-max)) | ||
| 1091 | ;; This function is called in a buffer modification hook. | ||
| 1092 | ;; `markdown-syntax-propertize' doesn't save the match data, | ||
| 1093 | ;; so we have to do it here. | ||
| 1094 | (save-match-data | ||
| 1095 | (markdown-syntax-propertize (car res) (cdr res)))) | ||
| 1096 | (setq jit-lock-start (car res) | ||
| 1097 | jit-lock-end (cdr res))))) | ||
| 1098 | |||
| 1099 | (defun markdown--cur-list-item-bounds () | ||
| 1100 | "Return a list describing the list item at point. | ||
| 1101 | Assumes that match data is set for `markdown-regex-list'. See the | ||
| 1102 | documentation for `markdown-cur-list-item-bounds' for the format of | ||
| 1103 | the returned list." | ||
| 1104 | (save-excursion | ||
| 1105 | (let* ((begin (match-beginning 0)) | ||
| 1106 | (indent (length (match-string-no-properties 1))) | ||
| 1107 | (nonlist-indent (- (match-end 3) (match-beginning 0))) | ||
| 1108 | (marker (buffer-substring-no-properties | ||
| 1109 | (match-beginning 2) (match-end 3))) | ||
| 1110 | (checkbox (match-string-no-properties 4)) | ||
| 1111 | (match (butlast (match-data t))) | ||
| 1112 | (end (markdown-cur-list-item-end nonlist-indent))) | ||
| 1113 | (list begin end indent nonlist-indent marker checkbox match)))) | ||
| 1114 | |||
| 1115 | (defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) | ||
| 1116 | "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. | ||
| 1117 | Here, MARKER is a string representing the type of list and INDENT | ||
| 1118 | is an integer giving the indentation, in spaces, of the current | ||
| 1119 | block. CUR-BOUNDS is a list of the form returned by | ||
| 1120 | `markdown-cur-list-item-bounds' and BOUNDS is a list of bounds | ||
| 1121 | values for parent list items. When BOUNDS is nil, it means we are | ||
| 1122 | at baseline (not inside of a nested list)." | ||
| 1123 | (let ((prev-indent (or (cl-third (car bounds)) 0))) | ||
| 1124 | (cond | ||
| 1125 | ;; New list item at baseline. | ||
| 1126 | ((and marker (null bounds)) | ||
| 1127 | (list cur-bounds)) | ||
| 1128 | ;; List item with greater indentation (four or more spaces). | ||
| 1129 | ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. | ||
| 1130 | ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) | ||
| 1131 | (cons cur-bounds bounds)) | ||
| 1132 | ;; List item with greater or equal indentation (less than four spaces). | ||
| 1133 | ;; Keep list level the same by replacing the car of BOUNDS. | ||
| 1134 | ((and marker (>= indent prev-indent)) | ||
| 1135 | (cons cur-bounds (cdr bounds))) | ||
| 1136 | ;; Lesser indentation level. | ||
| 1137 | ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser | ||
| 1138 | ;; indentation could move back more than one list level). Note | ||
| 1139 | ;; that this block need not be the beginning of list item. | ||
| 1140 | ((< indent prev-indent) | ||
| 1141 | (while (and (> (length bounds) 1) | ||
| 1142 | (setq prev-indent (cl-third (cadr bounds))) | ||
| 1143 | (< indent (+ prev-indent markdown-list-indent-width))) | ||
| 1144 | (setq bounds (cdr bounds))) | ||
| 1145 | (cons cur-bounds bounds)) | ||
| 1146 | ;; Otherwise, do nothing. | ||
| 1147 | (t bounds)))) | ||
| 1148 | |||
| 1149 | (defun markdown-syntax-propertize-list-items (start end) | ||
| 1150 | "Propertize list items from START to END. | ||
| 1151 | Stores nested list item information in the `markdown-list-item' | ||
| 1152 | text property to make later syntax analysis easier. The value of | ||
| 1153 | this property is a list with elements of the form (begin . end) | ||
| 1154 | giving the bounds of the current and parent list items." | ||
| 1155 | (save-excursion | ||
| 1156 | (goto-char start) | ||
| 1157 | (let (bounds level pre-regexp) | ||
| 1158 | ;; Find a baseline point with zero list indentation | ||
| 1159 | (markdown-search-backward-baseline) | ||
| 1160 | ;; Search for all list items between baseline and END | ||
| 1161 | (while (and (< (point) end) | ||
| 1162 | (re-search-forward markdown-regex-list end 'limit)) | ||
| 1163 | ;; Level of list nesting | ||
| 1164 | (setq level (length bounds)) | ||
| 1165 | ;; Pre blocks need to be indented one level past the list level | ||
| 1166 | (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) | ||
| 1167 | (beginning-of-line) | ||
| 1168 | (cond | ||
| 1169 | ;; Reset at headings, horizontal rules, and top-level blank lines. | ||
| 1170 | ;; Propertize baseline when in range. | ||
| 1171 | ((markdown-new-baseline) | ||
| 1172 | (setq bounds nil)) | ||
| 1173 | ;; Make sure this is not a line from a pre block | ||
| 1174 | ((looking-at-p pre-regexp)) | ||
| 1175 | ;; If not, then update levels and propertize list item when in range. | ||
| 1176 | (t | ||
| 1177 | (let* ((indent (current-indentation)) | ||
| 1178 | (cur-bounds (markdown--cur-list-item-bounds)) | ||
| 1179 | (first (cl-first cur-bounds)) | ||
| 1180 | (last (cl-second cur-bounds)) | ||
| 1181 | (marker (cl-fifth cur-bounds))) | ||
| 1182 | (setq bounds (markdown--append-list-item-bounds | ||
| 1183 | marker indent cur-bounds bounds)) | ||
| 1184 | (when (and (<= start (point)) (<= (point) end)) | ||
| 1185 | (put-text-property first last 'markdown-list-item bounds))))) | ||
| 1186 | (end-of-line))))) | ||
| 1187 | |||
| 1188 | (defun markdown-syntax-propertize-pre-blocks (start end) | ||
| 1189 | "Match preformatted text blocks from START to END." | ||
| 1190 | (save-excursion | ||
| 1191 | (goto-char start) | ||
| 1192 | (let (finish) | ||
| 1193 | ;; Use loop for avoiding too many recursive calls | ||
| 1194 | ;; https://github.com/jrblevin/markdown-mode/issues/512 | ||
| 1195 | (while (not finish) | ||
| 1196 | (let ((levels (markdown-calculate-list-levels)) | ||
| 1197 | indent pre-regexp close-regexp open close) | ||
| 1198 | (while (and (< (point) end) (not close)) | ||
| 1199 | ;; Search for a region with sufficient indentation | ||
| 1200 | (if (null levels) | ||
| 1201 | (setq indent 1) | ||
| 1202 | (setq indent (1+ (length levels)))) | ||
| 1203 | (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) | ||
| 1204 | (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) | ||
| 1205 | |||
| 1206 | (cond | ||
| 1207 | ;; If not at the beginning of a line, move forward | ||
| 1208 | ((not (bolp)) (forward-line)) | ||
| 1209 | ;; Move past blank lines | ||
| 1210 | ((markdown-cur-line-blank-p) (forward-line)) | ||
| 1211 | ;; At headers and horizontal rules, reset levels | ||
| 1212 | ((markdown-new-baseline) (forward-line) (setq levels nil)) | ||
| 1213 | ;; If the current line has sufficient indentation, mark out pre block | ||
| 1214 | ;; The opening should be preceded by a blank line. | ||
| 1215 | ((and (markdown-prev-line-blank) (looking-at pre-regexp)) | ||
| 1216 | (setq open (match-beginning 0)) | ||
| 1217 | (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) | ||
| 1218 | (not (eobp))) | ||
| 1219 | (forward-line)) | ||
| 1220 | (skip-syntax-backward "-") | ||
| 1221 | (setq close (point))) | ||
| 1222 | ;; If current line has a list marker, update levels, move to end of block | ||
| 1223 | ((looking-at markdown-regex-list) | ||
| 1224 | (setq levels (markdown-update-list-levels | ||
| 1225 | (match-string 2) (current-indentation) levels)) | ||
| 1226 | (markdown-end-of-text-block)) | ||
| 1227 | ;; If this is the end of the indentation level, adjust levels accordingly. | ||
| 1228 | ;; Only match end of indentation level if levels is not the empty list. | ||
| 1229 | ((and (car levels) (looking-at-p close-regexp)) | ||
| 1230 | (setq levels (markdown-update-list-levels | ||
| 1231 | nil (current-indentation) levels)) | ||
| 1232 | (markdown-end-of-text-block)) | ||
| 1233 | (t (markdown-end-of-text-block)))) | ||
| 1234 | |||
| 1235 | (if (and open close) | ||
| 1236 | ;; Set text property data and continue to search | ||
| 1237 | (put-text-property open close 'markdown-pre (list open close)) | ||
| 1238 | (setq finish t)))) | ||
| 1239 | nil))) | ||
| 1240 | |||
| 1241 | (defconst markdown-fenced-block-pairs | ||
| 1242 | `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) | ||
| 1243 | (markdown-make-tilde-fence-regex markdown-tilde-fence-end) | ||
| 1244 | markdown-fenced-code) | ||
| 1245 | ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) | ||
| 1246 | (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) | ||
| 1247 | markdown-yaml-metadata-section) | ||
| 1248 | ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) | ||
| 1249 | (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) | ||
| 1250 | markdown-gfm-code)) | ||
| 1251 | "Mapping of regular expressions to \"fenced-block\" constructs. | ||
| 1252 | These constructs are distinguished by having a distinctive start | ||
| 1253 | and end pattern, both of which take up an entire line of text, | ||
| 1254 | but no special pattern to identify text within the fenced | ||
| 1255 | blocks (unlike blockquotes and indented-code sections). | ||
| 1256 | |||
| 1257 | Each element within this list takes the form: | ||
| 1258 | |||
| 1259 | ((START-REGEX-OR-FUN START-PROPERTY) | ||
| 1260 | (END-REGEX-OR-FUN END-PROPERTY) | ||
| 1261 | MIDDLE-PROPERTY) | ||
| 1262 | |||
| 1263 | Each *-REGEX-OR-FUN element can be a regular expression as a string, or a | ||
| 1264 | function which evaluates to same. Functions for START-REGEX-OR-FUN accept no | ||
| 1265 | arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument | ||
| 1266 | which is the length of the first group of the START-REGEX-OR-FUN match, which | ||
| 1267 | can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to | ||
| 1268 | evaluate these into \"real\" regexps. | ||
| 1269 | |||
| 1270 | The *-PROPERTY elements are the text properties applied to each part of the | ||
| 1271 | block construct when it is matched using | ||
| 1272 | `markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied | ||
| 1273 | to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and | ||
| 1274 | MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the | ||
| 1275 | `match-data' when the regexp was matched to the text. In the case of | ||
| 1276 | MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with | ||
| 1277 | begin and end set to the edges of the \"middle\" text. This makes fontification | ||
| 1278 | easier.") | ||
| 1279 | |||
| 1280 | (defun markdown-text-property-at-point (prop) | ||
| 1281 | (get-text-property (point) prop)) | ||
| 1282 | |||
| 1283 | (defsubst markdown-maybe-funcall-regexp (object &optional arg) | ||
| 1284 | (cond ((functionp object) | ||
| 1285 | (if arg (funcall object arg) (funcall object))) | ||
| 1286 | ((stringp object) object) | ||
| 1287 | (t (error "Object cannot be turned into regex")))) | ||
| 1288 | |||
| 1289 | (defsubst markdown-get-start-fence-regexp () | ||
| 1290 | "Return regexp to find all \"start\" sections of fenced block constructs. | ||
| 1291 | Which construct is actually contained in the match must be found separately." | ||
| 1292 | (mapconcat | ||
| 1293 | #'identity | ||
| 1294 | (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) | ||
| 1295 | markdown-fenced-block-pairs) | ||
| 1296 | "\\|")) | ||
| 1297 | |||
| 1298 | (defun markdown-get-fenced-block-begin-properties () | ||
| 1299 | (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) | ||
| 1300 | |||
| 1301 | (defun markdown-get-fenced-block-end-properties () | ||
| 1302 | (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) | ||
| 1303 | |||
| 1304 | (defun markdown-get-fenced-block-middle-properties () | ||
| 1305 | (cl-mapcar #'cl-third markdown-fenced-block-pairs)) | ||
| 1306 | |||
| 1307 | (defun markdown-find-previous-prop (prop &optional lim) | ||
| 1308 | "Find previous place where property PROP is non-nil, up to LIM. | ||
| 1309 | Return a cons of (pos . property). pos is point if point contains | ||
| 1310 | non-nil PROP." | ||
| 1311 | (let ((res | ||
| 1312 | (if (get-text-property (point) prop) (point) | ||
| 1313 | (previous-single-property-change | ||
| 1314 | (point) prop nil (or lim (point-min)))))) | ||
| 1315 | (when (and (not (get-text-property res prop)) | ||
| 1316 | (> res (point-min)) | ||
| 1317 | (get-text-property (1- res) prop)) | ||
| 1318 | (cl-decf res)) | ||
| 1319 | (when (and res (get-text-property res prop)) (cons res prop)))) | ||
| 1320 | |||
| 1321 | (defun markdown-find-next-prop (prop &optional lim) | ||
| 1322 | "Find next place where property PROP is non-nil, up to LIM. | ||
| 1323 | Return a cons of (POS . PROPERTY) where POS is point if point | ||
| 1324 | contains non-nil PROP." | ||
| 1325 | (let ((res | ||
| 1326 | (if (get-text-property (point) prop) (point) | ||
| 1327 | (next-single-property-change | ||
| 1328 | (point) prop nil (or lim (point-max)))))) | ||
| 1329 | (when (and res (get-text-property res prop)) (cons res prop)))) | ||
| 1330 | |||
| 1331 | (defun markdown-min-of-seq (map-fn seq) | ||
| 1332 | "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." | ||
| 1333 | (cl-loop for el in seq | ||
| 1334 | with min = 1.0e+INF ; infinity | ||
| 1335 | with min-el = nil | ||
| 1336 | do (let ((res (funcall map-fn el))) | ||
| 1337 | (when (< res min) | ||
| 1338 | (setq min res) | ||
| 1339 | (setq min-el el))) | ||
| 1340 | finally return min-el)) | ||
| 1341 | |||
| 1342 | (defun markdown-max-of-seq (map-fn seq) | ||
| 1343 | "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." | ||
| 1344 | (cl-loop for el in seq | ||
| 1345 | with max = -1.0e+INF ; negative infinity | ||
| 1346 | with max-el = nil | ||
| 1347 | do (let ((res (funcall map-fn el))) | ||
| 1348 | (when (and res (> res max)) | ||
| 1349 | (setq max res) | ||
| 1350 | (setq max-el el))) | ||
| 1351 | finally return max-el)) | ||
| 1352 | |||
| 1353 | (defun markdown-find-previous-block () | ||
| 1354 | "Find previous block. | ||
| 1355 | Detect whether `markdown-syntax-propertize-fenced-block-constructs' was | ||
| 1356 | unable to propertize the entire block, but was able to propertize the beginning | ||
| 1357 | of the block. If so, return a cons of (pos . property) where the beginning of | ||
| 1358 | the block was propertized." | ||
| 1359 | (let ((start-pt (point)) | ||
| 1360 | (closest-open | ||
| 1361 | (markdown-max-of-seq | ||
| 1362 | #'car | ||
| 1363 | (cl-remove-if | ||
| 1364 | #'null | ||
| 1365 | (cl-mapcar | ||
| 1366 | #'markdown-find-previous-prop | ||
| 1367 | (markdown-get-fenced-block-begin-properties)))))) | ||
| 1368 | (when closest-open | ||
| 1369 | (let* ((length-of-open-match | ||
| 1370 | (let ((match-d | ||
| 1371 | (get-text-property (car closest-open) (cdr closest-open)))) | ||
| 1372 | (- (cl-fourth match-d) (cl-third match-d)))) | ||
| 1373 | (end-regexp | ||
| 1374 | (markdown-maybe-funcall-regexp | ||
| 1375 | (cl-caadr | ||
| 1376 | (cl-find-if | ||
| 1377 | (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) | ||
| 1378 | markdown-fenced-block-pairs)) | ||
| 1379 | length-of-open-match)) | ||
| 1380 | (end-prop-loc | ||
| 1381 | (save-excursion | ||
| 1382 | (save-match-data | ||
| 1383 | (goto-char (car closest-open)) | ||
| 1384 | (and (re-search-forward end-regexp start-pt t) | ||
| 1385 | (match-beginning 0)))))) | ||
| 1386 | (and (not end-prop-loc) closest-open))))) | ||
| 1387 | |||
| 1388 | (defun markdown-get-fenced-block-from-start (prop) | ||
| 1389 | "Return limits of an enclosing fenced block from its start, using PROP. | ||
| 1390 | Return value is a list usable as `match-data'." | ||
| 1391 | (catch 'no-rest-of-block | ||
| 1392 | (let* ((correct-entry | ||
| 1393 | (cl-find-if | ||
| 1394 | (lambda (entry) (eq (cl-cadar entry) prop)) | ||
| 1395 | markdown-fenced-block-pairs)) | ||
| 1396 | (begin-of-begin (cl-first (markdown-text-property-at-point prop))) | ||
| 1397 | (middle-prop (cl-third correct-entry)) | ||
| 1398 | (end-prop (cl-cadadr correct-entry)) | ||
| 1399 | (end-of-end | ||
| 1400 | (save-excursion | ||
| 1401 | (goto-char (match-end 0)) ; end of begin | ||
| 1402 | (unless (eobp) (forward-char)) | ||
| 1403 | (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) | ||
| 1404 | (if (not mid-prop-v) ; no middle | ||
| 1405 | (progn | ||
| 1406 | ;; try to find end by advancing one | ||
| 1407 | (let ((end-prop-v | ||
| 1408 | (markdown-text-property-at-point end-prop))) | ||
| 1409 | (if end-prop-v (cl-second end-prop-v) | ||
| 1410 | (throw 'no-rest-of-block nil)))) | ||
| 1411 | (set-match-data mid-prop-v) | ||
| 1412 | (goto-char (match-end 0)) ; end of middle | ||
| 1413 | (beginning-of-line) ; into end | ||
| 1414 | (cl-second (markdown-text-property-at-point end-prop))))))) | ||
| 1415 | (list begin-of-begin end-of-end)))) | ||
| 1416 | |||
| 1417 | (defun markdown-get-fenced-block-from-middle (prop) | ||
| 1418 | "Return limits of an enclosing fenced block from its middle, using PROP. | ||
| 1419 | Return value is a list usable as `match-data'." | ||
| 1420 | (let* ((correct-entry | ||
| 1421 | (cl-find-if | ||
| 1422 | (lambda (entry) (eq (cl-third entry) prop)) | ||
| 1423 | markdown-fenced-block-pairs)) | ||
| 1424 | (begin-prop (cl-cadar correct-entry)) | ||
| 1425 | (begin-of-begin | ||
| 1426 | (save-excursion | ||
| 1427 | (goto-char (match-beginning 0)) | ||
| 1428 | (unless (bobp) (forward-line -1)) | ||
| 1429 | (beginning-of-line) | ||
| 1430 | (cl-first (markdown-text-property-at-point begin-prop)))) | ||
| 1431 | (end-prop (cl-cadadr correct-entry)) | ||
| 1432 | (end-of-end | ||
| 1433 | (save-excursion | ||
| 1434 | (goto-char (match-end 0)) | ||
| 1435 | (beginning-of-line) | ||
| 1436 | (cl-second (markdown-text-property-at-point end-prop))))) | ||
| 1437 | (list begin-of-begin end-of-end))) | ||
| 1438 | |||
| 1439 | (defun markdown-get-fenced-block-from-end (prop) | ||
| 1440 | "Return limits of an enclosing fenced block from its end, using PROP. | ||
| 1441 | Return value is a list usable as `match-data'." | ||
| 1442 | (let* ((correct-entry | ||
| 1443 | (cl-find-if | ||
| 1444 | (lambda (entry) (eq (cl-cadadr entry) prop)) | ||
| 1445 | markdown-fenced-block-pairs)) | ||
| 1446 | (end-of-end (cl-second (markdown-text-property-at-point prop))) | ||
| 1447 | (middle-prop (cl-third correct-entry)) | ||
| 1448 | (begin-prop (cl-cadar correct-entry)) | ||
| 1449 | (begin-of-begin | ||
| 1450 | (save-excursion | ||
| 1451 | (goto-char (match-beginning 0)) ; beginning of end | ||
| 1452 | (unless (bobp) (backward-char)) ; into middle | ||
| 1453 | (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) | ||
| 1454 | (if (not mid-prop-v) | ||
| 1455 | (progn | ||
| 1456 | (beginning-of-line) | ||
| 1457 | (cl-first (markdown-text-property-at-point begin-prop))) | ||
| 1458 | (set-match-data mid-prop-v) | ||
| 1459 | (goto-char (match-beginning 0)) ; beginning of middle | ||
| 1460 | (unless (bobp) (forward-line -1)) ; into beginning | ||
| 1461 | (beginning-of-line) | ||
| 1462 | (cl-first (markdown-text-property-at-point begin-prop))))))) | ||
| 1463 | (list begin-of-begin end-of-end))) | ||
| 1464 | |||
| 1465 | (defun markdown-get-enclosing-fenced-block-construct (&optional pos) | ||
| 1466 | "Get \"fake\" match data for block enclosing POS. | ||
| 1467 | Returns fake match data which encloses the start, middle, and end | ||
| 1468 | of the block construct enclosing POS, if it exists. Used in | ||
| 1469 | `markdown-code-block-at-pos'." | ||
| 1470 | (save-excursion | ||
| 1471 | (when pos (goto-char pos)) | ||
| 1472 | (beginning-of-line) | ||
| 1473 | (car | ||
| 1474 | (cl-remove-if | ||
| 1475 | #'null | ||
| 1476 | (cl-mapcar | ||
| 1477 | (lambda (fun-and-prop) | ||
| 1478 | (cl-destructuring-bind (fun prop) fun-and-prop | ||
| 1479 | (when prop | ||
| 1480 | (save-match-data | ||
| 1481 | (set-match-data (markdown-text-property-at-point prop)) | ||
| 1482 | (funcall fun prop))))) | ||
| 1483 | `((markdown-get-fenced-block-from-start | ||
| 1484 | ,(cl-find-if | ||
| 1485 | #'markdown-text-property-at-point | ||
| 1486 | (markdown-get-fenced-block-begin-properties))) | ||
| 1487 | (markdown-get-fenced-block-from-middle | ||
| 1488 | ,(cl-find-if | ||
| 1489 | #'markdown-text-property-at-point | ||
| 1490 | (markdown-get-fenced-block-middle-properties))) | ||
| 1491 | (markdown-get-fenced-block-from-end | ||
| 1492 | ,(cl-find-if | ||
| 1493 | #'markdown-text-property-at-point | ||
| 1494 | (markdown-get-fenced-block-end-properties))))))))) | ||
| 1495 | |||
| 1496 | (defun markdown-propertize-end-match (reg end fence-spec middle-begin) | ||
| 1497 | "Get match for REG up to END, if exists, and propertize appropriately. | ||
| 1498 | FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and | ||
| 1499 | MIDDLE-BEGIN is the start of the \"middle\" section of the block." | ||
| 1500 | (when (re-search-forward reg end t) | ||
| 1501 | (let ((close-begin (match-beginning 0)) ; Start of closing line. | ||
| 1502 | (close-end (match-end 0)) ; End of closing line. | ||
| 1503 | (close-data (match-data t))) ; Match data for closing line. | ||
| 1504 | ;; Propertize middle section of fenced block. | ||
| 1505 | (put-text-property middle-begin close-begin | ||
| 1506 | (cl-third fence-spec) | ||
| 1507 | (list middle-begin close-begin)) | ||
| 1508 | ;; If the block is a YAML block, propertize the declarations inside | ||
| 1509 | (markdown-syntax-propertize-yaml-metadata middle-begin close-begin) | ||
| 1510 | ;; Propertize closing line of fenced block. | ||
| 1511 | (put-text-property close-begin close-end | ||
| 1512 | (cl-cadadr fence-spec) close-data)))) | ||
| 1513 | |||
| 1514 | (defun markdown-syntax-propertize-fenced-block-constructs (start end) | ||
| 1515 | "Propertize according to `markdown-fenced-block-pairs' from START to END. | ||
| 1516 | If unable to propertize an entire block (if the start of a block is within START | ||
| 1517 | and END, but the end of the block is not), propertize the start section of a | ||
| 1518 | block, then in a subsequent call propertize both middle and end by finding the | ||
| 1519 | start which was previously propertized." | ||
| 1520 | (let ((start-reg (markdown-get-start-fence-regexp))) | ||
| 1521 | (save-excursion | ||
| 1522 | (goto-char start) | ||
| 1523 | ;; start from previous unclosed block, if exists | ||
| 1524 | (let ((prev-begin-block (markdown-find-previous-block))) | ||
| 1525 | (when prev-begin-block | ||
| 1526 | (let* ((correct-entry | ||
| 1527 | (cl-find-if (lambda (entry) | ||
| 1528 | (eq (cdr prev-begin-block) (cl-cadar entry))) | ||
| 1529 | markdown-fenced-block-pairs)) | ||
| 1530 | (enclosed-text-start (1+ (car prev-begin-block))) | ||
| 1531 | (start-length | ||
| 1532 | (save-excursion | ||
| 1533 | (goto-char (car prev-begin-block)) | ||
| 1534 | (string-match | ||
| 1535 | (markdown-maybe-funcall-regexp | ||
| 1536 | (caar correct-entry)) | ||
| 1537 | (buffer-substring | ||
| 1538 | (point-at-bol) (point-at-eol))) | ||
| 1539 | (- (match-end 1) (match-beginning 1)))) | ||
| 1540 | (end-reg (markdown-maybe-funcall-regexp | ||
| 1541 | (cl-caadr correct-entry) start-length))) | ||
| 1542 | (markdown-propertize-end-match | ||
| 1543 | end-reg end correct-entry enclosed-text-start)))) | ||
| 1544 | ;; find all new blocks within region | ||
| 1545 | (while (re-search-forward start-reg end t) | ||
| 1546 | ;; we assume the opening constructs take up (only) an entire line, | ||
| 1547 | ;; so we re-check the current line | ||
| 1548 | (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol))) | ||
| 1549 | ;; find entry in `markdown-fenced-block-pairs' corresponding | ||
| 1550 | ;; to regex which was matched | ||
| 1551 | (correct-entry | ||
| 1552 | (cl-find-if | ||
| 1553 | (lambda (fenced-pair) | ||
| 1554 | (string-match-p | ||
| 1555 | (markdown-maybe-funcall-regexp (caar fenced-pair)) | ||
| 1556 | cur-line)) | ||
| 1557 | markdown-fenced-block-pairs)) | ||
| 1558 | (enclosed-text-start | ||
| 1559 | (save-excursion (1+ (point-at-eol)))) | ||
| 1560 | (end-reg | ||
| 1561 | (markdown-maybe-funcall-regexp | ||
| 1562 | (cl-caadr correct-entry) | ||
| 1563 | (if (and (match-beginning 1) (match-end 1)) | ||
| 1564 | (- (match-end 1) (match-beginning 1)) | ||
| 1565 | 0)))) | ||
| 1566 | ;; get correct match data | ||
| 1567 | (save-excursion | ||
| 1568 | (beginning-of-line) | ||
| 1569 | (re-search-forward | ||
| 1570 | (markdown-maybe-funcall-regexp (caar correct-entry)) | ||
| 1571 | (point-at-eol))) | ||
| 1572 | ;; mark starting, even if ending is outside of region | ||
| 1573 | (put-text-property (match-beginning 0) (match-end 0) | ||
| 1574 | (cl-cadar correct-entry) (match-data t)) | ||
| 1575 | (markdown-propertize-end-match | ||
| 1576 | end-reg end correct-entry enclosed-text-start)))))) | ||
| 1577 | |||
| 1578 | (defun markdown-syntax-propertize-blockquotes (start end) | ||
| 1579 | "Match blockquotes from START to END." | ||
| 1580 | (save-excursion | ||
| 1581 | (goto-char start) | ||
| 1582 | (while (and (re-search-forward markdown-regex-blockquote end t) | ||
| 1583 | (not (markdown-code-block-at-pos (match-beginning 0)))) | ||
| 1584 | (put-text-property (match-beginning 0) (match-end 0) | ||
| 1585 | 'markdown-blockquote | ||
| 1586 | (match-data t))))) | ||
| 1587 | |||
| 1588 | (defun markdown-syntax-propertize-hrs (start end) | ||
| 1589 | "Match horizontal rules from START to END." | ||
| 1590 | (save-excursion | ||
| 1591 | (goto-char start) | ||
| 1592 | (while (re-search-forward markdown-regex-hr end t) | ||
| 1593 | (let ((beg (match-beginning 0)) | ||
| 1594 | (end (match-end 0))) | ||
| 1595 | (goto-char beg) | ||
| 1596 | (unless (or (markdown-on-heading-p) | ||
| 1597 | (markdown-code-block-at-point-p)) | ||
| 1598 | (put-text-property beg end 'markdown-hr (match-data t))) | ||
| 1599 | (goto-char end))))) | ||
| 1600 | |||
| 1601 | (defun markdown-syntax-propertize-yaml-metadata (start end) | ||
| 1602 | "Propertize elements inside YAML metadata blocks from START to END. | ||
| 1603 | Assumes region from START and END is already known to be the interior | ||
| 1604 | region of a YAML metadata block as propertized by | ||
| 1605 | `markdown-syntax-propertize-fenced-block-constructs'." | ||
| 1606 | (save-excursion | ||
| 1607 | (goto-char start) | ||
| 1608 | (cl-loop | ||
| 1609 | while (re-search-forward markdown-regex-declarative-metadata end t) | ||
| 1610 | do (progn | ||
| 1611 | (put-text-property (match-beginning 1) (match-end 1) | ||
| 1612 | 'markdown-metadata-key (match-data t)) | ||
| 1613 | (put-text-property (match-beginning 2) (match-end 2) | ||
| 1614 | 'markdown-metadata-markup (match-data t)) | ||
| 1615 | (put-text-property (match-beginning 3) (match-end 3) | ||
| 1616 | 'markdown-metadata-value (match-data t)))))) | ||
| 1617 | |||
| 1618 | (defun markdown-syntax-propertize-headings (start end) | ||
| 1619 | "Match headings of type SYMBOL with REGEX from START to END." | ||
| 1620 | (goto-char start) | ||
| 1621 | (while (re-search-forward markdown-regex-header end t) | ||
| 1622 | (unless (markdown-code-block-at-pos (match-beginning 0)) | ||
| 1623 | (put-text-property | ||
| 1624 | (match-beginning 0) (match-end 0) 'markdown-heading | ||
| 1625 | (match-data t)) | ||
| 1626 | (put-text-property | ||
| 1627 | (match-beginning 0) (match-end 0) | ||
| 1628 | (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) | ||
| 1629 | ((match-string-no-properties 3) 'markdown-heading-2-setext) | ||
| 1630 | (t (let ((atx-level (length (markdown-trim-whitespace | ||
| 1631 | (match-string-no-properties 4))))) | ||
| 1632 | (intern (format "markdown-heading-%d-atx" atx-level))))) | ||
| 1633 | (match-data t))))) | ||
| 1634 | |||
| 1635 | (defun markdown-syntax-propertize-comments (start end) | ||
| 1636 | "Match HTML comments from the START to END." | ||
| 1637 | ;; Implement by loop instead of recursive call for avoiding | ||
| 1638 | ;; exceed max-lisp-eval-depth issue | ||
| 1639 | ;; https://github.com/jrblevin/markdown-mode/issues/536 | ||
| 1640 | (let (finish) | ||
| 1641 | (goto-char start) | ||
| 1642 | (while (not finish) | ||
| 1643 | (let* ((in-comment (nth 4 (syntax-ppss))) | ||
| 1644 | (comment-begin (nth 8 (syntax-ppss)))) | ||
| 1645 | (cond | ||
| 1646 | ;; Comment start | ||
| 1647 | ((and (not in-comment) | ||
| 1648 | (re-search-forward markdown-regex-comment-start end t) | ||
| 1649 | (not (markdown-inline-code-at-point-p)) | ||
| 1650 | (not (markdown-code-block-at-point-p))) | ||
| 1651 | (let ((open-beg (match-beginning 0))) | ||
| 1652 | (put-text-property open-beg (1+ open-beg) | ||
| 1653 | 'syntax-table (string-to-syntax "<")) | ||
| 1654 | (goto-char (min (1+ (match-end 0)) end (point-max))))) | ||
| 1655 | ;; Comment end | ||
| 1656 | ((and in-comment comment-begin | ||
| 1657 | (re-search-forward markdown-regex-comment-end end t)) | ||
| 1658 | (let ((comment-end (match-end 0))) | ||
| 1659 | (put-text-property (1- comment-end) comment-end | ||
| 1660 | 'syntax-table (string-to-syntax ">")) | ||
| 1661 | ;; Remove any other text properties inside the comment | ||
| 1662 | (remove-text-properties comment-begin comment-end | ||
| 1663 | markdown--syntax-properties) | ||
| 1664 | (put-text-property comment-begin comment-end | ||
| 1665 | 'markdown-comment (list comment-begin comment-end)) | ||
| 1666 | (goto-char (min (1+ comment-end) end (point-max))))) | ||
| 1667 | ;; Nothing found | ||
| 1668 | (t (setq finish t))))) | ||
| 1669 | nil)) | ||
| 1670 | |||
| 1671 | (defun markdown-syntax-propertize (start end) | ||
| 1672 | "Function used as `syntax-propertize-function'. | ||
| 1673 | START and END delimit region to propertize." | ||
| 1674 | (with-silent-modifications | ||
| 1675 | (save-excursion | ||
| 1676 | (remove-text-properties start end markdown--syntax-properties) | ||
| 1677 | (markdown-syntax-propertize-fenced-block-constructs start end) | ||
| 1678 | (markdown-syntax-propertize-list-items start end) | ||
| 1679 | (markdown-syntax-propertize-pre-blocks start end) | ||
| 1680 | (markdown-syntax-propertize-blockquotes start end) | ||
| 1681 | (markdown-syntax-propertize-headings start end) | ||
| 1682 | (markdown-syntax-propertize-hrs start end) | ||
| 1683 | (markdown-syntax-propertize-comments start end)))) | ||
| 1684 | |||
| 1685 | |||
| 1686 | ;;; Markup Hiding ============================================================= | ||
| 1687 | |||
| 1688 | (defconst markdown-markup-properties | ||
| 1689 | '(face markdown-markup-face invisible markdown-markup) | ||
| 1690 | "List of properties and values to apply to markup.") | ||
| 1691 | |||
| 1692 | (defconst markdown-language-keyword-properties | ||
| 1693 | '(face markdown-language-keyword-face invisible markdown-markup) | ||
| 1694 | "List of properties and values to apply to code block language names.") | ||
| 1695 | |||
| 1696 | (defconst markdown-language-info-properties | ||
| 1697 | '(face markdown-language-info-face invisible markdown-markup) | ||
| 1698 | "List of properties and values to apply to code block language info strings.") | ||
| 1699 | |||
| 1700 | (defconst markdown-include-title-properties | ||
| 1701 | '(face markdown-link-title-face invisible markdown-markup) | ||
| 1702 | "List of properties and values to apply to included code titles.") | ||
| 1703 | |||
| 1704 | (defcustom markdown-hide-markup nil | ||
| 1705 | "Determines whether markup in the buffer will be hidden. | ||
| 1706 | When set to nil, all markup is displayed in the buffer as it | ||
| 1707 | appears in the file. An exception is when `markdown-hide-urls' | ||
| 1708 | is non-nil. | ||
| 1709 | Set this to a non-nil value to turn this feature on by default. | ||
| 1710 | You can interactively toggle the value of this variable with | ||
| 1711 | `markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], | ||
| 1712 | or from the Markdown > Show & Hide menu. | ||
| 1713 | |||
| 1714 | Markup hiding works by adding text properties to positions in the | ||
| 1715 | buffer---either the `invisible' property or the `display' property | ||
| 1716 | in cases where alternative glyphs are used (e.g., list bullets). | ||
| 1717 | This does not, however, affect printing or other output. | ||
| 1718 | Functions such as `htmlfontify-buffer' and `ps-print-buffer' will | ||
| 1719 | not honor these text properties. For printing, it would be better | ||
| 1720 | to first convert to HTML or PDF (e.g,. using Pandoc)." | ||
| 1721 | :group 'markdown | ||
| 1722 | :type 'boolean | ||
| 1723 | :safe 'booleanp | ||
| 1724 | :package-version '(markdown-mode . "2.3")) | ||
| 1725 | (make-variable-buffer-local 'markdown-hide-markup) | ||
| 1726 | |||
| 1727 | (defun markdown-toggle-markup-hiding (&optional arg) | ||
| 1728 | "Toggle the display or hiding of markup. | ||
| 1729 | With a prefix argument ARG, enable markup hiding if ARG is positive, | ||
| 1730 | and disable it otherwise. | ||
| 1731 | See `markdown-hide-markup' for additional details." | ||
| 1732 | (interactive (list (or current-prefix-arg 'toggle))) | ||
| 1733 | (setq markdown-hide-markup | ||
| 1734 | (if (eq arg 'toggle) | ||
| 1735 | (not markdown-hide-markup) | ||
| 1736 | (> (prefix-numeric-value arg) 0))) | ||
| 1737 | (if markdown-hide-markup | ||
| 1738 | (progn (add-to-invisibility-spec 'markdown-markup) | ||
| 1739 | (message "markdown-mode markup hiding enabled")) | ||
| 1740 | (progn (remove-from-invisibility-spec 'markdown-markup) | ||
| 1741 | (message "markdown-mode markup hiding disabled"))) | ||
| 1742 | (markdown-reload-extensions)) | ||
| 1743 | |||
| 1744 | |||
| 1745 | ;;; Font Lock ================================================================= | ||
| 1746 | |||
| 1747 | (require 'font-lock) | ||
| 1748 | |||
| 1749 | (defgroup markdown-faces nil | ||
| 1750 | "Faces used in Markdown Mode" | ||
| 1751 | :group 'markdown | ||
| 1752 | :group 'faces) | ||
| 1753 | |||
| 1754 | (defface markdown-italic-face | ||
| 1755 | '((t (:inherit italic))) | ||
| 1756 | "Face for italic text." | ||
| 1757 | :group 'markdown-faces) | ||
| 1758 | |||
| 1759 | (defface markdown-bold-face | ||
| 1760 | '((t (:inherit bold))) | ||
| 1761 | "Face for bold text." | ||
| 1762 | :group 'markdown-faces) | ||
| 1763 | |||
| 1764 | (defface markdown-strike-through-face | ||
| 1765 | '((t (:strike-through t))) | ||
| 1766 | "Face for strike-through text." | ||
| 1767 | :group 'markdown-faces) | ||
| 1768 | |||
| 1769 | (defface markdown-markup-face | ||
| 1770 | '((t (:inherit shadow :slant normal :weight normal))) | ||
| 1771 | "Face for markup elements." | ||
| 1772 | :group 'markdown-faces) | ||
| 1773 | |||
| 1774 | (defface markdown-header-rule-face | ||
| 1775 | '((t (:inherit markdown-markup-face))) | ||
| 1776 | "Base face for headers rules." | ||
| 1777 | :group 'markdown-faces) | ||
| 1778 | |||
| 1779 | (defface markdown-header-delimiter-face | ||
| 1780 | '((t (:inherit markdown-markup-face))) | ||
| 1781 | "Base face for headers hash delimiter." | ||
| 1782 | :group 'markdown-faces) | ||
| 1783 | |||
| 1784 | (defface markdown-list-face | ||
| 1785 | '((t (:inherit markdown-markup-face))) | ||
| 1786 | "Face for list item markers." | ||
| 1787 | :group 'markdown-faces) | ||
| 1788 | |||
| 1789 | (defface markdown-blockquote-face | ||
| 1790 | '((t (:inherit font-lock-doc-face))) | ||
| 1791 | "Face for blockquote sections." | ||
| 1792 | :group 'markdown-faces) | ||
| 1793 | |||
| 1794 | (defface markdown-code-face | ||
| 1795 | '((t (:inherit fixed-pitch))) | ||
| 1796 | "Face for inline code, pre blocks, and fenced code blocks. | ||
| 1797 | This may be used, for example, to add a contrasting background to | ||
| 1798 | inline code fragments and code blocks." | ||
| 1799 | :group 'markdown-faces) | ||
| 1800 | |||
| 1801 | (defface markdown-inline-code-face | ||
| 1802 | '((t (:inherit (markdown-code-face font-lock-constant-face)))) | ||
| 1803 | "Face for inline code." | ||
| 1804 | :group 'markdown-faces) | ||
| 1805 | |||
| 1806 | (defface markdown-pre-face | ||
| 1807 | '((t (:inherit (markdown-code-face font-lock-constant-face)))) | ||
| 1808 | "Face for preformatted text." | ||
| 1809 | :group 'markdown-faces) | ||
| 1810 | |||
| 1811 | (defface markdown-table-face | ||
| 1812 | '((t (:inherit (markdown-code-face)))) | ||
| 1813 | "Face for tables." | ||
| 1814 | :group 'markdown-faces) | ||
| 1815 | |||
| 1816 | (defface markdown-language-keyword-face | ||
| 1817 | '((t (:inherit font-lock-type-face))) | ||
| 1818 | "Face for programming language identifiers." | ||
| 1819 | :group 'markdown-faces) | ||
| 1820 | |||
| 1821 | (defface markdown-language-info-face | ||
| 1822 | '((t (:inherit font-lock-string-face))) | ||
| 1823 | "Face for programming language info strings." | ||
| 1824 | :group 'markdown-faces) | ||
| 1825 | |||
| 1826 | (defface markdown-link-face | ||
| 1827 | '((t (:inherit link))) | ||
| 1828 | "Face for links." | ||
| 1829 | :group 'markdown-faces) | ||
| 1830 | |||
| 1831 | (defface markdown-missing-link-face | ||
| 1832 | '((t (:inherit font-lock-warning-face))) | ||
| 1833 | "Face for missing links." | ||
| 1834 | :group 'markdown-faces) | ||
| 1835 | |||
| 1836 | (defface markdown-reference-face | ||
| 1837 | '((t (:inherit markdown-markup-face))) | ||
| 1838 | "Face for link references." | ||
| 1839 | :group 'markdown-faces) | ||
| 1840 | |||
| 1841 | (defface markdown-footnote-marker-face | ||
| 1842 | '((t (:inherit markdown-markup-face))) | ||
| 1843 | "Face for footnote markers." | ||
| 1844 | :group 'markdown-faces) | ||
| 1845 | |||
| 1846 | (defface markdown-footnote-text-face | ||
| 1847 | '((t (:inherit font-lock-comment-face))) | ||
| 1848 | "Face for footnote text." | ||
| 1849 | :group 'markdown-faces) | ||
| 1850 | |||
| 1851 | (defface markdown-url-face | ||
| 1852 | '((t (:inherit font-lock-string-face))) | ||
| 1853 | "Face for URLs that are part of markup. | ||
| 1854 | For example, this applies to URLs in inline links: | ||
| 1855 | [link text](http://example.com/)." | ||
| 1856 | :group 'markdown-faces) | ||
| 1857 | |||
| 1858 | (defface markdown-plain-url-face | ||
| 1859 | '((t (:inherit markdown-link-face))) | ||
| 1860 | "Face for URLs that are also links. | ||
| 1861 | For example, this applies to plain angle bracket URLs: | ||
| 1862 | <http://example.com/>." | ||
| 1863 | :group 'markdown-faces) | ||
| 1864 | |||
| 1865 | (defface markdown-link-title-face | ||
| 1866 | '((t (:inherit font-lock-comment-face))) | ||
| 1867 | "Face for reference link titles." | ||
| 1868 | :group 'markdown-faces) | ||
| 1869 | |||
| 1870 | (defface markdown-line-break-face | ||
| 1871 | '((t (:inherit font-lock-constant-face :underline t))) | ||
| 1872 | "Face for hard line breaks." | ||
| 1873 | :group 'markdown-faces) | ||
| 1874 | |||
| 1875 | (defface markdown-comment-face | ||
| 1876 | '((t (:inherit font-lock-comment-face))) | ||
| 1877 | "Face for HTML comments." | ||
| 1878 | :group 'markdown-faces) | ||
| 1879 | |||
| 1880 | (defface markdown-math-face | ||
| 1881 | '((t (:inherit font-lock-string-face))) | ||
| 1882 | "Face for LaTeX expressions." | ||
| 1883 | :group 'markdown-faces) | ||
| 1884 | |||
| 1885 | (defface markdown-metadata-key-face | ||
| 1886 | '((t (:inherit font-lock-variable-name-face))) | ||
| 1887 | "Face for metadata keys." | ||
| 1888 | :group 'markdown-faces) | ||
| 1889 | |||
| 1890 | (defface markdown-metadata-value-face | ||
| 1891 | '((t (:inherit font-lock-string-face))) | ||
| 1892 | "Face for metadata values." | ||
| 1893 | :group 'markdown-faces) | ||
| 1894 | |||
| 1895 | (defface markdown-gfm-checkbox-face | ||
| 1896 | '((t (:inherit font-lock-builtin-face))) | ||
| 1897 | "Face for GFM checkboxes." | ||
| 1898 | :group 'markdown-faces) | ||
| 1899 | |||
| 1900 | (defface markdown-highlight-face | ||
| 1901 | '((t (:inherit highlight))) | ||
| 1902 | "Face for mouse highlighting." | ||
| 1903 | :group 'markdown-faces) | ||
| 1904 | |||
| 1905 | (defface markdown-hr-face | ||
| 1906 | '((t (:inherit markdown-markup-face))) | ||
| 1907 | "Face for horizontal rules." | ||
| 1908 | :group 'markdown-faces) | ||
| 1909 | |||
| 1910 | (defface markdown-html-tag-name-face | ||
| 1911 | '((t (:inherit font-lock-type-face))) | ||
| 1912 | "Face for HTML tag names." | ||
| 1913 | :group 'markdown-faces) | ||
| 1914 | |||
| 1915 | (defface markdown-html-tag-delimiter-face | ||
| 1916 | '((t (:inherit markdown-markup-face))) | ||
| 1917 | "Face for HTML tag delimiters." | ||
| 1918 | :group 'markdown-faces) | ||
| 1919 | |||
| 1920 | (defface markdown-html-attr-name-face | ||
| 1921 | '((t (:inherit font-lock-variable-name-face))) | ||
| 1922 | "Face for HTML attribute names." | ||
| 1923 | :group 'markdown-faces) | ||
| 1924 | |||
| 1925 | (defface markdown-html-attr-value-face | ||
| 1926 | '((t (:inherit font-lock-string-face))) | ||
| 1927 | "Face for HTML attribute values." | ||
| 1928 | :group 'markdown-faces) | ||
| 1929 | |||
| 1930 | (defface markdown-html-entity-face | ||
| 1931 | '((t (:inherit font-lock-variable-name-face))) | ||
| 1932 | "Face for HTML entities." | ||
| 1933 | :group 'markdown-faces) | ||
| 1934 | |||
| 1935 | (defcustom markdown-header-scaling nil | ||
| 1936 | "Whether to use variable-height faces for headers. | ||
| 1937 | When non-nil, `markdown-header-face' will inherit from | ||
| 1938 | `variable-pitch' and the scaling values in | ||
| 1939 | `markdown-header-scaling-values' will be applied to | ||
| 1940 | headers of levels one through six respectively." | ||
| 1941 | :type 'boolean | ||
| 1942 | :initialize 'custom-initialize-default | ||
| 1943 | :set (lambda (symbol value) | ||
| 1944 | (set-default symbol value) | ||
| 1945 | (markdown-update-header-faces value)) | ||
| 1946 | :group 'markdown-faces | ||
| 1947 | :package-version '(markdown-mode . "2.2")) | ||
| 1948 | |||
| 1949 | (defcustom markdown-header-scaling-values | ||
| 1950 | '(2.0 1.7 1.4 1.1 1.0 1.0) | ||
| 1951 | "List of scaling values for headers of level one through six. | ||
| 1952 | Used when `markdown-header-scaling' is non-nil." | ||
| 1953 | :type 'list | ||
| 1954 | :initialize 'custom-initialize-default | ||
| 1955 | :set (lambda (symbol value) | ||
| 1956 | (set-default symbol value) | ||
| 1957 | (markdown-update-header-faces markdown-header-scaling value)) | ||
| 1958 | :group 'markdown-faces) | ||
| 1959 | |||
| 1960 | (defun markdown-make-header-faces () | ||
| 1961 | "Build the faces used for Markdown headers." | ||
| 1962 | (let ((inherit-faces '(font-lock-function-name-face))) | ||
| 1963 | (when markdown-header-scaling | ||
| 1964 | (setq inherit-faces (cons 'variable-pitch inherit-faces))) | ||
| 1965 | (defface markdown-header-face | ||
| 1966 | `((t (:inherit ,inherit-faces :weight bold))) | ||
| 1967 | "Base face for headers." | ||
| 1968 | :group 'markdown-faces)) | ||
| 1969 | (dotimes (num 6) | ||
| 1970 | (let* ((num1 (1+ num)) | ||
| 1971 | (face-name (intern (format "markdown-header-face-%s" num1))) | ||
| 1972 | (scale (if markdown-header-scaling | ||
| 1973 | (float (nth num markdown-header-scaling-values)) | ||
| 1974 | 1.0))) | ||
| 1975 | (eval | ||
| 1976 | `(defface ,face-name | ||
| 1977 | '((t (:inherit markdown-header-face :height ,scale))) | ||
| 1978 | (format "Face for level %s headers. | ||
| 1979 | You probably don't want to customize this face directly. Instead | ||
| 1980 | you can customize the base face `markdown-header-face' or the | ||
| 1981 | variable-height variable `markdown-header-scaling'." ,num1) | ||
| 1982 | :group 'markdown-faces))))) | ||
| 1983 | |||
| 1984 | (markdown-make-header-faces) | ||
| 1985 | |||
| 1986 | (defun markdown-update-header-faces (&optional scaling scaling-values) | ||
| 1987 | "Update header faces, depending on if header SCALING is desired. | ||
| 1988 | If so, use given list of SCALING-VALUES relative to the baseline | ||
| 1989 | size of `markdown-header-face'." | ||
| 1990 | (dotimes (num 6) | ||
| 1991 | (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) | ||
| 1992 | (scale (cond ((not scaling) 1.0) | ||
| 1993 | (scaling-values (float (nth num scaling-values))) | ||
| 1994 | (t (float (nth num markdown-header-scaling-values)))))) | ||
| 1995 | (unless (get face-name 'saved-face) ; Don't update customized faces | ||
| 1996 | (set-face-attribute face-name nil :height scale))))) | ||
| 1997 | |||
| 1998 | (defun markdown-syntactic-face (state) | ||
| 1999 | "Return font-lock face for characters with given STATE. | ||
| 2000 | See `font-lock-syntactic-face-function' for details." | ||
| 2001 | (let ((in-comment (nth 4 state))) | ||
| 2002 | (cond | ||
| 2003 | (in-comment 'markdown-comment-face) | ||
| 2004 | (t nil)))) | ||
| 2005 | |||
| 2006 | (defcustom markdown-list-item-bullets | ||
| 2007 | '("●" "◎" "○" "◆" "◇" "►" "•") | ||
| 2008 | "List of bullets to use for unordered lists. | ||
| 2009 | It can contain any number of symbols, which will be repeated. | ||
| 2010 | Depending on your font, some reasonable choices are: | ||
| 2011 | ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." | ||
| 2012 | :group 'markdown | ||
| 2013 | :type '(repeat (string :tag "Bullet character")) | ||
| 2014 | :package-version '(markdown-mode . "2.3")) | ||
| 2015 | |||
| 2016 | (defun markdown--footnote-marker-properties () | ||
| 2017 | "Return a font-lock facespec expression for footnote marker text." | ||
| 2018 | `(face markdown-footnote-marker-face | ||
| 2019 | ,@(when markdown-hide-markup | ||
| 2020 | `(display ,markdown-footnote-display)))) | ||
| 2021 | |||
| 2022 | (defun markdown--pandoc-inline-footnote-properties () | ||
| 2023 | "Return a font-lock facespec expression for Pandoc inline footnote text." | ||
| 2024 | `(face markdown-footnote-text-face | ||
| 2025 | ,@(when markdown-hide-markup | ||
| 2026 | `(display ,markdown-footnote-display)))) | ||
| 2027 | |||
| 2028 | (defvar markdown-mode-font-lock-keywords | ||
| 2029 | `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) | ||
| 2030 | (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) | ||
| 2031 | (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) | ||
| 2032 | (2 'markdown-markup-face) | ||
| 2033 | (3 'markdown-metadata-value-face))) | ||
| 2034 | (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) | ||
| 2035 | (2 markdown-markup-properties nil t) | ||
| 2036 | (3 markdown-language-keyword-properties nil t) | ||
| 2037 | (4 markdown-language-info-properties nil t) | ||
| 2038 | (5 markdown-markup-properties nil t))) | ||
| 2039 | (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) | ||
| 2040 | (markdown-fontify-gfm-code-blocks) | ||
| 2041 | (markdown-fontify-tables) | ||
| 2042 | (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) | ||
| 2043 | (2 markdown-markup-properties nil t) | ||
| 2044 | (3 markdown-language-keyword-properties nil t) | ||
| 2045 | (4 markdown-language-info-properties nil t) | ||
| 2046 | (5 markdown-markup-properties nil t))) | ||
| 2047 | (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) | ||
| 2048 | (markdown-fontify-fenced-code-blocks) | ||
| 2049 | (markdown-match-pre-blocks . ((0 'markdown-pre-face))) | ||
| 2050 | (markdown-fontify-headings) | ||
| 2051 | (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) | ||
| 2052 | (2 'markdown-markup-face) | ||
| 2053 | (3 'markdown-metadata-value-face))) | ||
| 2054 | (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) | ||
| 2055 | (2 'markdown-markup-face) | ||
| 2056 | (3 'markdown-metadata-value-face))) | ||
| 2057 | (markdown-fontify-hrs) | ||
| 2058 | (markdown-match-code . ((1 markdown-markup-properties prepend) | ||
| 2059 | (2 'markdown-inline-code-face prepend) | ||
| 2060 | (3 markdown-markup-properties prepend))) | ||
| 2061 | (,markdown-regex-kbd . ((1 markdown-markup-properties) | ||
| 2062 | (2 'markdown-inline-code-face) | ||
| 2063 | (3 markdown-markup-properties))) | ||
| 2064 | (markdown-fontify-angle-uris) | ||
| 2065 | (,markdown-regex-email . 'markdown-plain-url-face) | ||
| 2066 | (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) | ||
| 2067 | (2 'markdown-html-tag-name-face t) | ||
| 2068 | (3 'markdown-html-tag-delimiter-face t) | ||
| 2069 | ;; Anchored matcher for HTML tag attributes | ||
| 2070 | (,markdown-regex-html-attr | ||
| 2071 | ;; Before searching, move past tag | ||
| 2072 | ;; name; set limit at tag close. | ||
| 2073 | (progn | ||
| 2074 | (goto-char (match-end 2)) (match-end 3)) | ||
| 2075 | nil | ||
| 2076 | . ((1 'markdown-html-attr-name-face) | ||
| 2077 | (3 'markdown-html-tag-delimiter-face nil t) | ||
| 2078 | (4 'markdown-html-attr-value-face nil t))))) | ||
| 2079 | (,markdown-regex-html-entity . 'markdown-html-entity-face) | ||
| 2080 | (markdown-fontify-list-items) | ||
| 2081 | (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ | ||
| 2082 | (2 (markdown--footnote-marker-properties)) ; label | ||
| 2083 | (3 markdown-markup-properties))) ; ] | ||
| 2084 | (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ | ||
| 2085 | (2 markdown-markup-properties) ; [ | ||
| 2086 | (3 (markdown--pandoc-inline-footnote-properties)) ; text | ||
| 2087 | (4 markdown-markup-properties))) ; ] | ||
| 2088 | (markdown-match-includes . ((1 markdown-markup-properties) | ||
| 2089 | (2 markdown-markup-properties nil t) | ||
| 2090 | (3 markdown-include-title-properties nil t) | ||
| 2091 | (4 markdown-markup-properties nil t) | ||
| 2092 | (5 markdown-markup-properties) | ||
| 2093 | (6 'markdown-url-face) | ||
| 2094 | (7 markdown-markup-properties))) | ||
| 2095 | (markdown-fontify-inline-links) | ||
| 2096 | (markdown-fontify-reference-links) | ||
| 2097 | (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ | ||
| 2098 | (2 'markdown-reference-face) ; label | ||
| 2099 | (3 'markdown-markup-face) ; ] | ||
| 2100 | (4 'markdown-markup-face) ; : | ||
| 2101 | (5 'markdown-url-face) ; url | ||
| 2102 | (6 'markdown-link-title-face))) ; "title" (optional) | ||
| 2103 | (markdown-fontify-plain-uris) | ||
| 2104 | ;; Math mode $..$ | ||
| 2105 | (markdown-match-math-single . ((1 'markdown-markup-face prepend) | ||
| 2106 | (2 'markdown-math-face append) | ||
| 2107 | (3 'markdown-markup-face prepend))) | ||
| 2108 | ;; Math mode $$..$$ | ||
| 2109 | (markdown-match-math-double . ((1 'markdown-markup-face prepend) | ||
| 2110 | (2 'markdown-math-face append) | ||
| 2111 | (3 'markdown-markup-face prepend))) | ||
| 2112 | ;; Math mode \[..\] and \\[..\\] | ||
| 2113 | (markdown-match-math-display . ((1 'markdown-markup-face prepend) | ||
| 2114 | (3 'markdown-math-face append) | ||
| 2115 | (4 'markdown-markup-face prepend))) | ||
| 2116 | (markdown-match-bold . ((1 markdown-markup-properties prepend) | ||
| 2117 | (2 'markdown-bold-face append) | ||
| 2118 | (3 markdown-markup-properties prepend))) | ||
| 2119 | (markdown-match-italic . ((1 markdown-markup-properties prepend) | ||
| 2120 | (2 'markdown-italic-face append) | ||
| 2121 | (3 markdown-markup-properties prepend))) | ||
| 2122 | (,markdown-regex-strike-through . ((3 markdown-markup-properties) | ||
| 2123 | (4 'markdown-strike-through-face) | ||
| 2124 | (5 markdown-markup-properties))) | ||
| 2125 | (,markdown-regex-line-break . (1 'markdown-line-break-face prepend)) | ||
| 2126 | (markdown-fontify-sub-superscripts) | ||
| 2127 | (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) | ||
| 2128 | (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) | ||
| 2129 | (markdown-fontify-blockquotes) | ||
| 2130 | (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) | ||
| 2131 | "Syntax highlighting for Markdown files.") | ||
| 2132 | |||
| 2133 | ;; Footnotes | ||
| 2134 | (defvar-local markdown-footnote-counter 0 | ||
| 2135 | "Counter for footnote numbers.") | ||
| 2136 | |||
| 2137 | (defconst markdown-footnote-chars | ||
| 2138 | "[[:alnum:]-]" | ||
| 2139 | "Regular expression matching any character that is allowed in a footnote identifier.") | ||
| 2140 | |||
| 2141 | (defconst markdown-regex-footnote-definition | ||
| 2142 | (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") | ||
| 2143 | "Regular expression matching a footnote definition, capturing the label.") | ||
| 2144 | |||
| 2145 | |||
| 2146 | ;;; Compatibility ============================================================= | ||
| 2147 | |||
| 2148 | (defun markdown-flyspell-check-word-p () | ||
| 2149 | "Return t if `flyspell' should check word just before point. | ||
| 2150 | Used for `flyspell-generic-check-word-predicate'." | ||
| 2151 | (save-excursion | ||
| 2152 | (goto-char (1- (point))) | ||
| 2153 | (if (or (markdown-code-block-at-point-p) | ||
| 2154 | (markdown-inline-code-at-point-p) | ||
| 2155 | (markdown-in-comment-p) | ||
| 2156 | (markdown--face-p (point) '(markdown-reference-face | ||
| 2157 | markdown-markup-face | ||
| 2158 | markdown-plain-url-face | ||
| 2159 | markdown-inline-code-face | ||
| 2160 | markdown-url-face))) | ||
| 2161 | (prog1 nil | ||
| 2162 | ;; If flyspell overlay is put, then remove it | ||
| 2163 | (let ((bounds (bounds-of-thing-at-point 'word))) | ||
| 2164 | (when bounds | ||
| 2165 | (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) | ||
| 2166 | when (overlay-get ov 'flyspell-overlay) | ||
| 2167 | do | ||
| 2168 | (delete-overlay ov))))) | ||
| 2169 | t))) | ||
| 2170 | |||
| 2171 | |||
| 2172 | ;;; Markdown Parsing Functions ================================================ | ||
| 2173 | |||
| 2174 | (defun markdown-cur-line-blank-p () | ||
| 2175 | "Return t if the current line is blank and nil otherwise." | ||
| 2176 | (save-excursion | ||
| 2177 | (beginning-of-line) | ||
| 2178 | (looking-at-p markdown-regex-blank-line))) | ||
| 2179 | |||
| 2180 | (defun markdown-prev-line-blank () | ||
| 2181 | "Return t if the previous line is blank and nil otherwise. | ||
| 2182 | If we are at the first line, then consider the previous line to be blank." | ||
| 2183 | (or (= (line-beginning-position) (point-min)) | ||
| 2184 | (save-excursion | ||
| 2185 | (forward-line -1) | ||
| 2186 | (looking-at markdown-regex-blank-line)))) | ||
| 2187 | |||
| 2188 | (defun markdown-prev-line-blank-p () | ||
| 2189 | "Like `markdown-prev-line-blank', but preserve `match-data'." | ||
| 2190 | (save-match-data (markdown-prev-line-blank))) | ||
| 2191 | |||
| 2192 | (defun markdown-next-line-blank-p () | ||
| 2193 | "Return t if the next line is blank and nil otherwise. | ||
| 2194 | If we are at the last line, then consider the next line to be blank." | ||
| 2195 | (or (= (line-end-position) (point-max)) | ||
| 2196 | (save-excursion | ||
| 2197 | (forward-line 1) | ||
| 2198 | (markdown-cur-line-blank-p)))) | ||
| 2199 | |||
| 2200 | (defun markdown-prev-line-indent () | ||
| 2201 | "Return the number of leading whitespace characters in the previous line. | ||
| 2202 | Return 0 if the current line is the first line in the buffer." | ||
| 2203 | (save-excursion | ||
| 2204 | (if (= (line-beginning-position) (point-min)) | ||
| 2205 | 0 | ||
| 2206 | (forward-line -1) | ||
| 2207 | (current-indentation)))) | ||
| 2208 | |||
| 2209 | (defun markdown-next-line-indent () | ||
| 2210 | "Return the number of leading whitespace characters in the next line. | ||
| 2211 | Return 0 if line is the last line in the buffer." | ||
| 2212 | (save-excursion | ||
| 2213 | (if (= (line-end-position) (point-max)) | ||
| 2214 | 0 | ||
| 2215 | (forward-line 1) | ||
| 2216 | (current-indentation)))) | ||
| 2217 | |||
| 2218 | (defun markdown-new-baseline () | ||
| 2219 | "Determine if the current line begins a new baseline level. | ||
| 2220 | Assume point is positioned at beginning of line." | ||
| 2221 | (or (looking-at markdown-regex-header) | ||
| 2222 | (looking-at markdown-regex-hr) | ||
| 2223 | (and (= (current-indentation) 0) | ||
| 2224 | (not (looking-at markdown-regex-list)) | ||
| 2225 | (markdown-prev-line-blank)))) | ||
| 2226 | |||
| 2227 | (defun markdown-search-backward-baseline () | ||
| 2228 | "Search backward baseline point with no indentation and not a list item." | ||
| 2229 | (end-of-line) | ||
| 2230 | (let (stop) | ||
| 2231 | (while (not (or stop (bobp))) | ||
| 2232 | (re-search-backward markdown-regex-block-separator-noindent nil t) | ||
| 2233 | (when (match-end 2) | ||
| 2234 | (goto-char (match-end 2)) | ||
| 2235 | (cond | ||
| 2236 | ((markdown-new-baseline) | ||
| 2237 | (setq stop t)) | ||
| 2238 | ((looking-at-p markdown-regex-list) | ||
| 2239 | (setq stop nil)) | ||
| 2240 | (t (setq stop t))))))) | ||
| 2241 | |||
| 2242 | (defun markdown-update-list-levels (marker indent levels) | ||
| 2243 | "Update list levels given list MARKER, block INDENT, and current LEVELS. | ||
| 2244 | Here, MARKER is a string representing the type of list, INDENT is an integer | ||
| 2245 | giving the indentation, in spaces, of the current block, and LEVELS is a | ||
| 2246 | list of the indentation levels of parent list items. When LEVELS is nil, | ||
| 2247 | it means we are at baseline (not inside of a nested list)." | ||
| 2248 | (cond | ||
| 2249 | ;; New list item at baseline. | ||
| 2250 | ((and marker (null levels)) | ||
| 2251 | (setq levels (list indent))) | ||
| 2252 | ;; List item with greater indentation (four or more spaces). | ||
| 2253 | ;; Increase list level. | ||
| 2254 | ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) | ||
| 2255 | (setq levels (cons indent levels))) | ||
| 2256 | ;; List item with greater or equal indentation (less than four spaces). | ||
| 2257 | ;; Do not increase list level. | ||
| 2258 | ((and marker (>= indent (car levels))) | ||
| 2259 | levels) | ||
| 2260 | ;; Lesser indentation level. | ||
| 2261 | ;; Pop appropriate number of elements off LEVELS list (e.g., lesser | ||
| 2262 | ;; indentation could move back more than one list level). Note | ||
| 2263 | ;; that this block need not be the beginning of list item. | ||
| 2264 | ((< indent (car levels)) | ||
| 2265 | (while (and (> (length levels) 1) | ||
| 2266 | (< indent (+ (cadr levels) markdown-list-indent-width))) | ||
| 2267 | (setq levels (cdr levels))) | ||
| 2268 | levels) | ||
| 2269 | ;; Otherwise, do nothing. | ||
| 2270 | (t levels))) | ||
| 2271 | |||
| 2272 | (defun markdown-calculate-list-levels () | ||
| 2273 | "Calculate list levels at point. | ||
| 2274 | Return a list of the form (n1 n2 n3 ...) where n1 is the | ||
| 2275 | indentation of the deepest nested list item in the branch of | ||
| 2276 | the list at the point, n2 is the indentation of the parent | ||
| 2277 | list item, and so on. The depth of the list item is therefore | ||
| 2278 | the length of the returned list. If the point is not at or | ||
| 2279 | immediately after a list item, return nil." | ||
| 2280 | (save-excursion | ||
| 2281 | (let ((first (point)) levels indent pre-regexp) | ||
| 2282 | ;; Find a baseline point with zero list indentation | ||
| 2283 | (markdown-search-backward-baseline) | ||
| 2284 | ;; Search for all list items between baseline and LOC | ||
| 2285 | (while (and (< (point) first) | ||
| 2286 | (re-search-forward markdown-regex-list first t)) | ||
| 2287 | (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) | ||
| 2288 | (beginning-of-line) | ||
| 2289 | (cond | ||
| 2290 | ;; Make sure this is not a header or hr | ||
| 2291 | ((markdown-new-baseline) (setq levels nil)) | ||
| 2292 | ;; Make sure this is not a line from a pre block | ||
| 2293 | ((looking-at-p pre-regexp)) | ||
| 2294 | ;; If not, then update levels | ||
| 2295 | (t | ||
| 2296 | (setq indent (current-indentation)) | ||
| 2297 | (setq levels (markdown-update-list-levels (match-string 2) | ||
| 2298 | indent levels)))) | ||
| 2299 | (end-of-line)) | ||
| 2300 | levels))) | ||
| 2301 | |||
| 2302 | (defun markdown-prev-list-item (level) | ||
| 2303 | "Search backward from point for a list item with indentation LEVEL. | ||
| 2304 | Set point to the beginning of the item, and return point, or nil | ||
| 2305 | upon failure." | ||
| 2306 | (let (bounds indent prev) | ||
| 2307 | (setq prev (point)) | ||
| 2308 | (forward-line -1) | ||
| 2309 | (setq indent (current-indentation)) | ||
| 2310 | (while | ||
| 2311 | (cond | ||
| 2312 | ;; List item | ||
| 2313 | ((and (looking-at-p markdown-regex-list) | ||
| 2314 | (setq bounds (markdown-cur-list-item-bounds))) | ||
| 2315 | (cond | ||
| 2316 | ;; Stop and return point at item of equal indentation | ||
| 2317 | ((= (nth 3 bounds) level) | ||
| 2318 | (setq prev (point)) | ||
| 2319 | nil) | ||
| 2320 | ;; Stop and return nil at item with lesser indentation | ||
| 2321 | ((< (nth 3 bounds) level) | ||
| 2322 | (setq prev nil) | ||
| 2323 | nil) | ||
| 2324 | ;; Stop at beginning of buffer | ||
| 2325 | ((bobp) (setq prev nil)) | ||
| 2326 | ;; Continue at item with greater indentation | ||
| 2327 | ((> (nth 3 bounds) level) t))) | ||
| 2328 | ;; Stop at beginning of buffer | ||
| 2329 | ((bobp) (setq prev nil)) | ||
| 2330 | ;; Continue if current line is blank | ||
| 2331 | ((markdown-cur-line-blank-p) t) | ||
| 2332 | ;; Continue while indentation is the same or greater | ||
| 2333 | ((>= indent level) t) | ||
| 2334 | ;; Stop if current indentation is less than list item | ||
| 2335 | ;; and the next is blank | ||
| 2336 | ((and (< indent level) | ||
| 2337 | (markdown-next-line-blank-p)) | ||
| 2338 | (setq prev nil)) | ||
| 2339 | ;; Stop at a header | ||
| 2340 | ((looking-at-p markdown-regex-header) (setq prev nil)) | ||
| 2341 | ;; Stop at a horizontal rule | ||
| 2342 | ((looking-at-p markdown-regex-hr) (setq prev nil)) | ||
| 2343 | ;; Otherwise, continue. | ||
| 2344 | (t t)) | ||
| 2345 | (forward-line -1) | ||
| 2346 | (setq indent (current-indentation))) | ||
| 2347 | prev)) | ||
| 2348 | |||
| 2349 | (defun markdown-next-list-item (level) | ||
| 2350 | "Search forward from point for the next list item with indentation LEVEL. | ||
| 2351 | Set point to the beginning of the item, and return point, or nil | ||
| 2352 | upon failure." | ||
| 2353 | (let (bounds indent next) | ||
| 2354 | (setq next (point)) | ||
| 2355 | (if (looking-at markdown-regex-header-setext) | ||
| 2356 | (goto-char (match-end 0))) | ||
| 2357 | (forward-line) | ||
| 2358 | (setq indent (current-indentation)) | ||
| 2359 | (while | ||
| 2360 | (cond | ||
| 2361 | ;; Stop at end of the buffer. | ||
| 2362 | ((eobp) nil) | ||
| 2363 | ;; Continue if the current line is blank | ||
| 2364 | ((markdown-cur-line-blank-p) t) | ||
| 2365 | ;; List item | ||
| 2366 | ((and (looking-at-p markdown-regex-list) | ||
| 2367 | (setq bounds (markdown-cur-list-item-bounds))) | ||
| 2368 | (cond | ||
| 2369 | ;; Continue at item with greater indentation | ||
| 2370 | ((> (nth 3 bounds) level) t) | ||
| 2371 | ;; Stop and return point at item of equal indentation | ||
| 2372 | ((= (nth 3 bounds) level) | ||
| 2373 | (setq next (point)) | ||
| 2374 | nil) | ||
| 2375 | ;; Stop and return nil at item with lesser indentation | ||
| 2376 | ((< (nth 3 bounds) level) | ||
| 2377 | (setq next nil) | ||
| 2378 | nil))) | ||
| 2379 | ;; Continue while indentation is the same or greater | ||
| 2380 | ((>= indent level) t) | ||
| 2381 | ;; Stop if current indentation is less than list item | ||
| 2382 | ;; and the previous line was blank. | ||
| 2383 | ((and (< indent level) | ||
| 2384 | (markdown-prev-line-blank-p)) | ||
| 2385 | (setq next nil)) | ||
| 2386 | ;; Stop at a header | ||
| 2387 | ((looking-at-p markdown-regex-header) (setq next nil)) | ||
| 2388 | ;; Stop at a horizontal rule | ||
| 2389 | ((looking-at-p markdown-regex-hr) (setq next nil)) | ||
| 2390 | ;; Otherwise, continue. | ||
| 2391 | (t t)) | ||
| 2392 | (forward-line) | ||
| 2393 | (setq indent (current-indentation))) | ||
| 2394 | next)) | ||
| 2395 | |||
| 2396 | (defun markdown-cur-list-item-end (level) | ||
| 2397 | "Move to end of list item with pre-marker indentation LEVEL. | ||
| 2398 | Return the point at the end when a list item was found at the | ||
| 2399 | original point. If the point is not in a list item, do nothing." | ||
| 2400 | (let (indent) | ||
| 2401 | (forward-line) | ||
| 2402 | (setq indent (current-indentation)) | ||
| 2403 | (while | ||
| 2404 | (cond | ||
| 2405 | ;; Stop at end of the buffer. | ||
| 2406 | ((eobp) nil) | ||
| 2407 | ;; Continue while indentation is the same or greater | ||
| 2408 | ((>= indent level) t) | ||
| 2409 | ;; Continue if the current line is blank | ||
| 2410 | ((looking-at markdown-regex-blank-line) t) | ||
| 2411 | ;; Stop if current indentation is less than list item | ||
| 2412 | ;; and the previous line was blank. | ||
| 2413 | ((and (< indent level) | ||
| 2414 | (markdown-prev-line-blank)) | ||
| 2415 | nil) | ||
| 2416 | ;; Stop at a new list items of the same or lesser | ||
| 2417 | ;; indentation, headings, and horizontal rules. | ||
| 2418 | ((looking-at (concat "\\(?:" markdown-regex-list | ||
| 2419 | "\\|" markdown-regex-header | ||
| 2420 | "\\|" markdown-regex-hr "\\)")) | ||
| 2421 | nil) | ||
| 2422 | ;; Otherwise, continue. | ||
| 2423 | (t t)) | ||
| 2424 | (forward-line) | ||
| 2425 | (setq indent (current-indentation))) | ||
| 2426 | ;; Don't skip over whitespace for empty list items (marker and | ||
| 2427 | ;; whitespace only), just move to end of whitespace. | ||
| 2428 | (if (save-excursion | ||
| 2429 | (beginning-of-line) | ||
| 2430 | (looking-at (concat markdown-regex-list "[ \t]*$"))) | ||
| 2431 | (goto-char (match-end 3)) | ||
| 2432 | (skip-chars-backward " \t\n")) | ||
| 2433 | (end-of-line) | ||
| 2434 | (point))) | ||
| 2435 | |||
| 2436 | (defun markdown-cur-list-item-bounds () | ||
| 2437 | "Return bounds for list item at point. | ||
| 2438 | Return a list of the following form: | ||
| 2439 | |||
| 2440 | (begin end indent nonlist-indent marker checkbox match) | ||
| 2441 | |||
| 2442 | The named components are: | ||
| 2443 | |||
| 2444 | - begin: Position of beginning of list item, including leading indentation. | ||
| 2445 | - end: Position of the end of the list item, including list item text. | ||
| 2446 | - indent: Number of characters of indentation before list marker (an integer). | ||
| 2447 | - nonlist-indent: Number characters of indentation, list | ||
| 2448 | marker, and whitespace following list marker (an integer). | ||
| 2449 | - marker: String containing the list marker and following whitespace | ||
| 2450 | (e.g., \"- \" or \"* \"). | ||
| 2451 | - checkbox: String containing the GFM checkbox portion, if any, | ||
| 2452 | including any trailing whitespace before the text | ||
| 2453 | begins (e.g., \"[x] \"). | ||
| 2454 | - match: match data for markdown-regex-list | ||
| 2455 | |||
| 2456 | As an example, for the following unordered list item | ||
| 2457 | |||
| 2458 | - item | ||
| 2459 | |||
| 2460 | the returned list would be | ||
| 2461 | |||
| 2462 | (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) | ||
| 2463 | |||
| 2464 | If the point is not inside a list item, return nil." | ||
| 2465 | (car (get-text-property (point-at-bol) 'markdown-list-item))) | ||
| 2466 | |||
| 2467 | (defun markdown-list-item-at-point-p () | ||
| 2468 | "Return t if there is a list item at the point and nil otherwise." | ||
| 2469 | (save-match-data (markdown-cur-list-item-bounds))) | ||
| 2470 | |||
| 2471 | (defun markdown-prev-list-item-bounds () | ||
| 2472 | "Return bounds of previous item in the same list of any level. | ||
| 2473 | The return value has the same form as that of | ||
| 2474 | `markdown-cur-list-item-bounds'." | ||
| 2475 | (save-excursion | ||
| 2476 | (let ((cur-bounds (markdown-cur-list-item-bounds)) | ||
| 2477 | (beginning-of-list (save-excursion (markdown-beginning-of-list))) | ||
| 2478 | stop) | ||
| 2479 | (when cur-bounds | ||
| 2480 | (goto-char (nth 0 cur-bounds)) | ||
| 2481 | (while (and (not stop) (not (bobp)) | ||
| 2482 | (re-search-backward markdown-regex-list | ||
| 2483 | beginning-of-list t)) | ||
| 2484 | (unless (or (looking-at markdown-regex-hr) | ||
| 2485 | (markdown-code-block-at-point-p)) | ||
| 2486 | (setq stop (point)))) | ||
| 2487 | (markdown-cur-list-item-bounds))))) | ||
| 2488 | |||
| 2489 | (defun markdown-next-list-item-bounds () | ||
| 2490 | "Return bounds of next item in the same list of any level. | ||
| 2491 | The return value has the same form as that of | ||
| 2492 | `markdown-cur-list-item-bounds'." | ||
| 2493 | (save-excursion | ||
| 2494 | (let ((cur-bounds (markdown-cur-list-item-bounds)) | ||
| 2495 | (end-of-list (save-excursion (markdown-end-of-list))) | ||
| 2496 | stop) | ||
| 2497 | (when cur-bounds | ||
| 2498 | (goto-char (nth 0 cur-bounds)) | ||
| 2499 | (end-of-line) | ||
| 2500 | (while (and (not stop) (not (eobp)) | ||
| 2501 | (re-search-forward markdown-regex-list | ||
| 2502 | end-of-list t)) | ||
| 2503 | (unless (or (looking-at markdown-regex-hr) | ||
| 2504 | (markdown-code-block-at-point-p)) | ||
| 2505 | (setq stop (point)))) | ||
| 2506 | (when stop | ||
| 2507 | (markdown-cur-list-item-bounds)))))) | ||
| 2508 | |||
| 2509 | (defun markdown-beginning-of-list () | ||
| 2510 | "Move point to beginning of list at point, if any." | ||
| 2511 | (interactive) | ||
| 2512 | (let ((orig-point (point)) | ||
| 2513 | (list-begin (save-excursion | ||
| 2514 | (markdown-search-backward-baseline) | ||
| 2515 | ;; Stop at next list item, regardless of the indentation. | ||
| 2516 | (markdown-next-list-item (point-max)) | ||
| 2517 | (when (looking-at markdown-regex-list) | ||
| 2518 | (point))))) | ||
| 2519 | (when (and list-begin (<= list-begin orig-point)) | ||
| 2520 | (goto-char list-begin)))) | ||
| 2521 | |||
| 2522 | (defun markdown-end-of-list () | ||
| 2523 | "Move point to end of list at point, if any." | ||
| 2524 | (interactive) | ||
| 2525 | (let ((start (point)) | ||
| 2526 | (end (save-excursion | ||
| 2527 | (when (markdown-beginning-of-list) | ||
| 2528 | ;; Items can't have nonlist-indent <= 1, so this | ||
| 2529 | ;; moves past all list items. | ||
| 2530 | (markdown-next-list-item 1) | ||
| 2531 | (skip-syntax-backward "-") | ||
| 2532 | (unless (eobp) (forward-char 1)) | ||
| 2533 | (point))))) | ||
| 2534 | (when (and end (>= end start)) | ||
| 2535 | (goto-char end)))) | ||
| 2536 | |||
| 2537 | (defun markdown-up-list () | ||
| 2538 | "Move point to beginning of parent list item." | ||
| 2539 | (interactive) | ||
| 2540 | (let ((cur-bounds (markdown-cur-list-item-bounds))) | ||
| 2541 | (when cur-bounds | ||
| 2542 | (markdown-prev-list-item (1- (nth 3 cur-bounds))) | ||
| 2543 | (let ((up-bounds (markdown-cur-list-item-bounds))) | ||
| 2544 | (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) | ||
| 2545 | (point)))))) | ||
| 2546 | |||
| 2547 | (defun markdown-bounds-of-thing-at-point (thing) | ||
| 2548 | "Call `bounds-of-thing-at-point' for THING with slight modifications. | ||
| 2549 | Does not include trailing newlines when THING is 'line. Handles the | ||
| 2550 | end of buffer case by setting both endpoints equal to the value of | ||
| 2551 | `point-max', since an empty region will trigger empty markup insertion. | ||
| 2552 | Return bounds of form (beg . end) if THING is found, or nil otherwise." | ||
| 2553 | (let* ((bounds (bounds-of-thing-at-point thing)) | ||
| 2554 | (a (car bounds)) | ||
| 2555 | (b (cdr bounds))) | ||
| 2556 | (when bounds | ||
| 2557 | (when (eq thing 'line) | ||
| 2558 | (cond ((and (eobp) (markdown-cur-line-blank-p)) | ||
| 2559 | (setq a b)) | ||
| 2560 | ((char-equal (char-before b) ?\^J) | ||
| 2561 | (setq b (1- b))))) | ||
| 2562 | (cons a b)))) | ||
| 2563 | |||
| 2564 | (defun markdown-reference-definition (reference) | ||
| 2565 | "Find out whether Markdown REFERENCE is defined. | ||
| 2566 | REFERENCE should not include the square brackets. | ||
| 2567 | When REFERENCE is defined, return a list of the form (text start end) | ||
| 2568 | containing the definition text itself followed by the start and end | ||
| 2569 | locations of the text. Otherwise, return nil. | ||
| 2570 | Leave match data for `markdown-regex-reference-definition' | ||
| 2571 | intact additional processing." | ||
| 2572 | (let ((reference (downcase reference))) | ||
| 2573 | (save-excursion | ||
| 2574 | (goto-char (point-min)) | ||
| 2575 | (catch 'found | ||
| 2576 | (while (re-search-forward markdown-regex-reference-definition nil t) | ||
| 2577 | (when (string= reference (downcase (match-string-no-properties 2))) | ||
| 2578 | (throw 'found | ||
| 2579 | (list (match-string-no-properties 5) | ||
| 2580 | (match-beginning 5) (match-end 5))))))))) | ||
| 2581 | |||
| 2582 | (defun markdown-get-defined-references () | ||
| 2583 | "Return all defined reference labels and their line numbers (not including square brackets)." | ||
| 2584 | (save-excursion | ||
| 2585 | (goto-char (point-min)) | ||
| 2586 | (let (refs) | ||
| 2587 | (while (re-search-forward markdown-regex-reference-definition nil t) | ||
| 2588 | (let ((target (match-string-no-properties 2))) | ||
| 2589 | (cl-pushnew | ||
| 2590 | (cons (downcase target) | ||
| 2591 | (markdown-line-number-at-pos (match-beginning 2))) | ||
| 2592 | refs :test #'equal :key #'car))) | ||
| 2593 | (reverse refs)))) | ||
| 2594 | |||
| 2595 | (defun markdown-get-used-uris () | ||
| 2596 | "Return a list of all used URIs in the buffer." | ||
| 2597 | (save-excursion | ||
| 2598 | (goto-char (point-min)) | ||
| 2599 | (let (uris) | ||
| 2600 | (while (re-search-forward | ||
| 2601 | (concat "\\(?:" markdown-regex-link-inline | ||
| 2602 | "\\|" markdown-regex-angle-uri | ||
| 2603 | "\\|" markdown-regex-uri | ||
| 2604 | "\\|" markdown-regex-email | ||
| 2605 | "\\)") | ||
| 2606 | nil t) | ||
| 2607 | (unless (or (markdown-inline-code-at-point-p) | ||
| 2608 | (markdown-code-block-at-point-p)) | ||
| 2609 | (cl-pushnew (or (match-string-no-properties 6) | ||
| 2610 | (match-string-no-properties 10) | ||
| 2611 | (match-string-no-properties 12) | ||
| 2612 | (match-string-no-properties 13)) | ||
| 2613 | uris :test #'equal))) | ||
| 2614 | (reverse uris)))) | ||
| 2615 | |||
| 2616 | (defun markdown-inline-code-at-pos (pos) | ||
| 2617 | "Return non-nil if there is an inline code fragment at POS. | ||
| 2618 | Return nil otherwise. Set match data according to | ||
| 2619 | `markdown-match-code' upon success. | ||
| 2620 | This function searches the block for a code fragment that | ||
| 2621 | contains the point using `markdown-match-code'. We do this | ||
| 2622 | because `thing-at-point-looking-at' does not work reliably with | ||
| 2623 | `markdown-regex-code'. | ||
| 2624 | |||
| 2625 | The match data is set as follows: | ||
| 2626 | Group 1 matches the opening backquotes. | ||
| 2627 | Group 2 matches the code fragment itself, without backquotes. | ||
| 2628 | Group 3 matches the closing backquotes." | ||
| 2629 | (save-excursion | ||
| 2630 | (goto-char pos) | ||
| 2631 | (let ((old-point (point)) | ||
| 2632 | (end-of-block (progn (markdown-end-of-text-block) (point))) | ||
| 2633 | found) | ||
| 2634 | (markdown-beginning-of-text-block) | ||
| 2635 | (while (and (markdown-match-code end-of-block) | ||
| 2636 | (setq found t) | ||
| 2637 | (< (match-end 0) old-point))) | ||
| 2638 | (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) | ||
| 2639 | (and found ; matched something | ||
| 2640 | (<= (match-beginning match-group) old-point) ; match contains old-point | ||
| 2641 | (> (match-end 0) old-point)))))) | ||
| 2642 | |||
| 2643 | (defun markdown-inline-code-at-pos-p (pos) | ||
| 2644 | "Return non-nil if there is an inline code fragment at POS. | ||
| 2645 | Like `markdown-inline-code-at-pos`, but preserves match data." | ||
| 2646 | (save-match-data (markdown-inline-code-at-pos pos))) | ||
| 2647 | |||
| 2648 | (defun markdown-inline-code-at-point () | ||
| 2649 | "Return non-nil if the point is at an inline code fragment. | ||
| 2650 | See `markdown-inline-code-at-pos' for details." | ||
| 2651 | (markdown-inline-code-at-pos (point))) | ||
| 2652 | |||
| 2653 | (defun markdown-inline-code-at-point-p (&optional pos) | ||
| 2654 | "Return non-nil if there is inline code at the POS. | ||
| 2655 | This is a predicate function counterpart to | ||
| 2656 | `markdown-inline-code-at-point' which does not modify the match | ||
| 2657 | data. See `markdown-code-block-at-point-p' for code blocks." | ||
| 2658 | (save-match-data (markdown-inline-code-at-pos (or pos (point))))) | ||
| 2659 | |||
| 2660 | (defun markdown-code-block-at-pos (pos) | ||
| 2661 | "Return match data list if there is a code block at POS. | ||
| 2662 | Uses text properties at the beginning of the line position. | ||
| 2663 | This includes pre blocks, tilde-fenced code blocks, and GFM | ||
| 2664 | quoted code blocks. Return nil otherwise." | ||
| 2665 | (let ((bol (save-excursion (goto-char pos) (point-at-bol)))) | ||
| 2666 | (or (get-text-property bol 'markdown-pre) | ||
| 2667 | (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) | ||
| 2668 | (second (cl-second bounds))) | ||
| 2669 | (if second | ||
| 2670 | ;; chunks are right open | ||
| 2671 | (when (< pos second) | ||
| 2672 | bounds) | ||
| 2673 | bounds))))) | ||
| 2674 | |||
| 2675 | ;; Function was renamed to emphasize that it does not modify match-data. | ||
| 2676 | (defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) | ||
| 2677 | |||
| 2678 | (defun markdown-code-block-at-point-p (&optional pos) | ||
| 2679 | "Return non-nil if there is a code block at the POS. | ||
| 2680 | This includes pre blocks, tilde-fenced code blocks, and GFM | ||
| 2681 | quoted code blocks. This function does not modify the match | ||
| 2682 | data. See `markdown-inline-code-at-point-p' for inline code." | ||
| 2683 | (save-match-data (markdown-code-block-at-pos (or pos (point))))) | ||
| 2684 | |||
| 2685 | (defun markdown-heading-at-point (&optional pos) | ||
| 2686 | "Return non-nil if there is a heading at the POS. | ||
| 2687 | Set match data for `markdown-regex-header'." | ||
| 2688 | (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) | ||
| 2689 | (when match-data | ||
| 2690 | (set-match-data match-data) | ||
| 2691 | t))) | ||
| 2692 | |||
| 2693 | (defun markdown-pipe-at-bol-p () | ||
| 2694 | "Return non-nil if the line begins with a pipe symbol. | ||
| 2695 | This may be useful for tables and Pandoc's line_blocks extension." | ||
| 2696 | (char-equal (char-after (point-at-bol)) ?|)) | ||
| 2697 | |||
| 2698 | |||
| 2699 | ;;; Markdown Font Lock Matching Functions ===================================== | ||
| 2700 | |||
| 2701 | (defun markdown-range-property-any (begin end prop prop-values) | ||
| 2702 | "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. | ||
| 2703 | Also returns t if PROP is a list containing one of the PROP-VALUES. | ||
| 2704 | Return nil otherwise." | ||
| 2705 | (let (props) | ||
| 2706 | (catch 'found | ||
| 2707 | (dolist (loc (number-sequence begin end)) | ||
| 2708 | (when (setq props (get-text-property loc prop)) | ||
| 2709 | (cond ((listp props) | ||
| 2710 | ;; props is a list, check for membership | ||
| 2711 | (dolist (val prop-values) | ||
| 2712 | (when (memq val props) (throw 'found loc)))) | ||
| 2713 | (t | ||
| 2714 | ;; props is a scalar, check for equality | ||
| 2715 | (dolist (val prop-values) | ||
| 2716 | (when (eq val props) (throw 'found loc)))))))))) | ||
| 2717 | |||
| 2718 | (defun markdown-range-properties-exist (begin end props) | ||
| 2719 | (cl-loop | ||
| 2720 | for loc in (number-sequence begin end) | ||
| 2721 | with result = nil | ||
| 2722 | while (not | ||
| 2723 | (setq result | ||
| 2724 | (cl-some (lambda (prop) (get-text-property loc prop)) props))) | ||
| 2725 | finally return result)) | ||
| 2726 | |||
| 2727 | (defun markdown-match-inline-generic (regex last &optional faceless) | ||
| 2728 | "Match inline REGEX from the point to LAST. | ||
| 2729 | When FACELESS is non-nil, do not return matches where faces have been applied." | ||
| 2730 | (when (re-search-forward regex last t) | ||
| 2731 | (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) | ||
| 2732 | (face (and faceless (text-property-not-all | ||
| 2733 | (match-beginning 0) (match-end 0) 'face nil)))) | ||
| 2734 | (cond | ||
| 2735 | ;; In code block: move past it and recursively search again | ||
| 2736 | (bounds | ||
| 2737 | (when (< (goto-char (cl-second bounds)) last) | ||
| 2738 | (markdown-match-inline-generic regex last faceless))) | ||
| 2739 | ;; When faces are found in the match range, skip over the match and | ||
| 2740 | ;; recursively search again. | ||
| 2741 | (face | ||
| 2742 | (when (< (goto-char (match-end 0)) last) | ||
| 2743 | (markdown-match-inline-generic regex last faceless))) | ||
| 2744 | ;; Keep match data and return t when in bounds. | ||
| 2745 | (t | ||
| 2746 | (<= (match-end 0) last)))))) | ||
| 2747 | |||
| 2748 | (defun markdown-match-code (last) | ||
| 2749 | "Match inline code fragments from point to LAST." | ||
| 2750 | (unless (bobp) | ||
| 2751 | (backward-char 1)) | ||
| 2752 | (when (markdown-search-until-condition | ||
| 2753 | (lambda () | ||
| 2754 | (and | ||
| 2755 | ;; Advance point in case of failure, but without exceeding last. | ||
| 2756 | (goto-char (min (1+ (match-beginning 1)) last)) | ||
| 2757 | (not (markdown-in-comment-p (match-beginning 1))) | ||
| 2758 | (not (markdown-in-comment-p (match-end 1))) | ||
| 2759 | (not (markdown-code-block-at-pos (match-beginning 1))))) | ||
| 2760 | markdown-regex-code last t) | ||
| 2761 | (set-match-data (list (match-beginning 1) (match-end 1) | ||
| 2762 | (match-beginning 2) (match-end 2) | ||
| 2763 | (match-beginning 3) (match-end 3) | ||
| 2764 | (match-beginning 4) (match-end 4))) | ||
| 2765 | (goto-char (min (1+ (match-end 0)) last (point-max))) | ||
| 2766 | t)) | ||
| 2767 | |||
| 2768 | (defun markdown--gfm-markup-underscore-p (begin end) | ||
| 2769 | (let ((is-underscore (eql (char-after begin) ?_))) | ||
| 2770 | (if (not is-underscore) | ||
| 2771 | t | ||
| 2772 | (save-excursion | ||
| 2773 | (save-match-data | ||
| 2774 | (goto-char begin) | ||
| 2775 | (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) | ||
| 2776 | (progn | ||
| 2777 | (goto-char end) | ||
| 2778 | (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) | ||
| 2779 | |||
| 2780 | (defun markdown-match-bold (last) | ||
| 2781 | "Match inline bold from the point to LAST." | ||
| 2782 | (when (markdown-match-inline-generic markdown-regex-bold last) | ||
| 2783 | (let ((is-gfm (derived-mode-p 'gfm-mode)) | ||
| 2784 | (begin (match-beginning 2)) | ||
| 2785 | (end (match-end 2))) | ||
| 2786 | (if (or (markdown-inline-code-at-pos-p begin) | ||
| 2787 | (markdown-inline-code-at-pos-p end) | ||
| 2788 | (markdown-in-comment-p) | ||
| 2789 | (markdown-range-property-any | ||
| 2790 | begin begin 'face '(markdown-url-face | ||
| 2791 | markdown-plain-url-face)) | ||
| 2792 | (markdown-range-property-any | ||
| 2793 | begin end 'face '(markdown-hr-face | ||
| 2794 | markdown-math-face)) | ||
| 2795 | (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) | ||
| 2796 | (progn (goto-char (min (1+ begin) last)) | ||
| 2797 | (when (< (point) last) | ||
| 2798 | (markdown-match-bold last))) | ||
| 2799 | (set-match-data (list (match-beginning 2) (match-end 2) | ||
| 2800 | (match-beginning 3) (match-end 3) | ||
| 2801 | (match-beginning 4) (match-end 4) | ||
| 2802 | (match-beginning 5) (match-end 5))) | ||
| 2803 | t)))) | ||
| 2804 | |||
| 2805 | (defun markdown-match-italic (last) | ||
| 2806 | "Match inline italics from the point to LAST." | ||
| 2807 | (let* ((is-gfm (derived-mode-p 'gfm-mode)) | ||
| 2808 | (regex (if is-gfm | ||
| 2809 | markdown-regex-gfm-italic | ||
| 2810 | markdown-regex-italic))) | ||
| 2811 | (when (and (markdown-match-inline-generic regex last) | ||
| 2812 | (not (markdown--face-p | ||
| 2813 | (match-beginning 1) | ||
| 2814 | '(markdown-html-attr-name-face markdown-html-attr-value-face)))) | ||
| 2815 | (let ((begin (match-beginning 1)) | ||
| 2816 | (end (match-end 1)) | ||
| 2817 | (close-end (match-end 4))) | ||
| 2818 | (if (or (eql (char-before begin) (char-after begin)) | ||
| 2819 | (markdown-inline-code-at-pos-p begin) | ||
| 2820 | (markdown-inline-code-at-pos-p (1- end)) | ||
| 2821 | (markdown-in-comment-p) | ||
| 2822 | (markdown-range-property-any | ||
| 2823 | begin begin 'face '(markdown-url-face | ||
| 2824 | markdown-plain-url-face)) | ||
| 2825 | (markdown-range-property-any | ||
| 2826 | begin end 'face '(markdown-bold-face | ||
| 2827 | markdown-list-face | ||
| 2828 | markdown-hr-face | ||
| 2829 | markdown-math-face)) | ||
| 2830 | (and is-gfm | ||
| 2831 | (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case | ||
| 2832 | (not (markdown--gfm-markup-underscore-p begin close-end))))) | ||
| 2833 | (progn (goto-char (min (1+ begin) last)) | ||
| 2834 | (when (< (point) last) | ||
| 2835 | (markdown-match-italic last))) | ||
| 2836 | (set-match-data (list (match-beginning 1) (match-end 1) | ||
| 2837 | (match-beginning 2) (match-end 2) | ||
| 2838 | (match-beginning 3) (match-end 3) | ||
| 2839 | (match-beginning 4) (match-end 4))) | ||
| 2840 | t))))) | ||
| 2841 | |||
| 2842 | (defun markdown-match-math-generic (regex last) | ||
| 2843 | "Match REGEX from point to LAST. | ||
| 2844 | REGEX is either `markdown-regex-math-inline-single' for matching | ||
| 2845 | $..$ or `markdown-regex-math-inline-double' for matching $$..$$." | ||
| 2846 | (when (markdown-match-inline-generic regex last) | ||
| 2847 | (let ((begin (match-beginning 1)) (end (match-end 1))) | ||
| 2848 | (prog1 | ||
| 2849 | (if (or (markdown-range-property-any | ||
| 2850 | begin end 'face | ||
| 2851 | '(markdown-inline-code-face markdown-bold-face)) | ||
| 2852 | (markdown-range-properties-exist | ||
| 2853 | begin end | ||
| 2854 | (markdown-get-fenced-block-middle-properties))) | ||
| 2855 | (markdown-match-math-generic regex last) | ||
| 2856 | t) | ||
| 2857 | (goto-char (1+ (match-end 0))))))) | ||
| 2858 | |||
| 2859 | (defun markdown-match-list-items (last) | ||
| 2860 | "Match list items from point to LAST." | ||
| 2861 | (let* ((first (point)) | ||
| 2862 | (pos first) | ||
| 2863 | (prop 'markdown-list-item) | ||
| 2864 | (bounds (car (get-text-property pos prop)))) | ||
| 2865 | (while | ||
| 2866 | (and (or (null (setq bounds (car (get-text-property pos prop)))) | ||
| 2867 | (< (cl-first bounds) pos)) | ||
| 2868 | (< (point) last) | ||
| 2869 | (setq pos (next-single-property-change pos prop nil last)) | ||
| 2870 | (goto-char pos))) | ||
| 2871 | (when bounds | ||
| 2872 | (set-match-data (cl-seventh bounds)) | ||
| 2873 | ;; Step at least one character beyond point. Otherwise | ||
| 2874 | ;; `font-lock-fontify-keywords-region' infloops. | ||
| 2875 | (goto-char (min (1+ (max (point-at-eol) first)) | ||
| 2876 | (point-max))) | ||
| 2877 | t))) | ||
| 2878 | |||
| 2879 | (defun markdown-match-math-single (last) | ||
| 2880 | "Match single quoted $..$ math from point to LAST." | ||
| 2881 | (when markdown-enable-math | ||
| 2882 | (when (and (char-equal (char-after) ?$) | ||
| 2883 | (not (bolp)) | ||
| 2884 | (not (char-equal (char-before) ?\\)) | ||
| 2885 | (not (char-equal (char-before) ?$))) | ||
| 2886 | (forward-char -1)) | ||
| 2887 | (markdown-match-math-generic markdown-regex-math-inline-single last))) | ||
| 2888 | |||
| 2889 | (defun markdown-match-math-double (last) | ||
| 2890 | "Match double quoted $$..$$ math from point to LAST." | ||
| 2891 | (when markdown-enable-math | ||
| 2892 | (when (and (char-equal (char-after) ?$) | ||
| 2893 | (char-equal (char-after (1+ (point))) ?$) | ||
| 2894 | (not (bolp)) | ||
| 2895 | (not (char-equal (char-before) ?\\)) | ||
| 2896 | (not (char-equal (char-before) ?$))) | ||
| 2897 | (forward-char -1)) | ||
| 2898 | (markdown-match-math-generic markdown-regex-math-inline-double last))) | ||
| 2899 | |||
| 2900 | (defun markdown-match-math-display (last) | ||
| 2901 | "Match bracketed display math \[..\] and \\[..\\] from point to LAST." | ||
| 2902 | (when markdown-enable-math | ||
| 2903 | (markdown-match-math-generic markdown-regex-math-display last))) | ||
| 2904 | |||
| 2905 | (defun markdown-match-propertized-text (property last) | ||
| 2906 | "Match text with PROPERTY from point to LAST. | ||
| 2907 | Restore match data previously stored in PROPERTY." | ||
| 2908 | (let ((saved (get-text-property (point) property)) | ||
| 2909 | pos) | ||
| 2910 | (unless saved | ||
| 2911 | (setq pos (next-single-property-change (point) property nil last)) | ||
| 2912 | (unless (= pos last) | ||
| 2913 | (setq saved (get-text-property pos property)))) | ||
| 2914 | (when saved | ||
| 2915 | (set-match-data saved) | ||
| 2916 | ;; Step at least one character beyond point. Otherwise | ||
| 2917 | ;; `font-lock-fontify-keywords-region' infloops. | ||
| 2918 | (goto-char (min (1+ (max (match-end 0) (point))) | ||
| 2919 | (point-max))) | ||
| 2920 | saved))) | ||
| 2921 | |||
| 2922 | (defun markdown-match-pre-blocks (last) | ||
| 2923 | "Match preformatted blocks from point to LAST. | ||
| 2924 | Use data stored in 'markdown-pre text property during syntax | ||
| 2925 | analysis." | ||
| 2926 | (markdown-match-propertized-text 'markdown-pre last)) | ||
| 2927 | |||
| 2928 | (defun markdown-match-gfm-code-blocks (last) | ||
| 2929 | "Match GFM quoted code blocks from point to LAST. | ||
| 2930 | Use data stored in 'markdown-gfm-code text property during syntax | ||
| 2931 | analysis." | ||
| 2932 | (markdown-match-propertized-text 'markdown-gfm-code last)) | ||
| 2933 | |||
| 2934 | (defun markdown-match-gfm-open-code-blocks (last) | ||
| 2935 | (markdown-match-propertized-text 'markdown-gfm-block-begin last)) | ||
| 2936 | |||
| 2937 | (defun markdown-match-gfm-close-code-blocks (last) | ||
| 2938 | (markdown-match-propertized-text 'markdown-gfm-block-end last)) | ||
| 2939 | |||
| 2940 | (defun markdown-match-fenced-code-blocks (last) | ||
| 2941 | "Match fenced code blocks from the point to LAST." | ||
| 2942 | (markdown-match-propertized-text 'markdown-fenced-code last)) | ||
| 2943 | |||
| 2944 | (defun markdown-match-fenced-start-code-block (last) | ||
| 2945 | (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) | ||
| 2946 | |||
| 2947 | (defun markdown-match-fenced-end-code-block (last) | ||
| 2948 | (markdown-match-propertized-text 'markdown-tilde-fence-end last)) | ||
| 2949 | |||
| 2950 | (defun markdown-match-blockquotes (last) | ||
| 2951 | "Match blockquotes from point to LAST. | ||
| 2952 | Use data stored in 'markdown-blockquote text property during syntax | ||
| 2953 | analysis." | ||
| 2954 | (markdown-match-propertized-text 'markdown-blockquote last)) | ||
| 2955 | |||
| 2956 | (defun markdown-match-hr (last) | ||
| 2957 | "Match horizontal rules comments from the point to LAST." | ||
| 2958 | (markdown-match-propertized-text 'markdown-hr last)) | ||
| 2959 | |||
| 2960 | (defun markdown-match-comments (last) | ||
| 2961 | "Match HTML comments from the point to LAST." | ||
| 2962 | (when (and (skip-syntax-forward "^<" last)) | ||
| 2963 | (let ((beg (point))) | ||
| 2964 | (when (and (skip-syntax-forward "^>" last) (< (point) last)) | ||
| 2965 | (forward-char) | ||
| 2966 | (set-match-data (list beg (point))) | ||
| 2967 | t)))) | ||
| 2968 | |||
| 2969 | (defun markdown-match-generic-links (last ref) | ||
| 2970 | "Match inline links from point to LAST. | ||
| 2971 | When REF is non-nil, match reference links instead of standard | ||
| 2972 | links with URLs. | ||
| 2973 | This function should only be used during font-lock, as it | ||
| 2974 | determines syntax based on the presence of faces for previously | ||
| 2975 | processed elements." | ||
| 2976 | ;; Search for the next potential link (not in a code block). | ||
| 2977 | (let ((prohibited-faces '(markdown-pre-face | ||
| 2978 | markdown-code-face | ||
| 2979 | markdown-inline-code-face | ||
| 2980 | markdown-comment-face)) | ||
| 2981 | found) | ||
| 2982 | (while | ||
| 2983 | (and (not found) (< (point) last) | ||
| 2984 | (progn | ||
| 2985 | ;; Clear match data to test for a match after functions returns. | ||
| 2986 | (set-match-data nil) | ||
| 2987 | ;; Preliminary regular expression search so we can return | ||
| 2988 | ;; quickly upon failure. This doesn't handle malformed links | ||
| 2989 | ;; or nested square brackets well, so if it passes we back up | ||
| 2990 | ;; continue with a more precise search. | ||
| 2991 | (re-search-forward | ||
| 2992 | (if ref | ||
| 2993 | markdown-regex-link-reference | ||
| 2994 | markdown-regex-link-inline) | ||
| 2995 | last 'limit))) | ||
| 2996 | ;; Keep searching if this is in a code block, inline code, or a | ||
| 2997 | ;; comment, or if it is include syntax. The link text portion | ||
| 2998 | ;; (group 3) may contain inline code or comments, but the | ||
| 2999 | ;; markup, URL, and title should not be part of such elements. | ||
| 3000 | (if (or (markdown-range-property-any | ||
| 3001 | (match-beginning 0) (match-end 2) 'face prohibited-faces) | ||
| 3002 | (markdown-range-property-any | ||
| 3003 | (match-beginning 4) (match-end 0) 'face prohibited-faces) | ||
| 3004 | (and (char-equal (char-after (point-at-bol)) ?<) | ||
| 3005 | (char-equal (char-after (1+ (point-at-bol))) ?<))) | ||
| 3006 | (set-match-data nil) | ||
| 3007 | (setq found t)))) | ||
| 3008 | ;; Match opening exclamation point (optional) and left bracket. | ||
| 3009 | (when (match-beginning 2) | ||
| 3010 | (let* ((bang (match-beginning 1)) | ||
| 3011 | (first-begin (match-beginning 2)) | ||
| 3012 | ;; Find end of block to prevent matching across blocks. | ||
| 3013 | (end-of-block (save-excursion | ||
| 3014 | (progn | ||
| 3015 | (goto-char (match-beginning 2)) | ||
| 3016 | (markdown-end-of-text-block) | ||
| 3017 | (point)))) | ||
| 3018 | ;; Move over balanced expressions to closing right bracket. | ||
| 3019 | ;; Catch unbalanced expression errors and return nil. | ||
| 3020 | (first-end (condition-case nil | ||
| 3021 | (and (goto-char first-begin) | ||
| 3022 | (scan-sexps (point) 1)) | ||
| 3023 | (error nil))) | ||
| 3024 | ;; Continue with point at CONT-POINT upon failure. | ||
| 3025 | (cont-point (min (1+ first-begin) last)) | ||
| 3026 | second-begin second-end url-begin url-end | ||
| 3027 | title-begin title-end) | ||
| 3028 | ;; When bracket found, in range, and followed by a left paren/bracket... | ||
| 3029 | (when (and first-end (< first-end end-of-block) (goto-char first-end) | ||
| 3030 | (char-equal (char-after (point)) (if ref ?\[ ?\())) | ||
| 3031 | ;; Scan across balanced expressions for closing parenthesis/bracket. | ||
| 3032 | (setq second-begin (point) | ||
| 3033 | second-end (condition-case nil | ||
| 3034 | (scan-sexps (point) 1) | ||
| 3035 | (error nil))) | ||
| 3036 | ;; Check that closing parenthesis/bracket is in range. | ||
| 3037 | (if (and second-end (<= second-end end-of-block) (<= second-end last)) | ||
| 3038 | (progn | ||
| 3039 | ;; Search for (optional) title inside closing parenthesis | ||
| 3040 | (when (and (not ref) (search-forward "\"" second-end t)) | ||
| 3041 | (setq title-begin (1- (point)) | ||
| 3042 | title-end (and (goto-char second-end) | ||
| 3043 | (search-backward "\"" (1+ title-begin) t)) | ||
| 3044 | title-end (and title-end (1+ title-end)))) | ||
| 3045 | ;; Store URL/reference range | ||
| 3046 | (setq url-begin (1+ second-begin) | ||
| 3047 | url-end (1- (or title-begin second-end))) | ||
| 3048 | ;; Set match data, move point beyond link, and return | ||
| 3049 | (set-match-data | ||
| 3050 | (list (or bang first-begin) second-end ; 0 - all | ||
| 3051 | bang (and bang (1+ bang)) ; 1 - bang | ||
| 3052 | first-begin (1+ first-begin) ; 2 - markup | ||
| 3053 | (1+ first-begin) (1- first-end) ; 3 - link text | ||
| 3054 | (1- first-end) first-end ; 4 - markup | ||
| 3055 | second-begin (1+ second-begin) ; 5 - markup | ||
| 3056 | url-begin url-end ; 6 - url/reference | ||
| 3057 | title-begin title-end ; 7 - title | ||
| 3058 | (1- second-end) second-end)) ; 8 - markup | ||
| 3059 | ;; Nullify cont-point and leave point at end and | ||
| 3060 | (setq cont-point nil) | ||
| 3061 | (goto-char second-end)) | ||
| 3062 | ;; If no closing parenthesis in range, update continuation point | ||
| 3063 | (setq cont-point (min end-of-block second-begin)))) | ||
| 3064 | (cond | ||
| 3065 | ;; On failure, continue searching at cont-point | ||
| 3066 | ((and cont-point (< cont-point last)) | ||
| 3067 | (goto-char cont-point) | ||
| 3068 | (markdown-match-generic-links last ref)) | ||
| 3069 | ;; No more text, return nil | ||
| 3070 | ((and cont-point (= cont-point last)) | ||
| 3071 | nil) | ||
| 3072 | ;; Return t if a match occurred | ||
| 3073 | (t t))))) | ||
| 3074 | |||
| 3075 | (defun markdown-match-angle-uris (last) | ||
| 3076 | "Match angle bracket URIs from point to LAST." | ||
| 3077 | (when (markdown-match-inline-generic markdown-regex-angle-uri last) | ||
| 3078 | (goto-char (1+ (match-end 0))))) | ||
| 3079 | |||
| 3080 | (defun markdown-match-plain-uris (last) | ||
| 3081 | "Match plain URIs from point to LAST." | ||
| 3082 | (when (markdown-match-inline-generic markdown-regex-uri last t) | ||
| 3083 | (goto-char (1+ (match-end 0))))) | ||
| 3084 | |||
| 3085 | (defvar markdown-conditional-search-function #'re-search-forward | ||
| 3086 | "Conditional search function used in `markdown-search-until-condition'. | ||
| 3087 | Made into a variable to allow for dynamic let-binding.") | ||
| 3088 | |||
| 3089 | (defun markdown-search-until-condition (condition &rest args) | ||
| 3090 | (let (ret) | ||
| 3091 | (while (and (not ret) (apply markdown-conditional-search-function args)) | ||
| 3092 | (setq ret (funcall condition))) | ||
| 3093 | ret)) | ||
| 3094 | |||
| 3095 | (defun markdown-metadata-line-p (pos regexp) | ||
| 3096 | (save-excursion | ||
| 3097 | (or (= (line-number-at-pos pos) 1) | ||
| 3098 | (progn | ||
| 3099 | (forward-line -1) | ||
| 3100 | ;; skip multi-line metadata | ||
| 3101 | (while (and (looking-at-p "^\\s-+[[:alpha:]]") | ||
| 3102 | (> (line-number-at-pos (point)) 1)) | ||
| 3103 | (forward-line -1)) | ||
| 3104 | (looking-at-p regexp))))) | ||
| 3105 | |||
| 3106 | (defun markdown-match-generic-metadata (regexp last) | ||
| 3107 | "Match metadata declarations specified by REGEXP from point to LAST. | ||
| 3108 | These declarations must appear inside a metadata block that begins at | ||
| 3109 | the beginning of the buffer and ends with a blank line (or the end of | ||
| 3110 | the buffer)." | ||
| 3111 | (let* ((first (point)) | ||
| 3112 | (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") | ||
| 3113 | (block-begin (goto-char 1)) | ||
| 3114 | (block-end (re-search-forward end-re nil t))) | ||
| 3115 | (if (and block-end (> first block-end)) | ||
| 3116 | ;; Don't match declarations if there is no metadata block or if | ||
| 3117 | ;; the point is beyond the block. Move point to point-max to | ||
| 3118 | ;; prevent additional searches and return return nil since nothing | ||
| 3119 | ;; was found. | ||
| 3120 | (progn (goto-char (point-max)) nil) | ||
| 3121 | ;; If a block was found that begins before LAST and ends after | ||
| 3122 | ;; point, search for declarations inside it. If the starting is | ||
| 3123 | ;; before the beginning of the block, start there. Otherwise, | ||
| 3124 | ;; move back to FIRST. | ||
| 3125 | (goto-char (if (< first block-begin) block-begin first)) | ||
| 3126 | (if (and (re-search-forward regexp (min last block-end) t) | ||
| 3127 | (markdown-metadata-line-p (point) regexp)) | ||
| 3128 | ;; If a metadata declaration is found, set match-data and return t. | ||
| 3129 | (let ((key-beginning (match-beginning 1)) | ||
| 3130 | (key-end (match-end 1)) | ||
| 3131 | (markup-begin (match-beginning 2)) | ||
| 3132 | (markup-end (match-end 2)) | ||
| 3133 | (value-beginning (match-beginning 3))) | ||
| 3134 | (set-match-data (list key-beginning (point) ; complete metadata | ||
| 3135 | key-beginning key-end ; key | ||
| 3136 | markup-begin markup-end ; markup | ||
| 3137 | value-beginning (point))) ; value | ||
| 3138 | t) | ||
| 3139 | ;; Otherwise, move the point to last and return nil | ||
| 3140 | (goto-char last) | ||
| 3141 | nil)))) | ||
| 3142 | |||
| 3143 | (defun markdown-match-declarative-metadata (last) | ||
| 3144 | "Match declarative metadata from the point to LAST." | ||
| 3145 | (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) | ||
| 3146 | |||
| 3147 | (defun markdown-match-pandoc-metadata (last) | ||
| 3148 | "Match Pandoc metadata from the point to LAST." | ||
| 3149 | (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) | ||
| 3150 | |||
| 3151 | (defun markdown-match-yaml-metadata-begin (last) | ||
| 3152 | (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) | ||
| 3153 | |||
| 3154 | (defun markdown-match-yaml-metadata-end (last) | ||
| 3155 | (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) | ||
| 3156 | |||
| 3157 | (defun markdown-match-yaml-metadata-key (last) | ||
| 3158 | (markdown-match-propertized-text 'markdown-metadata-key last)) | ||
| 3159 | |||
| 3160 | (defun markdown-match-wiki-link (last) | ||
| 3161 | "Match wiki links from point to LAST." | ||
| 3162 | (when (and markdown-enable-wiki-links | ||
| 3163 | (not markdown-wiki-link-fontify-missing) | ||
| 3164 | (markdown-match-inline-generic markdown-regex-wiki-link last)) | ||
| 3165 | (let ((begin (match-beginning 1)) (end (match-end 1))) | ||
| 3166 | (if (or (markdown-in-comment-p begin) | ||
| 3167 | (markdown-in-comment-p end) | ||
| 3168 | (markdown-inline-code-at-pos-p begin) | ||
| 3169 | (markdown-inline-code-at-pos-p end) | ||
| 3170 | (markdown-code-block-at-pos begin)) | ||
| 3171 | (progn (goto-char (min (1+ begin) last)) | ||
| 3172 | (when (< (point) last) | ||
| 3173 | (markdown-match-wiki-link last))) | ||
| 3174 | (set-match-data (list begin end)) | ||
| 3175 | t)))) | ||
| 3176 | |||
| 3177 | (defun markdown-match-inline-attributes (last) | ||
| 3178 | "Match inline attributes from point to LAST." | ||
| 3179 | ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. | ||
| 3180 | ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes | ||
| 3181 | ;; against matched string. | ||
| 3182 | (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) | ||
| 3183 | (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) | ||
| 3184 | (markdown-match-inline-attributes last) | ||
| 3185 | (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) | ||
| 3186 | (markdown-inline-code-at-pos-p (match-end 0)) | ||
| 3187 | (markdown-in-comment-p)) | ||
| 3188 | t)))) | ||
| 3189 | |||
| 3190 | (defun markdown-match-leanpub-sections (last) | ||
| 3191 | "Match Leanpub section markers from point to LAST." | ||
| 3192 | (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) | ||
| 3193 | (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) | ||
| 3194 | (markdown-inline-code-at-pos-p (match-end 0)) | ||
| 3195 | (markdown-in-comment-p)) | ||
| 3196 | t))) | ||
| 3197 | |||
| 3198 | (defun markdown-match-includes (last) | ||
| 3199 | "Match include statements from point to LAST. | ||
| 3200 | Sets match data for the following seven groups: | ||
| 3201 | Group 1: opening two angle brackets | ||
| 3202 | Group 2: opening title delimiter (optional) | ||
| 3203 | Group 3: title text (optional) | ||
| 3204 | Group 4: closing title delimiter (optional) | ||
| 3205 | Group 5: opening filename delimiter | ||
| 3206 | Group 6: filename | ||
| 3207 | Group 7: closing filename delimiter" | ||
| 3208 | (when (markdown-match-inline-generic markdown-regex-include last) | ||
| 3209 | (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) | ||
| 3210 | (markdown-in-comment-p (match-end 0)) | ||
| 3211 | (markdown-code-block-at-pos (match-beginning 0)))))) | ||
| 3212 | (cond | ||
| 3213 | ;; Parentheses and maybe square brackets, but no curly braces: | ||
| 3214 | ;; match optional title in square brackets and file in parentheses. | ||
| 3215 | ((and valid (match-beginning 5) | ||
| 3216 | (not (match-beginning 8))) | ||
| 3217 | (set-match-data (list (match-beginning 1) (match-end 7) | ||
| 3218 | (match-beginning 1) (match-end 1) | ||
| 3219 | (match-beginning 2) (match-end 2) | ||
| 3220 | (match-beginning 3) (match-end 3) | ||
| 3221 | (match-beginning 4) (match-end 4) | ||
| 3222 | (match-beginning 5) (match-end 5) | ||
| 3223 | (match-beginning 6) (match-end 6) | ||
| 3224 | (match-beginning 7) (match-end 7)))) | ||
| 3225 | ;; Only square brackets present: match file in square brackets. | ||
| 3226 | ((and valid (match-beginning 2) | ||
| 3227 | (not (match-beginning 5)) | ||
| 3228 | (not (match-beginning 7))) | ||
| 3229 | (set-match-data (list (match-beginning 1) (match-end 4) | ||
| 3230 | (match-beginning 1) (match-end 1) | ||
| 3231 | nil nil | ||
| 3232 | nil nil | ||
| 3233 | nil nil | ||
| 3234 | (match-beginning 2) (match-end 2) | ||
| 3235 | (match-beginning 3) (match-end 3) | ||
| 3236 | (match-beginning 4) (match-end 4)))) | ||
| 3237 | ;; Only curly braces present: match file in curly braces. | ||
| 3238 | ((and valid (match-beginning 8) | ||
| 3239 | (not (match-beginning 2)) | ||
| 3240 | (not (match-beginning 5))) | ||
| 3241 | (set-match-data (list (match-beginning 1) (match-end 10) | ||
| 3242 | (match-beginning 1) (match-end 1) | ||
| 3243 | nil nil | ||
| 3244 | nil nil | ||
| 3245 | nil nil | ||
| 3246 | (match-beginning 8) (match-end 8) | ||
| 3247 | (match-beginning 9) (match-end 9) | ||
| 3248 | (match-beginning 10) (match-end 10)))) | ||
| 3249 | (t | ||
| 3250 | ;; Not a valid match, move to next line and search again. | ||
| 3251 | (forward-line) | ||
| 3252 | (when (< (point) last) | ||
| 3253 | (setq valid (markdown-match-includes last))))) | ||
| 3254 | valid))) | ||
| 3255 | |||
| 3256 | (defun markdown-match-html-tag (last) | ||
| 3257 | "Match HTML tags from point to LAST." | ||
| 3258 | (when (and markdown-enable-html | ||
| 3259 | (markdown-match-inline-generic markdown-regex-html-tag last t)) | ||
| 3260 | (set-match-data (list (match-beginning 0) (match-end 0) | ||
| 3261 | (match-beginning 1) (match-end 1) | ||
| 3262 | (match-beginning 2) (match-end 2) | ||
| 3263 | (match-beginning 9) (match-end 9))) | ||
| 3264 | t)) | ||
| 3265 | |||
| 3266 | |||
| 3267 | ;;; Markdown Font Fontification Functions ===================================== | ||
| 3268 | |||
| 3269 | (defun markdown--first-displayable (seq) | ||
| 3270 | "Return the first displayable character or string in SEQ. | ||
| 3271 | SEQ may be an atom or a sequence." | ||
| 3272 | (let ((seq (if (listp seq) seq (list seq)))) | ||
| 3273 | (cond ((stringp (car seq)) | ||
| 3274 | (cl-find-if | ||
| 3275 | (lambda (str) | ||
| 3276 | (and (mapcar #'char-displayable-p (string-to-list str)))) | ||
| 3277 | seq)) | ||
| 3278 | ((characterp (car seq)) | ||
| 3279 | (cl-find-if #'char-displayable-p seq))))) | ||
| 3280 | |||
| 3281 | (defun markdown--marginalize-string (level) | ||
| 3282 | "Generate atx markup string of given LEVEL for left margin." | ||
| 3283 | (let ((margin-left-space-count | ||
| 3284 | (- markdown-marginalize-headers-margin-width level))) | ||
| 3285 | (concat (make-string margin-left-space-count ? ) | ||
| 3286 | (make-string level ?#)))) | ||
| 3287 | |||
| 3288 | (defun markdown-marginalize-update-current () | ||
| 3289 | "Update the window configuration to create a left margin." | ||
| 3290 | (if window-system | ||
| 3291 | (let* ((header-delimiter-font-width | ||
| 3292 | (window-font-width nil 'markdown-header-delimiter-face)) | ||
| 3293 | (margin-pixel-width (* markdown-marginalize-headers-margin-width | ||
| 3294 | header-delimiter-font-width)) | ||
| 3295 | (margin-char-width (/ margin-pixel-width (default-font-width)))) | ||
| 3296 | (set-window-margins nil margin-char-width)) | ||
| 3297 | ;; As a fallback, simply set margin based on character count. | ||
| 3298 | (set-window-margins nil markdown-marginalize-headers-margin-width))) | ||
| 3299 | |||
| 3300 | (defun markdown-fontify-headings (last) | ||
| 3301 | "Add text properties to headings from point to LAST." | ||
| 3302 | (when (markdown-match-propertized-text 'markdown-heading last) | ||
| 3303 | (let* ((level (markdown-outline-level)) | ||
| 3304 | (heading-face | ||
| 3305 | (intern (format "markdown-header-face-%d" level))) | ||
| 3306 | (heading-props `(face ,heading-face)) | ||
| 3307 | (left-markup-props | ||
| 3308 | `(face markdown-header-delimiter-face | ||
| 3309 | ,@(cond | ||
| 3310 | (markdown-hide-markup | ||
| 3311 | `(display "")) | ||
| 3312 | (markdown-marginalize-headers | ||
| 3313 | `(display ((margin left-margin) | ||
| 3314 | ,(markdown--marginalize-string level))))))) | ||
| 3315 | (right-markup-props | ||
| 3316 | `(face markdown-header-delimiter-face | ||
| 3317 | ,@(when markdown-hide-markup `(display "")))) | ||
| 3318 | (rule-props `(face markdown-header-rule-face | ||
| 3319 | ,@(when markdown-hide-markup `(display ""))))) | ||
| 3320 | (if (match-end 1) | ||
| 3321 | ;; Setext heading | ||
| 3322 | (progn (add-text-properties | ||
| 3323 | (match-beginning 1) (match-end 1) heading-props) | ||
| 3324 | (if (= level 1) | ||
| 3325 | (add-text-properties | ||
| 3326 | (match-beginning 2) (match-end 2) rule-props) | ||
| 3327 | (add-text-properties | ||
| 3328 | (match-beginning 3) (match-end 3) rule-props))) | ||
| 3329 | ;; atx heading | ||
| 3330 | (add-text-properties | ||
| 3331 | (match-beginning 4) (match-end 4) left-markup-props) | ||
| 3332 | (add-text-properties | ||
| 3333 | (match-beginning 5) (match-end 5) heading-props) | ||
| 3334 | (when (match-end 6) | ||
| 3335 | (add-text-properties | ||
| 3336 | (match-beginning 6) (match-end 6) right-markup-props)))) | ||
| 3337 | t)) | ||
| 3338 | |||
| 3339 | (defun markdown-fontify-tables (last) | ||
| 3340 | (when (and (re-search-forward "|" last t) | ||
| 3341 | (markdown-table-at-point-p)) | ||
| 3342 | (font-lock-append-text-property | ||
| 3343 | (line-beginning-position) (min (1+ (line-end-position)) (point-max)) | ||
| 3344 | 'face 'markdown-table-face) | ||
| 3345 | (forward-line 1) | ||
| 3346 | t)) | ||
| 3347 | |||
| 3348 | (defun markdown-fontify-blockquotes (last) | ||
| 3349 | "Apply font-lock properties to blockquotes from point to LAST." | ||
| 3350 | (when (markdown-match-blockquotes last) | ||
| 3351 | (let ((display-string | ||
| 3352 | (markdown--first-displayable markdown-blockquote-display-char))) | ||
| 3353 | (add-text-properties | ||
| 3354 | (match-beginning 1) (match-end 1) | ||
| 3355 | (if markdown-hide-markup | ||
| 3356 | `(face markdown-blockquote-face display ,display-string) | ||
| 3357 | `(face markdown-markup-face))) | ||
| 3358 | (font-lock-append-text-property | ||
| 3359 | (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) | ||
| 3360 | t))) | ||
| 3361 | |||
| 3362 | (defun markdown-fontify-list-items (last) | ||
| 3363 | "Apply font-lock properties to list markers from point to LAST." | ||
| 3364 | (when (markdown-match-list-items last) | ||
| 3365 | (let* ((indent (length (match-string-no-properties 1))) | ||
| 3366 | (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... | ||
| 3367 | (bullet (nth (mod level (length markdown-list-item-bullets)) | ||
| 3368 | markdown-list-item-bullets))) | ||
| 3369 | (add-text-properties | ||
| 3370 | (match-beginning 2) (match-end 2) '(face markdown-list-face)) | ||
| 3371 | (when markdown-hide-markup | ||
| 3372 | (cond | ||
| 3373 | ;; Unordered lists | ||
| 3374 | ((string-match-p "[\\*\\+-]" (match-string 2)) | ||
| 3375 | (add-text-properties | ||
| 3376 | (match-beginning 2) (match-end 2) `(display ,bullet))) | ||
| 3377 | ;; Definition lists | ||
| 3378 | ((string-equal ":" (match-string 2)) | ||
| 3379 | (let ((display-string | ||
| 3380 | (char-to-string (markdown--first-displayable | ||
| 3381 | markdown-definition-display-char)))) | ||
| 3382 | (add-text-properties (match-beginning 2) (match-end 2) | ||
| 3383 | `(display ,display-string))))))) | ||
| 3384 | t)) | ||
| 3385 | |||
| 3386 | (defun markdown-fontify-hrs (last) | ||
| 3387 | "Add text properties to horizontal rules from point to LAST." | ||
| 3388 | (when (markdown-match-hr last) | ||
| 3389 | (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) | ||
| 3390 | (add-text-properties | ||
| 3391 | (match-beginning 0) (match-end 0) | ||
| 3392 | `(face markdown-hr-face | ||
| 3393 | font-lock-multiline t | ||
| 3394 | ,@(when (and markdown-hide-markup hr-char) | ||
| 3395 | `(display ,(make-string | ||
| 3396 | (window-body-width) hr-char))))) | ||
| 3397 | t))) | ||
| 3398 | |||
| 3399 | (defun markdown-fontify-sub-superscripts (last) | ||
| 3400 | "Apply text properties to sub- and superscripts from point to LAST." | ||
| 3401 | (when (markdown-search-until-condition | ||
| 3402 | (lambda () (and (not (markdown-code-block-at-point-p)) | ||
| 3403 | (not (markdown-inline-code-at-point-p)) | ||
| 3404 | (not (markdown-in-comment-p)))) | ||
| 3405 | markdown-regex-sub-superscript last t) | ||
| 3406 | (let* ((subscript-p (string= (match-string 2) "~")) | ||
| 3407 | (props | ||
| 3408 | (if subscript-p | ||
| 3409 | (car markdown-sub-superscript-display) | ||
| 3410 | (cdr markdown-sub-superscript-display))) | ||
| 3411 | (mp (list 'face 'markdown-markup-face | ||
| 3412 | 'invisible 'markdown-markup))) | ||
| 3413 | (when markdown-hide-markup | ||
| 3414 | (put-text-property (match-beginning 3) (match-end 3) | ||
| 3415 | 'display props)) | ||
| 3416 | (add-text-properties (match-beginning 2) (match-end 2) mp) | ||
| 3417 | (add-text-properties (match-beginning 4) (match-end 4) mp) | ||
| 3418 | t))) | ||
| 3419 | |||
| 3420 | |||
| 3421 | ;;; Syntax Table ============================================================== | ||
| 3422 | |||
| 3423 | (defvar markdown-mode-syntax-table | ||
| 3424 | (let ((tab (make-syntax-table text-mode-syntax-table))) | ||
| 3425 | (modify-syntax-entry ?\" "." tab) | ||
| 3426 | tab) | ||
| 3427 | "Syntax table for `markdown-mode'.") | ||
| 3428 | |||
| 3429 | |||
| 3430 | ;;; Element Insertion ========================================================= | ||
| 3431 | |||
| 3432 | (defun markdown-ensure-blank-line-before () | ||
| 3433 | "If previous line is not already blank, insert a blank line before point." | ||
| 3434 | (unless (bolp) (insert "\n")) | ||
| 3435 | (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) | ||
| 3436 | |||
| 3437 | (defun markdown-ensure-blank-line-after () | ||
| 3438 | "If following line is not already blank, insert a blank line after point. | ||
| 3439 | Return the point where it was originally." | ||
| 3440 | (save-excursion | ||
| 3441 | (unless (eolp) (insert "\n")) | ||
| 3442 | (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) | ||
| 3443 | |||
| 3444 | (defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) | ||
| 3445 | "Insert the strings S1 and S2, wrapping around region or THING. | ||
| 3446 | If a region is specified by the optional BEG and END arguments, | ||
| 3447 | wrap the strings S1 and S2 around that region. | ||
| 3448 | If there is an active region, wrap the strings S1 and S2 around | ||
| 3449 | the region. If there is not an active region but the point is at | ||
| 3450 | THING, wrap that thing (which defaults to word). Otherwise, just | ||
| 3451 | insert S1 and S2 and place the point in between. Return the | ||
| 3452 | bounds of the entire wrapped string, or nil if nothing was wrapped | ||
| 3453 | and S1 and S2 were only inserted." | ||
| 3454 | (let (a b bounds new-point) | ||
| 3455 | (cond | ||
| 3456 | ;; Given region | ||
| 3457 | ((and beg end) | ||
| 3458 | (setq a beg | ||
| 3459 | b end | ||
| 3460 | new-point (+ (point) (length s1)))) | ||
| 3461 | ;; Active region | ||
| 3462 | ((use-region-p) | ||
| 3463 | (setq a (region-beginning) | ||
| 3464 | b (region-end) | ||
| 3465 | new-point (+ (point) (length s1)))) | ||
| 3466 | ;; Thing (word) at point | ||
| 3467 | ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) | ||
| 3468 | (setq a (car bounds) | ||
| 3469 | b (cdr bounds) | ||
| 3470 | new-point (+ (point) (length s1)))) | ||
| 3471 | ;; No active region and no word | ||
| 3472 | (t | ||
| 3473 | (setq a (point) | ||
| 3474 | b (point)))) | ||
| 3475 | (goto-char b) | ||
| 3476 | (insert s2) | ||
| 3477 | (goto-char a) | ||
| 3478 | (insert s1) | ||
| 3479 | (when new-point (goto-char new-point)) | ||
| 3480 | (if (= a b) | ||
| 3481 | nil | ||
| 3482 | (setq b (+ b (length s1) (length s2))) | ||
| 3483 | (cons a b)))) | ||
| 3484 | |||
| 3485 | (defun markdown-point-after-unwrap (cur prefix suffix) | ||
| 3486 | "Return desired position of point after an unwrapping operation. | ||
| 3487 | CUR gives the position of the point before the operation. | ||
| 3488 | Additionally, two cons cells must be provided. PREFIX gives the | ||
| 3489 | bounds of the prefix string and SUFFIX gives the bounds of the | ||
| 3490 | suffix string." | ||
| 3491 | (cond ((< cur (cdr prefix)) (car prefix)) | ||
| 3492 | ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) | ||
| 3493 | ((<= cur (cdr suffix)) | ||
| 3494 | (- cur (+ (- (cdr prefix) (car prefix)) | ||
| 3495 | (- cur (car suffix))))) | ||
| 3496 | (t cur))) | ||
| 3497 | |||
| 3498 | (defun markdown-unwrap-thing-at-point (regexp all text) | ||
| 3499 | "Remove prefix and suffix of thing at point and reposition the point. | ||
| 3500 | When the thing at point matches REGEXP, replace the subexpression | ||
| 3501 | ALL with the string in subexpression TEXT. Reposition the point | ||
| 3502 | in an appropriate location accounting for the removal of prefix | ||
| 3503 | and suffix strings. Return new bounds of string from group TEXT. | ||
| 3504 | When REGEXP is nil, assumes match data is already set." | ||
| 3505 | (when (or (null regexp) | ||
| 3506 | (thing-at-point-looking-at regexp)) | ||
| 3507 | (let ((cur (point)) | ||
| 3508 | (prefix (cons (match-beginning all) (match-beginning text))) | ||
| 3509 | (suffix (cons (match-end text) (match-end all))) | ||
| 3510 | (bounds (cons (match-beginning text) (match-end text)))) | ||
| 3511 | ;; Replace the thing at point | ||
| 3512 | (replace-match (match-string text) t t nil all) | ||
| 3513 | ;; Reposition the point | ||
| 3514 | (goto-char (markdown-point-after-unwrap cur prefix suffix)) | ||
| 3515 | ;; Adjust bounds | ||
| 3516 | (setq bounds (cons (car prefix) | ||
| 3517 | (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) | ||
| 3518 | |||
| 3519 | (defun markdown-unwrap-things-in-region (beg end regexp all text) | ||
| 3520 | "Remove prefix and suffix of all things in region from BEG to END. | ||
| 3521 | When a thing in the region matches REGEXP, replace the | ||
| 3522 | subexpression ALL with the string in subexpression TEXT. | ||
| 3523 | Return a cons cell containing updated bounds for the region." | ||
| 3524 | (save-excursion | ||
| 3525 | (goto-char beg) | ||
| 3526 | (let ((removed 0) len-all len-text) | ||
| 3527 | (while (re-search-forward regexp (- end removed) t) | ||
| 3528 | (setq len-all (length (match-string-no-properties all))) | ||
| 3529 | (setq len-text (length (match-string-no-properties text))) | ||
| 3530 | (setq removed (+ removed (- len-all len-text))) | ||
| 3531 | (replace-match (match-string text) t t nil all)) | ||
| 3532 | (cons beg (- end removed))))) | ||
| 3533 | |||
| 3534 | (defun markdown-insert-hr (arg) | ||
| 3535 | "Insert or replace a horizontal rule. | ||
| 3536 | By default, use the first element of `markdown-hr-strings'. When | ||
| 3537 | ARG is non-nil, as when given a prefix, select a different | ||
| 3538 | element as follows. When prefixed with \\[universal-argument], | ||
| 3539 | use the last element of `markdown-hr-strings' instead. When | ||
| 3540 | prefixed with an integer from 1 to the length of | ||
| 3541 | `markdown-hr-strings', use the element in that position instead." | ||
| 3542 | (interactive "*P") | ||
| 3543 | (when (thing-at-point-looking-at markdown-regex-hr) | ||
| 3544 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 3545 | (markdown-ensure-blank-line-before) | ||
| 3546 | (cond ((equal arg '(4)) | ||
| 3547 | (insert (car (reverse markdown-hr-strings)))) | ||
| 3548 | ((and (integerp arg) (> arg 0) | ||
| 3549 | (<= arg (length markdown-hr-strings))) | ||
| 3550 | (insert (nth (1- arg) markdown-hr-strings))) | ||
| 3551 | (t | ||
| 3552 | (insert (car markdown-hr-strings)))) | ||
| 3553 | (markdown-ensure-blank-line-after)) | ||
| 3554 | |||
| 3555 | (defun markdown--insert-common (start-delim end-delim regex start-group end-group face) | ||
| 3556 | (if (use-region-p) | ||
| 3557 | ;; Active region | ||
| 3558 | (let ((bounds (markdown-unwrap-things-in-region | ||
| 3559 | (region-beginning) (region-end) | ||
| 3560 | regex start-group end-group))) | ||
| 3561 | (markdown-wrap-or-insert start-delim end-delim nil (car bounds) (cdr bounds))) | ||
| 3562 | (if (markdown--face-p (point) (list face)) | ||
| 3563 | (save-excursion | ||
| 3564 | (while (and (markdown--face-p (point) (list face)) (not (bobp))) | ||
| 3565 | (forward-char -1)) | ||
| 3566 | (forward-char (- (1- (length start-delim)))) ;; for delimiter | ||
| 3567 | (unless (bolp) | ||
| 3568 | (forward-char -1)) | ||
| 3569 | (when (looking-at regex) | ||
| 3570 | (markdown-unwrap-thing-at-point nil start-group end-group))) | ||
| 3571 | (if (thing-at-point-looking-at regex) | ||
| 3572 | (markdown-unwrap-thing-at-point nil start-group end-group) | ||
| 3573 | (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) | ||
| 3574 | |||
| 3575 | (defun markdown-insert-bold () | ||
| 3576 | "Insert markup to make a region or word bold. | ||
| 3577 | If there is an active region, make the region bold. If the point | ||
| 3578 | is at a non-bold word, make the word bold. If the point is at a | ||
| 3579 | bold word or phrase, remove the bold markup. Otherwise, simply | ||
| 3580 | insert bold delimiters and place the point in between them." | ||
| 3581 | (interactive) | ||
| 3582 | (let ((delim (if markdown-bold-underscore "__" "**"))) | ||
| 3583 | (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face))) | ||
| 3584 | |||
| 3585 | (defun markdown-insert-italic () | ||
| 3586 | "Insert markup to make a region or word italic. | ||
| 3587 | If there is an active region, make the region italic. If the point | ||
| 3588 | is at a non-italic word, make the word italic. If the point is at an | ||
| 3589 | italic word or phrase, remove the italic markup. Otherwise, simply | ||
| 3590 | insert italic delimiters and place the point in between them." | ||
| 3591 | (interactive) | ||
| 3592 | (let ((delim (if markdown-italic-underscore "_" "*"))) | ||
| 3593 | (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face))) | ||
| 3594 | |||
| 3595 | (defun markdown-insert-strike-through () | ||
| 3596 | "Insert markup to make a region or word strikethrough. | ||
| 3597 | If there is an active region, make the region strikethrough. If the point | ||
| 3598 | is at a non-bold word, make the word strikethrough. If the point is at a | ||
| 3599 | strikethrough word or phrase, remove the strikethrough markup. Otherwise, | ||
| 3600 | simply insert bold delimiters and place the point in between them." | ||
| 3601 | (interactive) | ||
| 3602 | (markdown--insert-common | ||
| 3603 | "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face)) | ||
| 3604 | |||
| 3605 | (defun markdown-insert-code () | ||
| 3606 | "Insert markup to make a region or word an inline code fragment. | ||
| 3607 | If there is an active region, make the region an inline code | ||
| 3608 | fragment. If the point is at a word, make the word an inline | ||
| 3609 | code fragment. Otherwise, simply insert code delimiters and | ||
| 3610 | place the point in between them." | ||
| 3611 | (interactive) | ||
| 3612 | (if (use-region-p) | ||
| 3613 | ;; Active region | ||
| 3614 | (let ((bounds (markdown-unwrap-things-in-region | ||
| 3615 | (region-beginning) (region-end) | ||
| 3616 | markdown-regex-code 1 3))) | ||
| 3617 | (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) | ||
| 3618 | ;; Code markup removal, code markup for word, or empty markup insertion | ||
| 3619 | (if (markdown-inline-code-at-point) | ||
| 3620 | (markdown-unwrap-thing-at-point nil 0 2) | ||
| 3621 | (markdown-wrap-or-insert "`" "`" 'word nil nil)))) | ||
| 3622 | |||
| 3623 | (defun markdown-insert-kbd () | ||
| 3624 | "Insert markup to wrap region or word in <kbd> tags. | ||
| 3625 | If there is an active region, use the region. If the point is at | ||
| 3626 | a word, use the word. Otherwise, simply insert <kbd> tags and | ||
| 3627 | place the point in between them." | ||
| 3628 | (interactive) | ||
| 3629 | (if (use-region-p) | ||
| 3630 | ;; Active region | ||
| 3631 | (let ((bounds (markdown-unwrap-things-in-region | ||
| 3632 | (region-beginning) (region-end) | ||
| 3633 | markdown-regex-kbd 0 2))) | ||
| 3634 | (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) | ||
| 3635 | ;; Markup removal, markup for word, or empty markup insertion | ||
| 3636 | (if (thing-at-point-looking-at markdown-regex-kbd) | ||
| 3637 | (markdown-unwrap-thing-at-point nil 0 2) | ||
| 3638 | (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) | ||
| 3639 | |||
| 3640 | (defun markdown-insert-inline-link (text url &optional title) | ||
| 3641 | "Insert an inline link with TEXT pointing to URL. | ||
| 3642 | Optionally, the user can provide a TITLE." | ||
| 3643 | (let ((cur (point))) | ||
| 3644 | (setq title (and title (concat " \"" title "\""))) | ||
| 3645 | (insert (concat "[" text "](" url title ")")) | ||
| 3646 | (cond ((not text) (goto-char (+ 1 cur))) | ||
| 3647 | ((not url) (goto-char (+ 3 (length text) cur)))))) | ||
| 3648 | |||
| 3649 | (defun markdown-insert-inline-image (text url &optional title) | ||
| 3650 | "Insert an inline link with alt TEXT pointing to URL. | ||
| 3651 | Optionally, also provide a TITLE." | ||
| 3652 | (let ((cur (point))) | ||
| 3653 | (setq title (and title (concat " \"" title "\""))) | ||
| 3654 | (insert (concat "")) | ||
| 3655 | (cond ((not text) (goto-char (+ 2 cur))) | ||
| 3656 | ((not url) (goto-char (+ 4 (length text) cur)))))) | ||
| 3657 | |||
| 3658 | (defun markdown-insert-reference-link (text label &optional url title) | ||
| 3659 | "Insert a reference link and, optionally, a reference definition. | ||
| 3660 | The link TEXT will be inserted followed by the optional LABEL. | ||
| 3661 | If a URL is given, also insert a definition for the reference | ||
| 3662 | LABEL according to `markdown-reference-location'. If a TITLE is | ||
| 3663 | given, it will be added to the end of the reference definition | ||
| 3664 | and will be used to populate the title attribute when converted | ||
| 3665 | to XHTML. If URL is nil, insert only the link portion (for | ||
| 3666 | example, when a reference label is already defined)." | ||
| 3667 | (insert (concat "[" text "][" label "]")) | ||
| 3668 | (when url | ||
| 3669 | (markdown-insert-reference-definition | ||
| 3670 | (if (string-equal label "") text label) | ||
| 3671 | url title))) | ||
| 3672 | |||
| 3673 | (defun markdown-insert-reference-image (text label &optional url title) | ||
| 3674 | "Insert a reference image and, optionally, a reference definition. | ||
| 3675 | The alt TEXT will be inserted followed by the optional LABEL. | ||
| 3676 | If a URL is given, also insert a definition for the reference | ||
| 3677 | LABEL according to `markdown-reference-location'. If a TITLE is | ||
| 3678 | given, it will be added to the end of the reference definition | ||
| 3679 | and will be used to populate the title attribute when converted | ||
| 3680 | to XHTML. If URL is nil, insert only the link portion (for | ||
| 3681 | example, when a reference label is already defined)." | ||
| 3682 | (insert (concat "![" text "][" label "]")) | ||
| 3683 | (when url | ||
| 3684 | (markdown-insert-reference-definition | ||
| 3685 | (if (string-equal label "") text label) | ||
| 3686 | url title))) | ||
| 3687 | |||
| 3688 | (defun markdown-insert-reference-definition (label &optional url title) | ||
| 3689 | "Add definition for reference LABEL with URL and TITLE. | ||
| 3690 | LABEL is a Markdown reference label without square brackets. | ||
| 3691 | URL and TITLE are optional. When given, the TITLE will | ||
| 3692 | be used to populate the title attribute when converted to XHTML." | ||
| 3693 | ;; END specifies where to leave the point upon return | ||
| 3694 | (let ((end (point))) | ||
| 3695 | (cl-case markdown-reference-location | ||
| 3696 | (end (goto-char (point-max))) | ||
| 3697 | (immediately (markdown-end-of-text-block)) | ||
| 3698 | (subtree (markdown-end-of-subtree)) | ||
| 3699 | (header (markdown-end-of-defun))) | ||
| 3700 | ;; Skip backwards over local variables. This logic is similar to the one | ||
| 3701 | ;; used in ‘hack-local-variables’. | ||
| 3702 | (when (and enable-local-variables (eobp)) | ||
| 3703 | (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) | ||
| 3704 | (when (let ((case-fold-search t)) | ||
| 3705 | (search-forward "Local Variables:" nil :move)) | ||
| 3706 | (beginning-of-line 0) | ||
| 3707 | (when (eq (char-before) ?\n) (backward-char)))) | ||
| 3708 | (unless (or (markdown-cur-line-blank-p) | ||
| 3709 | (thing-at-point-looking-at markdown-regex-reference-definition)) | ||
| 3710 | (insert "\n")) | ||
| 3711 | (insert "\n[" label "]: ") | ||
| 3712 | (if url | ||
| 3713 | (insert url) | ||
| 3714 | ;; When no URL is given, leave point at END following the colon | ||
| 3715 | (setq end (point))) | ||
| 3716 | (when (> (length title) 0) | ||
| 3717 | (insert " \"" title "\"")) | ||
| 3718 | (unless (looking-at-p "\n") | ||
| 3719 | (insert "\n")) | ||
| 3720 | (goto-char end) | ||
| 3721 | (when url | ||
| 3722 | (message | ||
| 3723 | (markdown--substitute-command-keys | ||
| 3724 | "Reference [%s] was defined, press \\[markdown-do] to jump there") | ||
| 3725 | label)))) | ||
| 3726 | |||
| 3727 | (defcustom markdown-link-make-text-function nil | ||
| 3728 | "Function that automatically generates a link text for a URL. | ||
| 3729 | |||
| 3730 | If non-nil, this function will be called by | ||
| 3731 | `markdown--insert-link-or-image' and the result will be the | ||
| 3732 | default link text. The function should receive exactly one | ||
| 3733 | argument that corresponds to the link URL." | ||
| 3734 | :group 'markdown | ||
| 3735 | :type 'function | ||
| 3736 | :package-version '(markdown-mode . "2.5")) | ||
| 3737 | |||
| 3738 | (defcustom markdown-disable-tooltip-prompt nil | ||
| 3739 | "Disable prompt for tooltip when inserting a link or image. | ||
| 3740 | |||
| 3741 | If non-nil, `markdown-insert-link' and `markdown-insert-link' | ||
| 3742 | will not prompt the user to insert a tooltip text for the given | ||
| 3743 | link or image." | ||
| 3744 | :group 'markdown | ||
| 3745 | :type 'boolean | ||
| 3746 | :safe 'booleanp | ||
| 3747 | :package-version '(markdown-mode . "2.5")) | ||
| 3748 | |||
| 3749 | (defun markdown--insert-link-or-image (image) | ||
| 3750 | "Interactively insert new or update an existing link or image. | ||
| 3751 | When IMAGE is non-nil, insert an image. Otherwise, insert a link. | ||
| 3752 | This is an internal function called by | ||
| 3753 | `markdown-insert-link' and `markdown-insert-image'." | ||
| 3754 | (cl-multiple-value-bind (begin end text uri ref title) | ||
| 3755 | (if (use-region-p) | ||
| 3756 | ;; Use region as either link text or URL as appropriate. | ||
| 3757 | (let ((region (buffer-substring-no-properties | ||
| 3758 | (region-beginning) (region-end)))) | ||
| 3759 | (if (string-match markdown-regex-uri region) | ||
| 3760 | ;; Region contains a URL; use it as such. | ||
| 3761 | (list (region-beginning) (region-end) | ||
| 3762 | nil (match-string 0 region) nil nil) | ||
| 3763 | ;; Region doesn't contain a URL, so use it as text. | ||
| 3764 | (list (region-beginning) (region-end) | ||
| 3765 | region nil nil nil))) | ||
| 3766 | ;; Extract and use properties of existing link, if any. | ||
| 3767 | (markdown-link-at-pos (point))) | ||
| 3768 | (let* ((ref (when ref (concat "[" ref "]"))) | ||
| 3769 | (defined-refs (mapcar #'car (markdown-get-defined-references))) | ||
| 3770 | (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) | ||
| 3771 | (used-uris (markdown-get-used-uris)) | ||
| 3772 | (uri-or-ref (completing-read | ||
| 3773 | "URL or [reference]: " | ||
| 3774 | (append defined-ref-cands used-uris) | ||
| 3775 | nil nil (or uri ref))) | ||
| 3776 | (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) | ||
| 3777 | (match-string 1 uri-or-ref)) | ||
| 3778 | ((string-equal "" uri-or-ref) | ||
| 3779 | ""))) | ||
| 3780 | (uri (unless ref uri-or-ref)) | ||
| 3781 | (text-prompt (if image | ||
| 3782 | "Alt text: " | ||
| 3783 | (if ref | ||
| 3784 | "Link text: " | ||
| 3785 | "Link text (blank for plain URL): "))) | ||
| 3786 | (text (or text (and markdown-link-make-text-function uri | ||
| 3787 | (funcall markdown-link-make-text-function uri)))) | ||
| 3788 | (text (completing-read text-prompt defined-refs nil nil text)) | ||
| 3789 | (text (if (= (length text) 0) nil text)) | ||
| 3790 | (plainp (and uri (not text))) | ||
| 3791 | (implicitp (string-equal ref "")) | ||
| 3792 | (ref (if implicitp text ref)) | ||
| 3793 | (definedp (and ref (markdown-reference-definition ref))) | ||
| 3794 | (ref-url (unless (or uri definedp) | ||
| 3795 | (completing-read "Reference URL: " used-uris))) | ||
| 3796 | (title (unless (or plainp definedp markdown-disable-tooltip-prompt) | ||
| 3797 | (read-string "Title (tooltip text, optional): " title))) | ||
| 3798 | (title (if (= (length title) 0) nil title))) | ||
| 3799 | (when (and image implicitp) | ||
| 3800 | (user-error "Reference required: implicit image references are invalid")) | ||
| 3801 | (when (and begin end) | ||
| 3802 | (delete-region begin end)) | ||
| 3803 | (cond | ||
| 3804 | ((and (not image) uri text) | ||
| 3805 | (markdown-insert-inline-link text uri title)) | ||
| 3806 | ((and image uri text) | ||
| 3807 | (markdown-insert-inline-image text uri title)) | ||
| 3808 | ((and ref text) | ||
| 3809 | (if image | ||
| 3810 | (markdown-insert-reference-image text (unless implicitp ref) nil title) | ||
| 3811 | (markdown-insert-reference-link text (unless implicitp ref) nil title)) | ||
| 3812 | (unless definedp | ||
| 3813 | (markdown-insert-reference-definition ref ref-url title))) | ||
| 3814 | ((and (not image) uri) | ||
| 3815 | (markdown-insert-uri uri)))))) | ||
| 3816 | |||
| 3817 | (defun markdown-insert-link () | ||
| 3818 | "Insert new or update an existing link, with interactive prompts. | ||
| 3819 | If the point is at an existing link or URL, update the link text, | ||
| 3820 | URL, reference label, and/or title. Otherwise, insert a new link. | ||
| 3821 | The type of link inserted (inline, reference, or plain URL) | ||
| 3822 | depends on which values are provided: | ||
| 3823 | |||
| 3824 | * If a URL and TEXT are given, insert an inline link: [TEXT](URL). | ||
| 3825 | * If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. | ||
| 3826 | * If only TEXT is given, insert an implicit reference link: [TEXT][]. | ||
| 3827 | * If only a URL is given, insert a plain link: <URL>. | ||
| 3828 | |||
| 3829 | In other words, to create an implicit reference link, leave the | ||
| 3830 | URL prompt empty and to create a plain URL link, leave the link | ||
| 3831 | text empty. | ||
| 3832 | |||
| 3833 | If there is an active region, use the text as the default URL, if | ||
| 3834 | it seems to be a URL, or link text value otherwise. | ||
| 3835 | |||
| 3836 | If a given reference is not defined, this function will | ||
| 3837 | additionally prompt for the URL and optional title. In this case, | ||
| 3838 | the reference definition is placed at the location determined by | ||
| 3839 | `markdown-reference-location'. In addition, it is possible to | ||
| 3840 | have the `markdown-link-make-text-function' function, if non-nil, | ||
| 3841 | define the default link text before prompting the user for it. | ||
| 3842 | |||
| 3843 | If `markdown-disable-tooltip-prompt' is non-nil, the user will | ||
| 3844 | not be prompted to add or modify a tooltip text. | ||
| 3845 | |||
| 3846 | Through updating the link, this function can be used to convert a | ||
| 3847 | link of one type (inline, reference, or plain) to another type by | ||
| 3848 | selectively adding or removing information via the prompts." | ||
| 3849 | (interactive) | ||
| 3850 | (markdown--insert-link-or-image nil)) | ||
| 3851 | |||
| 3852 | (defun markdown-insert-image () | ||
| 3853 | "Insert new or update an existing image, with interactive prompts. | ||
| 3854 | If the point is at an existing image, update the alt text, URL, | ||
| 3855 | reference label, and/or title. Otherwise, insert a new image. | ||
| 3856 | The type of image inserted (inline or reference) depends on which | ||
| 3857 | values are provided: | ||
| 3858 | |||
| 3859 | * If a URL and ALT-TEXT are given, insert an inline image: | ||
| 3860 | . | ||
| 3861 | * If [REF] and ALT-TEXT are given, insert a reference image: | ||
| 3862 | ![ALT-TEXT][REF]. | ||
| 3863 | |||
| 3864 | If there is an active region, use the text as the default URL, if | ||
| 3865 | it seems to be a URL, or alt text value otherwise. | ||
| 3866 | |||
| 3867 | If a given reference is not defined, this function will | ||
| 3868 | additionally prompt for the URL and optional title. In this case, | ||
| 3869 | the reference definition is placed at the location determined by | ||
| 3870 | `markdown-reference-location'. | ||
| 3871 | |||
| 3872 | Through updating the image, this function can be used to convert an | ||
| 3873 | image of one type (inline or reference) to another type by | ||
| 3874 | selectively adding or removing information via the prompts." | ||
| 3875 | (interactive) | ||
| 3876 | (markdown--insert-link-or-image t)) | ||
| 3877 | |||
| 3878 | (defun markdown-insert-uri (&optional uri) | ||
| 3879 | "Insert markup for an inline URI. | ||
| 3880 | If there is an active region, use it as the URI. If the point is | ||
| 3881 | at a URI, wrap it with angle brackets. If the point is at an | ||
| 3882 | inline URI, remove the angle brackets. Otherwise, simply insert | ||
| 3883 | angle brackets place the point between them." | ||
| 3884 | (interactive) | ||
| 3885 | (if (use-region-p) | ||
| 3886 | ;; Active region | ||
| 3887 | (let ((bounds (markdown-unwrap-things-in-region | ||
| 3888 | (region-beginning) (region-end) | ||
| 3889 | markdown-regex-angle-uri 0 2))) | ||
| 3890 | (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) | ||
| 3891 | ;; Markup removal, URI at point, new URI, or empty markup insertion | ||
| 3892 | (if (thing-at-point-looking-at markdown-regex-angle-uri) | ||
| 3893 | (markdown-unwrap-thing-at-point nil 0 2) | ||
| 3894 | (if uri | ||
| 3895 | (insert "<" uri ">") | ||
| 3896 | (markdown-wrap-or-insert "<" ">" 'url nil nil))))) | ||
| 3897 | |||
| 3898 | (defun markdown-insert-wiki-link () | ||
| 3899 | "Insert a wiki link of the form [[WikiLink]]. | ||
| 3900 | If there is an active region, use the region as the link text. | ||
| 3901 | If the point is at a word, use the word as the link text. If | ||
| 3902 | there is no active region and the point is not at word, simply | ||
| 3903 | insert link markup." | ||
| 3904 | (interactive) | ||
| 3905 | (if (use-region-p) | ||
| 3906 | ;; Active region | ||
| 3907 | (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) | ||
| 3908 | ;; Markup removal, wiki link at at point, or empty markup insertion | ||
| 3909 | (if (thing-at-point-looking-at markdown-regex-wiki-link) | ||
| 3910 | (if (or markdown-wiki-link-alias-first | ||
| 3911 | (null (match-string 5))) | ||
| 3912 | (markdown-unwrap-thing-at-point nil 1 3) | ||
| 3913 | (markdown-unwrap-thing-at-point nil 1 5)) | ||
| 3914 | (markdown-wrap-or-insert "[[" "]]")))) | ||
| 3915 | |||
| 3916 | (defun markdown-remove-header () | ||
| 3917 | "Remove header markup if point is at a header. | ||
| 3918 | Return bounds of remaining header text if a header was removed | ||
| 3919 | and nil otherwise." | ||
| 3920 | (interactive "*") | ||
| 3921 | (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) | ||
| 3922 | (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) | ||
| 3923 | |||
| 3924 | (defun markdown-insert-header (&optional level text setext) | ||
| 3925 | "Insert or replace header markup. | ||
| 3926 | The level of the header is specified by LEVEL and header text is | ||
| 3927 | given by TEXT. LEVEL must be an integer from 1 and 6, and the | ||
| 3928 | default value is 1. | ||
| 3929 | When TEXT is nil, the header text is obtained as follows. | ||
| 3930 | If there is an active region, it is used as the header text. | ||
| 3931 | Otherwise, the current line will be used as the header text. | ||
| 3932 | If there is not an active region and the point is at a header, | ||
| 3933 | remove the header markup and replace with level N header. | ||
| 3934 | Otherwise, insert empty header markup and place the point in | ||
| 3935 | between. | ||
| 3936 | The style of the header will be atx (hash marks) unless | ||
| 3937 | SETEXT is non-nil, in which case a setext-style (underlined) | ||
| 3938 | header will be inserted." | ||
| 3939 | (interactive "p\nsHeader text: ") | ||
| 3940 | (setq level (min (max (or level 1) 1) (if setext 2 6))) | ||
| 3941 | ;; Determine header text if not given | ||
| 3942 | (when (null text) | ||
| 3943 | (if (use-region-p) | ||
| 3944 | ;; Active region | ||
| 3945 | (setq text (delete-and-extract-region (region-beginning) (region-end))) | ||
| 3946 | ;; No active region | ||
| 3947 | (markdown-remove-header) | ||
| 3948 | (setq text (delete-and-extract-region | ||
| 3949 | (line-beginning-position) (line-end-position))) | ||
| 3950 | (when (and setext (string-match-p "^[ \t]*$" text)) | ||
| 3951 | (setq text (read-string "Header text: ")))) | ||
| 3952 | (setq text (markdown-compress-whitespace-string text))) | ||
| 3953 | ;; Insertion with given text | ||
| 3954 | (markdown-ensure-blank-line-before) | ||
| 3955 | (let (hdr) | ||
| 3956 | (cond (setext | ||
| 3957 | (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) | ||
| 3958 | (insert text "\n" hdr)) | ||
| 3959 | (t | ||
| 3960 | (setq hdr (make-string level ?#)) | ||
| 3961 | (insert hdr " " text) | ||
| 3962 | (when (null markdown-asymmetric-header) (insert " " hdr))))) | ||
| 3963 | (markdown-ensure-blank-line-after) | ||
| 3964 | ;; Leave point at end of text | ||
| 3965 | (cond (setext | ||
| 3966 | (backward-char (1+ (string-width text)))) | ||
| 3967 | ((null markdown-asymmetric-header) | ||
| 3968 | (backward-char (1+ level))))) | ||
| 3969 | |||
| 3970 | (defun markdown-insert-header-dwim (&optional arg setext) | ||
| 3971 | "Insert or replace header markup. | ||
| 3972 | The level and type of the header are determined automatically by | ||
| 3973 | the type and level of the previous header, unless a prefix | ||
| 3974 | argument is given via ARG. | ||
| 3975 | With a numeric prefix valued 1 to 6, insert a header of the given | ||
| 3976 | level, with the type being determined automatically (note that | ||
| 3977 | only level 1 or 2 setext headers are possible). | ||
| 3978 | |||
| 3979 | With a \\[universal-argument] prefix (i.e., when ARG is (4)), | ||
| 3980 | promote the heading by one level. | ||
| 3981 | With two \\[universal-argument] prefixes (i.e., when ARG is (16)), | ||
| 3982 | demote the heading by one level. | ||
| 3983 | When SETEXT is non-nil, prefer setext-style headers when | ||
| 3984 | possible (levels one and two). | ||
| 3985 | |||
| 3986 | When there is an active region, use it for the header text. When | ||
| 3987 | the point is at an existing header, change the type and level | ||
| 3988 | according to the rules above. | ||
| 3989 | Otherwise, if the line is not empty, create a header using the | ||
| 3990 | text on the current line as the header text. | ||
| 3991 | Finally, if the point is on a blank line, insert empty header | ||
| 3992 | markup (atx) or prompt for text (setext). | ||
| 3993 | See `markdown-insert-header' for more details about how the | ||
| 3994 | header text is determined." | ||
| 3995 | (interactive "*P") | ||
| 3996 | (let (level) | ||
| 3997 | (save-excursion | ||
| 3998 | (when (or (thing-at-point-looking-at markdown-regex-header) | ||
| 3999 | (re-search-backward markdown-regex-header nil t)) | ||
| 4000 | ;; level of current or previous header | ||
| 4001 | (setq level (markdown-outline-level)) | ||
| 4002 | ;; match group 1 indicates a setext header | ||
| 4003 | (setq setext (match-end 1)))) | ||
| 4004 | ;; check prefix argument | ||
| 4005 | (cond | ||
| 4006 | ((and (equal arg '(4)) level (> level 1)) ;; C-u | ||
| 4007 | (cl-decf level)) | ||
| 4008 | ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u | ||
| 4009 | (cl-incf level)) | ||
| 4010 | (arg ;; numeric prefix | ||
| 4011 | (setq level (prefix-numeric-value arg)))) | ||
| 4012 | ;; setext headers must be level one or two | ||
| 4013 | (and level (setq setext (and setext (<= level 2)))) | ||
| 4014 | ;; insert the heading | ||
| 4015 | (markdown-insert-header level nil setext))) | ||
| 4016 | |||
| 4017 | (defun markdown-insert-header-setext-dwim (&optional arg) | ||
| 4018 | "Insert or replace header markup, with preference for setext. | ||
| 4019 | See `markdown-insert-header-dwim' for details, including how ARG is handled." | ||
| 4020 | (interactive "*P") | ||
| 4021 | (markdown-insert-header-dwim arg t)) | ||
| 4022 | |||
| 4023 | (defun markdown-insert-header-atx-1 () | ||
| 4024 | "Insert a first level atx-style (hash mark) header. | ||
| 4025 | See `markdown-insert-header'." | ||
| 4026 | (interactive "*") | ||
| 4027 | (markdown-insert-header 1 nil nil)) | ||
| 4028 | |||
| 4029 | (defun markdown-insert-header-atx-2 () | ||
| 4030 | "Insert a level two atx-style (hash mark) header. | ||
| 4031 | See `markdown-insert-header'." | ||
| 4032 | (interactive "*") | ||
| 4033 | (markdown-insert-header 2 nil nil)) | ||
| 4034 | |||
| 4035 | (defun markdown-insert-header-atx-3 () | ||
| 4036 | "Insert a level three atx-style (hash mark) header. | ||
| 4037 | See `markdown-insert-header'." | ||
| 4038 | (interactive "*") | ||
| 4039 | (markdown-insert-header 3 nil nil)) | ||
| 4040 | |||
| 4041 | (defun markdown-insert-header-atx-4 () | ||
| 4042 | "Insert a level four atx-style (hash mark) header. | ||
| 4043 | See `markdown-insert-header'." | ||
| 4044 | (interactive "*") | ||
| 4045 | (markdown-insert-header 4 nil nil)) | ||
| 4046 | |||
| 4047 | (defun markdown-insert-header-atx-5 () | ||
| 4048 | "Insert a level five atx-style (hash mark) header. | ||
| 4049 | See `markdown-insert-header'." | ||
| 4050 | (interactive "*") | ||
| 4051 | (markdown-insert-header 5 nil nil)) | ||
| 4052 | |||
| 4053 | (defun markdown-insert-header-atx-6 () | ||
| 4054 | "Insert a sixth level atx-style (hash mark) header. | ||
| 4055 | See `markdown-insert-header'." | ||
| 4056 | (interactive "*") | ||
| 4057 | (markdown-insert-header 6 nil nil)) | ||
| 4058 | |||
| 4059 | (defun markdown-insert-header-setext-1 () | ||
| 4060 | "Insert a setext-style (underlined) first-level header. | ||
| 4061 | See `markdown-insert-header'." | ||
| 4062 | (interactive "*") | ||
| 4063 | (markdown-insert-header 1 nil t)) | ||
| 4064 | |||
| 4065 | (defun markdown-insert-header-setext-2 () | ||
| 4066 | "Insert a setext-style (underlined) second-level header. | ||
| 4067 | See `markdown-insert-header'." | ||
| 4068 | (interactive "*") | ||
| 4069 | (markdown-insert-header 2 nil t)) | ||
| 4070 | |||
| 4071 | (defun markdown-blockquote-indentation (loc) | ||
| 4072 | "Return string containing necessary indentation for a blockquote at LOC. | ||
| 4073 | Also see `markdown-pre-indentation'." | ||
| 4074 | (save-excursion | ||
| 4075 | (goto-char loc) | ||
| 4076 | (let* ((list-level (length (markdown-calculate-list-levels))) | ||
| 4077 | (indent "")) | ||
| 4078 | (dotimes (_ list-level indent) | ||
| 4079 | (setq indent (concat indent " ")))))) | ||
| 4080 | |||
| 4081 | (defun markdown-insert-blockquote () | ||
| 4082 | "Start a blockquote section (or blockquote the region). | ||
| 4083 | If Transient Mark mode is on and a region is active, it is used as | ||
| 4084 | the blockquote text." | ||
| 4085 | (interactive) | ||
| 4086 | (if (use-region-p) | ||
| 4087 | (markdown-blockquote-region (region-beginning) (region-end)) | ||
| 4088 | (markdown-ensure-blank-line-before) | ||
| 4089 | (insert (markdown-blockquote-indentation (point)) "> ") | ||
| 4090 | (markdown-ensure-blank-line-after))) | ||
| 4091 | |||
| 4092 | (defun markdown-block-region (beg end prefix) | ||
| 4093 | "Format the region using a block prefix. | ||
| 4094 | Arguments BEG and END specify the beginning and end of the | ||
| 4095 | region. The characters PREFIX will appear at the beginning | ||
| 4096 | of each line." | ||
| 4097 | (save-excursion | ||
| 4098 | (let* ((end-marker (make-marker)) | ||
| 4099 | (beg-marker (make-marker)) | ||
| 4100 | (prefix-without-trailing-whitespace | ||
| 4101 | (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) | ||
| 4102 | ;; Ensure blank line after and remove extra whitespace | ||
| 4103 | (goto-char end) | ||
| 4104 | (skip-syntax-backward "-") | ||
| 4105 | (set-marker end-marker (point)) | ||
| 4106 | (delete-horizontal-space) | ||
| 4107 | (markdown-ensure-blank-line-after) | ||
| 4108 | ;; Ensure blank line before and remove extra whitespace | ||
| 4109 | (goto-char beg) | ||
| 4110 | (skip-syntax-forward "-") | ||
| 4111 | (delete-horizontal-space) | ||
| 4112 | (markdown-ensure-blank-line-before) | ||
| 4113 | (set-marker beg-marker (point)) | ||
| 4114 | ;; Insert PREFIX before each line | ||
| 4115 | (goto-char beg-marker) | ||
| 4116 | (while (and (< (line-beginning-position) end-marker) | ||
| 4117 | (not (eobp))) | ||
| 4118 | ;; Don’t insert trailing whitespace. | ||
| 4119 | (insert (if (eolp) prefix-without-trailing-whitespace prefix)) | ||
| 4120 | (forward-line))))) | ||
| 4121 | |||
| 4122 | (defun markdown-blockquote-region (beg end) | ||
| 4123 | "Blockquote the region. | ||
| 4124 | Arguments BEG and END specify the beginning and end of the region." | ||
| 4125 | (interactive "*r") | ||
| 4126 | (markdown-block-region | ||
| 4127 | beg end (concat (markdown-blockquote-indentation | ||
| 4128 | (max (point-min) (1- beg))) "> "))) | ||
| 4129 | |||
| 4130 | (defun markdown-pre-indentation (loc) | ||
| 4131 | "Return string containing necessary whitespace for a pre block at LOC. | ||
| 4132 | Also see `markdown-blockquote-indentation'." | ||
| 4133 | (save-excursion | ||
| 4134 | (goto-char loc) | ||
| 4135 | (let* ((list-level (length (markdown-calculate-list-levels))) | ||
| 4136 | indent) | ||
| 4137 | (dotimes (_ (1+ list-level) indent) | ||
| 4138 | (setq indent (concat indent " ")))))) | ||
| 4139 | |||
| 4140 | (defun markdown-insert-pre () | ||
| 4141 | "Start a preformatted section (or apply to the region). | ||
| 4142 | If Transient Mark mode is on and a region is active, it is marked | ||
| 4143 | as preformatted text." | ||
| 4144 | (interactive) | ||
| 4145 | (if (use-region-p) | ||
| 4146 | (markdown-pre-region (region-beginning) (region-end)) | ||
| 4147 | (markdown-ensure-blank-line-before) | ||
| 4148 | (insert (markdown-pre-indentation (point))) | ||
| 4149 | (markdown-ensure-blank-line-after))) | ||
| 4150 | |||
| 4151 | (defun markdown-pre-region (beg end) | ||
| 4152 | "Format the region as preformatted text. | ||
| 4153 | Arguments BEG and END specify the beginning and end of the region." | ||
| 4154 | (interactive "*r") | ||
| 4155 | (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) | ||
| 4156 | (markdown-block-region beg end indent))) | ||
| 4157 | |||
| 4158 | (defun markdown-electric-backquote (arg) | ||
| 4159 | "Insert a backquote. | ||
| 4160 | The numeric prefix argument ARG says how many times to repeat the insertion. | ||
| 4161 | Call `markdown-insert-gfm-code-block' interactively | ||
| 4162 | if three backquotes inserted at the beginning of line." | ||
| 4163 | (interactive "*P") | ||
| 4164 | (self-insert-command (prefix-numeric-value arg)) | ||
| 4165 | (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) | ||
| 4166 | (replace-match "") | ||
| 4167 | (call-interactively #'markdown-insert-gfm-code-block))) | ||
| 4168 | |||
| 4169 | (defconst markdown-gfm-recognized-languages | ||
| 4170 | ;; To reproduce/update, evaluate the let-form in | ||
| 4171 | ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, | ||
| 4172 | ;; but with appropriate use of a keyboard macro, indenting and filling it | ||
| 4173 | ;; properly is pretty fast. | ||
| 4174 | '("1C-Enterprise" "4D" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR" | ||
| 4175 | "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada" | ||
| 4176 | "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" | ||
| 4177 | "AngelScript" "Ant-Build-System" "ApacheConf" "Apex" | ||
| 4178 | "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" "Assembly" | ||
| 4179 | "Asymptote" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Ballerina" "Batchfile" | ||
| 4180 | "Befunge" "BibTeX" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax" | ||
| 4181 | "Bluespec" "Boo" "Brainfuck" "Brightscript" "C#" "C++" "C-ObjDump" | ||
| 4182 | "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" "CWeb" | ||
| 4183 | "Cabal-Config" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK" | ||
| 4184 | "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates" | ||
| 4185 | "Cloud-Firestore-Security-Rules" "CoNLL-U" "CodeQL" "CoffeeScript" | ||
| 4186 | "ColdFusion" "ColdFusion-CFC" "Common-Lisp" "Common-Workflow-Language" | ||
| 4187 | "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" "Csound" | ||
| 4188 | "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" "D-ObjDump" | ||
| 4189 | "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" "Dafny" "Darcs-Patch" | ||
| 4190 | "Dart" "DataWeave" "Dhall" "Diff" "DirectX-3D-File" "Dockerfile" "Dogescript" | ||
| 4191 | "Dylan" "EBNF" "ECL" "ECLiPSe" "EJS" "EML" "EQ" "Eagle" "Easybuild" | ||
| 4192 | "Ecere-Projects" "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" | ||
| 4193 | "Emacs-Lisp" "EmberScript" "Erlang" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" | ||
| 4194 | "Fancy" "Fantom" "Faust" "Filebench-WML" "Filterscript" "Formatted" "Forth" | ||
| 4195 | "Fortran" "Fortran-Free-Form" "FreeMarker" "Frege" "G-code" "GAML" "GAMS" | ||
| 4196 | "GAP" "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" | ||
| 4197 | "Game-Maker-Language" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" | ||
| 4198 | "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" "Git-Config" | ||
| 4199 | "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" "Golo" "Gosu" | ||
| 4200 | "Grace" "Gradle" "Grammatical-Framework" "Graph-Modeling-Language" "GraphQL" | ||
| 4201 | "Graphviz-(DOT)" "Groovy" "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HTML" | ||
| 4202 | "HTML+Django" "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" | ||
| 4203 | "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" "HolyC" | ||
| 4204 | "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" "Idris" "Ignore-List" "Inform-7" | ||
| 4205 | "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "JFlex" "JSON" | ||
| 4206 | "JSON-with-Comments" "JSON5" "JSONLD" "JSONiq" "JSX" "Jasmin" "Java" | ||
| 4207 | "Java-Properties" "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jison" | ||
| 4208 | "Jison-Lex" "Jolie" "Jsonnet" "Julia" "Jupyter-Notebook" "KRL" "KiCad-Layout" | ||
| 4209 | "KiCad-Legacy-Layout" "KiCad-Schematic" "Kit" "Kotlin" "LFE" "LLVM" "LOLCODE" | ||
| 4210 | "LSL" "LTspice-Symbol" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex" | ||
| 4211 | "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid" | ||
| 4212 | "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" | ||
| 4213 | "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" "M4Sugar" "MATLAB" | ||
| 4214 | "MAXScript" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" "Makefile" "Mako" | ||
| 4215 | "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" "Max" "MediaWiki" | ||
| 4216 | "Mercury" "Meson" "Metal" "Microsoft-Developer-Studio-Project" "MiniD" "Mirah" | ||
| 4217 | "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Monkey" "Moocode" | ||
| 4218 | "MoonScript" "Motorola-68K-Assembly" "Muse" "Myghty" "NASL" "NCL" "NEON" "NL" | ||
| 4219 | "NPM-Config" "NSIS" "Nearley" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" | ||
| 4220 | "NewLisp" "Nextflow" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml" | ||
| 4221 | "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" "Objective-C" | ||
| 4222 | "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" "Opal" | ||
| 4223 | "Open-Policy-Agent" "OpenCL" "OpenEdge-ABL" "OpenQASM" "OpenRC-runscript" | ||
| 4224 | "OpenSCAD" "OpenStep-Property-List" "OpenType-Feature-File" "Org" "Ox" | ||
| 4225 | "Oxygene" "Oz" "P4" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus" | ||
| 4226 | "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pawn" | ||
| 4227 | "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "PlantUML" "Pod" | ||
| 4228 | "Pod-6" "PogoScript" "Pony" "PostCSS" "PostScript" "PowerBuilder" "PowerShell" | ||
| 4229 | "Prisma" "Processing" "Proguard" "Prolog" "Propeller-Spin" "Protocol-Buffer" | ||
| 4230 | "Public-Key" "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python" | ||
| 4231 | "Python-console" "Python-traceback" "QML" "QMake" "Quake" "RAML" "RDoc" | ||
| 4232 | "REALbasic" "REXX" "RHTML" "RMarkdown" "RPC" "RPM-Spec" "RUNOFF" "Racket" | ||
| 4233 | "Ragel" "Raku" "Rascal" "Raw-token-data" "Readline-Config" "Reason" "Rebol" | ||
| 4234 | "Red" "Redcode" "Regular-Expression" "Ren'Py" "RenderScript" | ||
| 4235 | "Rich-Text-Format" "Ring" "Riot" "RobotFramework" "Roff" "Roff-Manpage" | ||
| 4236 | "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL" | ||
| 4237 | "SRecode-Template" "SSH-Config" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" | ||
| 4238 | "Scala" "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession" | ||
| 4239 | "Shen" "Slash" "Slice" "Slim" "SmPL" "Smali" "Smalltalk" "Smarty" "Solidity" | ||
| 4240 | "SourcePawn" "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Starlark" | ||
| 4241 | "Stata" "Stylus" "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Swift" | ||
| 4242 | "SystemVerilog" "TI-Program" "TLA" "TOML" "TSQL" "TSX" "TXL" "Tcl" "Tcsh" | ||
| 4243 | "TeX" "Tea" "Terra" "Texinfo" "Text" "Textile" "Thrift" "Turing" "Turtle" | ||
| 4244 | "Twig" "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset" | ||
| 4245 | "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VBA" "VBScript" "VCL" "VHDL" | ||
| 4246 | "Vala" "Verilog" "Vim-Snippet" "Vim-script" "Visual-Basic-.NET" "Volt" "Vue" | ||
| 4247 | "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" "WebAssembly" | ||
| 4248 | "WebIDL" "WebVTT" "Wget-Config" "Windows-Registry-Entries" "Wollok" | ||
| 4249 | "World-of-Warcraft-Addon-Data" "X-BitMap" "X-Font-Directory-Index" "X-PixMap" | ||
| 4250 | "X10" "XC" "XCompose" "XML" "XML-Property-List" "XPages" "XProc" "XQuery" "XS" | ||
| 4251 | "XSLT" "Xojo" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "ZAP" "ZIL" | ||
| 4252 | "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" "desktop" "dircolors" | ||
| 4253 | "eC" "edn" "fish" "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" | ||
| 4254 | "reStructuredText" "sed" "wdl" "wisp" "xBase") | ||
| 4255 | "Language specifiers recognized by GitHub's syntax highlighting features.") | ||
| 4256 | |||
| 4257 | (defvar-local markdown-gfm-used-languages nil | ||
| 4258 | "Language names used in GFM code blocks.") | ||
| 4259 | |||
| 4260 | (defun markdown-trim-whitespace (str) | ||
| 4261 | (replace-regexp-in-string | ||
| 4262 | "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) | ||
| 4263 | |||
| 4264 | (defun markdown-clean-language-string (str) | ||
| 4265 | (replace-regexp-in-string | ||
| 4266 | "{\\.?\\|}" "" (markdown-trim-whitespace str))) | ||
| 4267 | |||
| 4268 | (defun markdown-validate-language-string (widget) | ||
| 4269 | (let ((str (widget-value widget))) | ||
| 4270 | (unless (string= str (markdown-clean-language-string str)) | ||
| 4271 | (widget-put widget :error (format "Invalid language spec: '%s'" str)) | ||
| 4272 | widget))) | ||
| 4273 | |||
| 4274 | (defun markdown-gfm-get-corpus () | ||
| 4275 | "Create corpus of recognized GFM code block languages for the given buffer." | ||
| 4276 | (let ((given-corpus (append markdown-gfm-additional-languages | ||
| 4277 | markdown-gfm-recognized-languages))) | ||
| 4278 | (append | ||
| 4279 | markdown-gfm-used-languages | ||
| 4280 | (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) | ||
| 4281 | given-corpus)))) | ||
| 4282 | |||
| 4283 | (defun markdown-gfm-add-used-language (lang) | ||
| 4284 | "Clean LANG and add to list of used languages." | ||
| 4285 | (setq markdown-gfm-used-languages | ||
| 4286 | (cons lang (remove lang markdown-gfm-used-languages)))) | ||
| 4287 | |||
| 4288 | (defcustom markdown-spaces-after-code-fence 1 | ||
| 4289 | "Number of space characters to insert after a code fence. | ||
| 4290 | \\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an | ||
| 4291 | opening code fence and an info string." | ||
| 4292 | :group 'markdown | ||
| 4293 | :type 'integer | ||
| 4294 | :safe #'natnump | ||
| 4295 | :package-version '(markdown-mode . "2.3")) | ||
| 4296 | |||
| 4297 | (defun markdown-insert-gfm-code-block (&optional lang edit) | ||
| 4298 | "Insert GFM code block for language LANG. | ||
| 4299 | If LANG is nil, the language will be queried from user. If a | ||
| 4300 | region is active, wrap this region with the markup instead. If | ||
| 4301 | the region boundaries are not on empty lines, these are added | ||
| 4302 | automatically in order to have the correct markup. When EDIT is | ||
| 4303 | non-nil (e.g., when \\[universal-argument] is given), edit the | ||
| 4304 | code block in an indirect buffer after insertion." | ||
| 4305 | (interactive | ||
| 4306 | (list (let ((completion-ignore-case nil)) | ||
| 4307 | (condition-case nil | ||
| 4308 | (markdown-clean-language-string | ||
| 4309 | (completing-read | ||
| 4310 | "Programming language: " | ||
| 4311 | (markdown-gfm-get-corpus) | ||
| 4312 | nil 'confirm (car markdown-gfm-used-languages) | ||
| 4313 | 'markdown-gfm-language-history)) | ||
| 4314 | (quit ""))) | ||
| 4315 | current-prefix-arg)) | ||
| 4316 | (unless (string= lang "") (markdown-gfm-add-used-language lang)) | ||
| 4317 | (when (> (length lang) 0) | ||
| 4318 | (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) | ||
| 4319 | lang))) | ||
| 4320 | (if (use-region-p) | ||
| 4321 | (let* ((b (region-beginning)) (e (region-end)) end | ||
| 4322 | (indent (progn (goto-char b) (current-indentation)))) | ||
| 4323 | (goto-char e) | ||
| 4324 | ;; if we're on a blank line, don't newline, otherwise the ``` | ||
| 4325 | ;; should go on its own line | ||
| 4326 | (unless (looking-back "\n" nil) | ||
| 4327 | (newline)) | ||
| 4328 | (indent-to indent) | ||
| 4329 | (insert "```") | ||
| 4330 | (markdown-ensure-blank-line-after) | ||
| 4331 | (setq end (point)) | ||
| 4332 | (goto-char b) | ||
| 4333 | ;; if we're on a blank line, insert the quotes here, otherwise | ||
| 4334 | ;; add a new line first | ||
| 4335 | (unless (looking-at-p "\n") | ||
| 4336 | (newline) | ||
| 4337 | (forward-line -1)) | ||
| 4338 | (markdown-ensure-blank-line-before) | ||
| 4339 | (indent-to indent) | ||
| 4340 | (insert "```" lang) | ||
| 4341 | (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end)) | ||
| 4342 | (let ((indent (current-indentation)) start-bol) | ||
| 4343 | (delete-horizontal-space :backward-only) | ||
| 4344 | (markdown-ensure-blank-line-before) | ||
| 4345 | (indent-to indent) | ||
| 4346 | (setq start-bol (point-at-bol)) | ||
| 4347 | (insert "```" lang "\n") | ||
| 4348 | (indent-to indent) | ||
| 4349 | (unless edit (insert ?\n)) | ||
| 4350 | (indent-to indent) | ||
| 4351 | (insert "```") | ||
| 4352 | (markdown-ensure-blank-line-after) | ||
| 4353 | (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) | ||
| 4354 | (end-of-line 0) | ||
| 4355 | (when edit (markdown-edit-code-block)))) | ||
| 4356 | |||
| 4357 | (defun markdown-code-block-lang (&optional pos-prop) | ||
| 4358 | "Return the language name for a GFM or tilde fenced code block. | ||
| 4359 | The beginning of the block may be described by POS-PROP, | ||
| 4360 | a cons of (pos . prop) giving the position and property | ||
| 4361 | at the beginning of the block." | ||
| 4362 | (or pos-prop | ||
| 4363 | (setq pos-prop | ||
| 4364 | (markdown-max-of-seq | ||
| 4365 | #'car | ||
| 4366 | (cl-remove-if | ||
| 4367 | #'null | ||
| 4368 | (cl-mapcar | ||
| 4369 | #'markdown-find-previous-prop | ||
| 4370 | (markdown-get-fenced-block-begin-properties)))))) | ||
| 4371 | (when pos-prop | ||
| 4372 | (goto-char (car pos-prop)) | ||
| 4373 | (set-match-data (get-text-property (point) (cdr pos-prop))) | ||
| 4374 | ;; Note: Hard-coded group number assumes tilde | ||
| 4375 | ;; and GFM fenced code regexp groups agree. | ||
| 4376 | (let ((begin (match-beginning 3)) | ||
| 4377 | (end (match-end 3))) | ||
| 4378 | (when (and begin end) | ||
| 4379 | ;; Fix language strings beginning with periods, like ".ruby". | ||
| 4380 | (when (eq (char-after begin) ?.) | ||
| 4381 | (setq begin (1+ begin))) | ||
| 4382 | (buffer-substring-no-properties begin end))))) | ||
| 4383 | |||
| 4384 | (defun markdown-gfm-parse-buffer-for-languages (&optional buffer) | ||
| 4385 | (with-current-buffer (or buffer (current-buffer)) | ||
| 4386 | (save-excursion | ||
| 4387 | (goto-char (point-min)) | ||
| 4388 | (cl-loop | ||
| 4389 | with prop = 'markdown-gfm-block-begin | ||
| 4390 | for pos-prop = (markdown-find-next-prop prop) | ||
| 4391 | while pos-prop | ||
| 4392 | for lang = (markdown-code-block-lang pos-prop) | ||
| 4393 | do (progn (when lang (markdown-gfm-add-used-language lang)) | ||
| 4394 | (goto-char (next-single-property-change (point) prop))))))) | ||
| 4395 | |||
| 4396 | |||
| 4397 | ;;; Footnotes ================================================================= | ||
| 4398 | |||
| 4399 | (defun markdown-footnote-counter-inc () | ||
| 4400 | "Increment `markdown-footnote-counter' and return the new value." | ||
| 4401 | (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. | ||
| 4402 | (save-excursion | ||
| 4403 | (goto-char (point-min)) | ||
| 4404 | (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") | ||
| 4405 | (point-max) t) | ||
| 4406 | (let ((fn (string-to-number (match-string 1)))) | ||
| 4407 | (when (> fn markdown-footnote-counter) | ||
| 4408 | (setq markdown-footnote-counter fn)))))) | ||
| 4409 | (cl-incf markdown-footnote-counter)) | ||
| 4410 | |||
| 4411 | (defun markdown-insert-footnote () | ||
| 4412 | "Insert footnote with a new number and move point to footnote definition." | ||
| 4413 | (interactive) | ||
| 4414 | (let ((fn (markdown-footnote-counter-inc))) | ||
| 4415 | (insert (format "[^%d]" fn)) | ||
| 4416 | (markdown-footnote-text-find-new-location) | ||
| 4417 | (markdown-ensure-blank-line-before) | ||
| 4418 | (unless (markdown-cur-line-blank-p) | ||
| 4419 | (insert "\n")) | ||
| 4420 | (insert (format "[^%d]: " fn)) | ||
| 4421 | (markdown-ensure-blank-line-after))) | ||
| 4422 | |||
| 4423 | (defun markdown-footnote-text-find-new-location () | ||
| 4424 | "Position the point at the proper location for a new footnote text." | ||
| 4425 | (cond | ||
| 4426 | ((eq markdown-footnote-location 'end) (goto-char (point-max))) | ||
| 4427 | ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) | ||
| 4428 | ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) | ||
| 4429 | ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) | ||
| 4430 | |||
| 4431 | (defun markdown-footnote-kill () | ||
| 4432 | "Kill the footnote at point. | ||
| 4433 | The footnote text is killed (and added to the kill ring), the | ||
| 4434 | footnote marker is deleted. Point has to be either at the | ||
| 4435 | footnote marker or in the footnote text." | ||
| 4436 | (interactive) | ||
| 4437 | (let ((marker-pos nil) | ||
| 4438 | (skip-deleting-marker nil) | ||
| 4439 | (starting-footnote-text-positions | ||
| 4440 | (markdown-footnote-text-positions))) | ||
| 4441 | (when starting-footnote-text-positions | ||
| 4442 | ;; We're starting in footnote text, so mark our return position and jump | ||
| 4443 | ;; to the marker if possible. | ||
| 4444 | (let ((marker-pos (markdown-footnote-find-marker | ||
| 4445 | (cl-first starting-footnote-text-positions)))) | ||
| 4446 | (if marker-pos | ||
| 4447 | (goto-char (1- marker-pos)) | ||
| 4448 | ;; If there isn't a marker, we still want to kill the text. | ||
| 4449 | (setq skip-deleting-marker t)))) | ||
| 4450 | ;; Either we didn't start in the text, or we started in the text and jumped | ||
| 4451 | ;; to the marker. We want to assume we're at the marker now and error if | ||
| 4452 | ;; we're not. | ||
| 4453 | (unless skip-deleting-marker | ||
| 4454 | (let ((marker (markdown-footnote-delete-marker))) | ||
| 4455 | (unless marker | ||
| 4456 | (error "Not at a footnote")) | ||
| 4457 | ;; Even if we knew the text position before, it changed when we deleted | ||
| 4458 | ;; the label. | ||
| 4459 | (setq marker-pos (cl-second marker)) | ||
| 4460 | (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) | ||
| 4461 | (unless new-text-pos | ||
| 4462 | (error "No text for footnote `%s'" (cl-first marker))) | ||
| 4463 | (goto-char new-text-pos)))) | ||
| 4464 | (let ((pos (markdown-footnote-kill-text))) | ||
| 4465 | (goto-char (if starting-footnote-text-positions | ||
| 4466 | pos | ||
| 4467 | marker-pos))))) | ||
| 4468 | |||
| 4469 | (defun markdown-footnote-delete-marker () | ||
| 4470 | "Delete a footnote marker at point. | ||
| 4471 | Returns a list (ID START) containing the footnote ID and the | ||
| 4472 | start position of the marker before deletion. If no footnote | ||
| 4473 | marker was deleted, this function returns NIL." | ||
| 4474 | (let ((marker (markdown-footnote-marker-positions))) | ||
| 4475 | (when marker | ||
| 4476 | (delete-region (cl-second marker) (cl-third marker)) | ||
| 4477 | (butlast marker)))) | ||
| 4478 | |||
| 4479 | (defun markdown-footnote-kill-text () | ||
| 4480 | "Kill footnote text at point. | ||
| 4481 | Returns the start position of the footnote text before deletion, | ||
| 4482 | or NIL if point was not inside a footnote text. | ||
| 4483 | |||
| 4484 | The killed text is placed in the kill ring (without the footnote | ||
| 4485 | number)." | ||
| 4486 | (let ((fn (markdown-footnote-text-positions))) | ||
| 4487 | (when fn | ||
| 4488 | (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) | ||
| 4489 | (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) | ||
| 4490 | (kill-new (match-string 1 text)) | ||
| 4491 | (when (and (markdown-cur-line-blank-p) | ||
| 4492 | (markdown-prev-line-blank-p) | ||
| 4493 | (not (bobp))) | ||
| 4494 | (delete-region (1- (point)) (point))) | ||
| 4495 | (cl-second fn))))) | ||
| 4496 | |||
| 4497 | (defun markdown-footnote-goto-text () | ||
| 4498 | "Jump to the text of the footnote at point." | ||
| 4499 | (interactive) | ||
| 4500 | (let ((fn (car (markdown-footnote-marker-positions)))) | ||
| 4501 | (unless fn | ||
| 4502 | (user-error "Not at a footnote marker")) | ||
| 4503 | (let ((new-pos (markdown-footnote-find-text fn))) | ||
| 4504 | (unless new-pos | ||
| 4505 | (error "No definition found for footnote `%s'" fn)) | ||
| 4506 | (goto-char new-pos)))) | ||
| 4507 | |||
| 4508 | (defun markdown-footnote-return () | ||
| 4509 | "Return from a footnote to its footnote number in the main text." | ||
| 4510 | (interactive) | ||
| 4511 | (let ((fn (save-excursion | ||
| 4512 | (car (markdown-footnote-text-positions))))) | ||
| 4513 | (unless fn | ||
| 4514 | (user-error "Not in a footnote")) | ||
| 4515 | (let ((new-pos (markdown-footnote-find-marker fn))) | ||
| 4516 | (unless new-pos | ||
| 4517 | (error "Footnote marker `%s' not found" fn)) | ||
| 4518 | (goto-char new-pos)))) | ||
| 4519 | |||
| 4520 | (defun markdown-footnote-find-marker (id) | ||
| 4521 | "Find the location of the footnote marker with ID. | ||
| 4522 | The actual buffer position returned is the position directly | ||
| 4523 | following the marker's closing bracket. If no marker is found, | ||
| 4524 | NIL is returned." | ||
| 4525 | (save-excursion | ||
| 4526 | (goto-char (point-min)) | ||
| 4527 | (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) | ||
| 4528 | (skip-chars-backward "^]") | ||
| 4529 | (point)))) | ||
| 4530 | |||
| 4531 | (defun markdown-footnote-find-text (id) | ||
| 4532 | "Find the location of the text of footnote ID. | ||
| 4533 | The actual buffer position returned is the position of the first | ||
| 4534 | character of the text, after the footnote's identifier. If no | ||
| 4535 | footnote text is found, NIL is returned." | ||
| 4536 | (save-excursion | ||
| 4537 | (goto-char (point-min)) | ||
| 4538 | (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) | ||
| 4539 | (skip-chars-forward "[ \t]") | ||
| 4540 | (point)))) | ||
| 4541 | |||
| 4542 | (defun markdown-footnote-marker-positions () | ||
| 4543 | "Return the position and ID of the footnote marker point is on. | ||
| 4544 | The return value is a list (ID START END). If point is not on a | ||
| 4545 | footnote, NIL is returned." | ||
| 4546 | ;; first make sure we're at a footnote marker | ||
| 4547 | (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) | ||
| 4548 | (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) | ||
| 4549 | (save-excursion | ||
| 4550 | ;; move point between [ and ^: | ||
| 4551 | (if (looking-at-p "\\[") | ||
| 4552 | (forward-char 1) | ||
| 4553 | (skip-chars-backward "^[")) | ||
| 4554 | (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) | ||
| 4555 | (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) | ||
| 4556 | |||
| 4557 | (defun markdown-footnote-text-positions () | ||
| 4558 | "Return the start and end positions of the footnote text point is in. | ||
| 4559 | The exact return value is a list of three elements: (ID START END). | ||
| 4560 | The start position is the position of the opening bracket | ||
| 4561 | of the footnote id. The end position is directly after the | ||
| 4562 | newline that ends the footnote. If point is not in a footnote, | ||
| 4563 | NIL is returned instead." | ||
| 4564 | (save-excursion | ||
| 4565 | (let (result) | ||
| 4566 | (move-beginning-of-line 1) | ||
| 4567 | ;; Try to find the label. If we haven't found the label and we're at a blank | ||
| 4568 | ;; or indented line, back up if possible. | ||
| 4569 | (while (and | ||
| 4570 | (not (and (looking-at markdown-regex-footnote-definition) | ||
| 4571 | (setq result (list (match-string 1) (point))))) | ||
| 4572 | (and (not (bobp)) | ||
| 4573 | (or (markdown-cur-line-blank-p) | ||
| 4574 | (>= (current-indentation) 4)))) | ||
| 4575 | (forward-line -1)) | ||
| 4576 | (when result | ||
| 4577 | ;; Advance if there is a next line that is either blank or indented. | ||
| 4578 | ;; (Need to check if we're on the last line, because | ||
| 4579 | ;; markdown-next-line-blank-p returns true for last line in buffer.) | ||
| 4580 | (while (and (/= (line-end-position) (point-max)) | ||
| 4581 | (or (markdown-next-line-blank-p) | ||
| 4582 | (>= (markdown-next-line-indent) 4))) | ||
| 4583 | (forward-line)) | ||
| 4584 | ;; Move back while the current line is blank. | ||
| 4585 | (while (markdown-cur-line-blank-p) | ||
| 4586 | (forward-line -1)) | ||
| 4587 | ;; Advance to capture this line and a single trailing newline (if there | ||
| 4588 | ;; is one). | ||
| 4589 | (forward-line) | ||
| 4590 | (append result (list (point))))))) | ||
| 4591 | |||
| 4592 | (defun markdown-get-defined-footnotes () | ||
| 4593 | "Return a list of all defined footnotes. | ||
| 4594 | Result is an alist of pairs (MARKER . LINE), where MARKER is the | ||
| 4595 | footnote marker, a string, and LINE is the line number containing | ||
| 4596 | the footnote definition. | ||
| 4597 | |||
| 4598 | For example, suppose the following footnotes are defined at positions | ||
| 4599 | 448 and 475: | ||
| 4600 | |||
| 4601 | \[^1]: First footnote here. | ||
| 4602 | \[^marker]: Second footnote. | ||
| 4603 | |||
| 4604 | Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" | ||
| 4605 | (save-excursion | ||
| 4606 | (goto-char (point-min)) | ||
| 4607 | (let (footnotes) | ||
| 4608 | (while (markdown-search-until-condition | ||
| 4609 | (lambda () (and (not (markdown-code-block-at-point-p)) | ||
| 4610 | (not (markdown-inline-code-at-point-p)) | ||
| 4611 | (not (markdown-in-comment-p)))) | ||
| 4612 | markdown-regex-footnote-definition nil t) | ||
| 4613 | (let ((marker (match-string-no-properties 1)) | ||
| 4614 | (pos (match-beginning 0))) | ||
| 4615 | (unless (zerop (length marker)) | ||
| 4616 | (cl-pushnew (cons marker pos) footnotes :test #'equal)))) | ||
| 4617 | (reverse footnotes)))) | ||
| 4618 | |||
| 4619 | |||
| 4620 | ;;; Element Removal =========================================================== | ||
| 4621 | |||
| 4622 | (defun markdown-kill-thing-at-point () | ||
| 4623 | "Kill thing at point and add important text, without markup, to kill ring. | ||
| 4624 | Possible things to kill include (roughly in order of precedence): | ||
| 4625 | inline code, headers, horizontal rules, links (add link text to | ||
| 4626 | kill ring), images (add alt text to kill ring), angle uri, email | ||
| 4627 | addresses, bold, italics, reference definition (add URI to kill | ||
| 4628 | ring), footnote markers and text (kill both marker and text, add | ||
| 4629 | text to kill ring), and list items." | ||
| 4630 | (interactive "*") | ||
| 4631 | (let (val) | ||
| 4632 | (cond | ||
| 4633 | ;; Inline code | ||
| 4634 | ((markdown-inline-code-at-point) | ||
| 4635 | (kill-new (match-string 2)) | ||
| 4636 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4637 | ;; ATX header | ||
| 4638 | ((thing-at-point-looking-at markdown-regex-header-atx) | ||
| 4639 | (kill-new (match-string 2)) | ||
| 4640 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4641 | ;; Setext header | ||
| 4642 | ((thing-at-point-looking-at markdown-regex-header-setext) | ||
| 4643 | (kill-new (match-string 1)) | ||
| 4644 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4645 | ;; Horizontal rule | ||
| 4646 | ((thing-at-point-looking-at markdown-regex-hr) | ||
| 4647 | (kill-new (match-string 0)) | ||
| 4648 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4649 | ;; Inline link or image (add link or alt text to kill ring) | ||
| 4650 | ((thing-at-point-looking-at markdown-regex-link-inline) | ||
| 4651 | (kill-new (match-string 3)) | ||
| 4652 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4653 | ;; Reference link or image (add link or alt text to kill ring) | ||
| 4654 | ((thing-at-point-looking-at markdown-regex-link-reference) | ||
| 4655 | (kill-new (match-string 3)) | ||
| 4656 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4657 | ;; Angle URI (add URL to kill ring) | ||
| 4658 | ((thing-at-point-looking-at markdown-regex-angle-uri) | ||
| 4659 | (kill-new (match-string 2)) | ||
| 4660 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4661 | ;; Email address in angle brackets (add email address to kill ring) | ||
| 4662 | ((thing-at-point-looking-at markdown-regex-email) | ||
| 4663 | (kill-new (match-string 1)) | ||
| 4664 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4665 | ;; Wiki link (add alias text to kill ring) | ||
| 4666 | ((and markdown-enable-wiki-links | ||
| 4667 | (thing-at-point-looking-at markdown-regex-wiki-link)) | ||
| 4668 | (kill-new (markdown-wiki-link-alias)) | ||
| 4669 | (delete-region (match-beginning 1) (match-end 1))) | ||
| 4670 | ;; Bold | ||
| 4671 | ((thing-at-point-looking-at markdown-regex-bold) | ||
| 4672 | (kill-new (match-string 4)) | ||
| 4673 | (delete-region (match-beginning 2) (match-end 2))) | ||
| 4674 | ;; Italics | ||
| 4675 | ((thing-at-point-looking-at markdown-regex-italic) | ||
| 4676 | (kill-new (match-string 3)) | ||
| 4677 | (delete-region (match-beginning 1) (match-end 1))) | ||
| 4678 | ;; Strikethrough | ||
| 4679 | ((thing-at-point-looking-at markdown-regex-strike-through) | ||
| 4680 | (kill-new (match-string 4)) | ||
| 4681 | (delete-region (match-beginning 2) (match-end 2))) | ||
| 4682 | ;; Footnote marker (add footnote text to kill ring) | ||
| 4683 | ((thing-at-point-looking-at markdown-regex-footnote) | ||
| 4684 | (markdown-footnote-kill)) | ||
| 4685 | ;; Footnote text (add footnote text to kill ring) | ||
| 4686 | ((setq val (markdown-footnote-text-positions)) | ||
| 4687 | (markdown-footnote-kill)) | ||
| 4688 | ;; Reference definition (add URL to kill ring) | ||
| 4689 | ((thing-at-point-looking-at markdown-regex-reference-definition) | ||
| 4690 | (kill-new (match-string 5)) | ||
| 4691 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 4692 | ;; List item | ||
| 4693 | ((setq val (markdown-cur-list-item-bounds)) | ||
| 4694 | (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) | ||
| 4695 | (t | ||
| 4696 | (user-error "Nothing found at point to kill"))))) | ||
| 4697 | |||
| 4698 | (defun markdown-kill-outline () | ||
| 4699 | "Kill visible heading and add it to `kill-ring'." | ||
| 4700 | (interactive) | ||
| 4701 | (save-excursion | ||
| 4702 | (markdown-outline-previous) | ||
| 4703 | (kill-region (point) (progn (markdown-outline-next) (point))))) | ||
| 4704 | |||
| 4705 | (defun markdown-kill-block () | ||
| 4706 | "Kill visible code block, list item, or blockquote and add it to `kill-ring'." | ||
| 4707 | (interactive) | ||
| 4708 | (save-excursion | ||
| 4709 | (markdown-backward-block) | ||
| 4710 | (kill-region (point) (progn (markdown-forward-block) (point))))) | ||
| 4711 | |||
| 4712 | |||
| 4713 | ;;; Indentation =============================================================== | ||
| 4714 | |||
| 4715 | (defun markdown-indent-find-next-position (cur-pos positions) | ||
| 4716 | "Return the position after the index of CUR-POS in POSITIONS. | ||
| 4717 | Positions are calculated by `markdown-calc-indents'." | ||
| 4718 | (while (and positions | ||
| 4719 | (not (equal cur-pos (car positions)))) | ||
| 4720 | (setq positions (cdr positions))) | ||
| 4721 | (or (cadr positions) 0)) | ||
| 4722 | |||
| 4723 | (defun markdown-outdent-find-next-position (cur-pos positions) | ||
| 4724 | "Return the maximal element that precedes CUR-POS from POSITIONS. | ||
| 4725 | Positions are calculated by `markdown-calc-indents'." | ||
| 4726 | (let ((result 0)) | ||
| 4727 | (dolist (i positions) | ||
| 4728 | (when (< i cur-pos) | ||
| 4729 | (setq result (max result i)))) | ||
| 4730 | result)) | ||
| 4731 | |||
| 4732 | (defun markdown-indent-line () | ||
| 4733 | "Indent the current line using some heuristics. | ||
| 4734 | If the _previous_ command was either `markdown-enter-key' or | ||
| 4735 | `markdown-cycle', then we should cycle to the next | ||
| 4736 | reasonable indentation position. Otherwise, we could have been | ||
| 4737 | called directly by `markdown-enter-key', by an initial call of | ||
| 4738 | `markdown-cycle', or indirectly by `auto-fill-mode'. In | ||
| 4739 | these cases, indent to the default position. | ||
| 4740 | Positions are calculated by `markdown-calc-indents'." | ||
| 4741 | (interactive) | ||
| 4742 | (let ((positions (markdown-calc-indents)) | ||
| 4743 | (point-pos (current-column)) | ||
| 4744 | (_ (back-to-indentation)) | ||
| 4745 | (cur-pos (current-column))) | ||
| 4746 | (if (not (equal this-command 'markdown-cycle)) | ||
| 4747 | (indent-line-to (car positions)) | ||
| 4748 | (setq positions (sort (delete-dups positions) '<)) | ||
| 4749 | (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) | ||
| 4750 | (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) | ||
| 4751 | (indent-line-to next-pos) | ||
| 4752 | (move-to-column new-point-pos))))) | ||
| 4753 | |||
| 4754 | (defun markdown-calc-indents () | ||
| 4755 | "Return a list of indentation columns to cycle through. | ||
| 4756 | The first element in the returned list should be considered the | ||
| 4757 | default indentation level. This function does not worry about | ||
| 4758 | duplicate positions, which are handled up by calling functions." | ||
| 4759 | (let (pos prev-line-pos positions) | ||
| 4760 | |||
| 4761 | ;; Indentation of previous line | ||
| 4762 | (setq prev-line-pos (markdown-prev-line-indent)) | ||
| 4763 | (setq positions (cons prev-line-pos positions)) | ||
| 4764 | |||
| 4765 | ;; Indentation of previous non-list-marker text | ||
| 4766 | (when (setq pos (save-excursion | ||
| 4767 | (forward-line -1) | ||
| 4768 | (when (looking-at markdown-regex-list) | ||
| 4769 | (- (match-end 3) (match-beginning 0))))) | ||
| 4770 | (setq positions (cons pos positions))) | ||
| 4771 | |||
| 4772 | ;; Indentation required for a pre block in current context | ||
| 4773 | (setq pos (length (markdown-pre-indentation (point)))) | ||
| 4774 | (setq positions (cons pos positions)) | ||
| 4775 | |||
| 4776 | ;; Indentation of the previous line + tab-width | ||
| 4777 | (if prev-line-pos | ||
| 4778 | (setq positions (cons (+ prev-line-pos tab-width) positions)) | ||
| 4779 | (setq positions (cons tab-width positions))) | ||
| 4780 | |||
| 4781 | ;; Indentation of the previous line - tab-width | ||
| 4782 | (if (and prev-line-pos (> prev-line-pos tab-width)) | ||
| 4783 | (setq positions (cons (- prev-line-pos tab-width) positions))) | ||
| 4784 | |||
| 4785 | ;; Indentation of all preceding list markers (when in a list) | ||
| 4786 | (when (setq pos (markdown-calculate-list-levels)) | ||
| 4787 | (setq positions (append pos positions))) | ||
| 4788 | |||
| 4789 | ;; First column | ||
| 4790 | (setq positions (cons 0 positions)) | ||
| 4791 | |||
| 4792 | ;; Return reversed list | ||
| 4793 | (reverse positions))) | ||
| 4794 | |||
| 4795 | (defun markdown-enter-key () | ||
| 4796 | "Handle RET depending on the context. | ||
| 4797 | If the point is at a table, move to the next row. Otherwise, | ||
| 4798 | indent according to value of `markdown-indent-on-enter'. | ||
| 4799 | When it is nil, simply call `newline'. Otherwise, indent the next line | ||
| 4800 | following RET using `markdown-indent-line'. Furthermore, when it | ||
| 4801 | is set to 'indent-and-new-item and the point is in a list item, | ||
| 4802 | start a new item with the same indentation. If the point is in an | ||
| 4803 | empty list item, remove it (so that pressing RET twice when in a | ||
| 4804 | list simply adds a blank line)." | ||
| 4805 | (interactive) | ||
| 4806 | (cond | ||
| 4807 | ;; Table | ||
| 4808 | ((markdown-table-at-point-p) | ||
| 4809 | (call-interactively #'markdown-table-next-row)) | ||
| 4810 | ;; Indent non-table text | ||
| 4811 | (markdown-indent-on-enter | ||
| 4812 | (let (bounds) | ||
| 4813 | (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) | ||
| 4814 | (setq bounds (markdown-cur-list-item-bounds))) | ||
| 4815 | (let ((beg (cl-first bounds)) | ||
| 4816 | (end (cl-second bounds)) | ||
| 4817 | (length (cl-fourth bounds))) | ||
| 4818 | ;; Point is in a list item | ||
| 4819 | (if (= (- end beg) length) | ||
| 4820 | ;; Delete blank list | ||
| 4821 | (progn | ||
| 4822 | (delete-region beg end) | ||
| 4823 | (newline) | ||
| 4824 | (markdown-indent-line)) | ||
| 4825 | (call-interactively #'markdown-insert-list-item))) | ||
| 4826 | ;; Point is not in a list | ||
| 4827 | (newline) | ||
| 4828 | (markdown-indent-line)))) | ||
| 4829 | ;; Insert a raw newline | ||
| 4830 | (t (newline)))) | ||
| 4831 | |||
| 4832 | (defun markdown-outdent-or-delete (arg) | ||
| 4833 | "Handle BACKSPACE by cycling through indentation points. | ||
| 4834 | When BACKSPACE is pressed, if there is only whitespace | ||
| 4835 | before the current point, then outdent the line one level. | ||
| 4836 | Otherwise, do normal delete by repeating | ||
| 4837 | `backward-delete-char-untabify' ARG times." | ||
| 4838 | (interactive "*p") | ||
| 4839 | (if (use-region-p) | ||
| 4840 | (backward-delete-char-untabify arg) | ||
| 4841 | (let ((cur-pos (current-column)) | ||
| 4842 | (start-of-indention (save-excursion | ||
| 4843 | (back-to-indentation) | ||
| 4844 | (current-column))) | ||
| 4845 | (positions (markdown-calc-indents))) | ||
| 4846 | (if (and (> cur-pos 0) (= cur-pos start-of-indention)) | ||
| 4847 | (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) | ||
| 4848 | (backward-delete-char-untabify arg))))) | ||
| 4849 | |||
| 4850 | (defun markdown-find-leftmost-column (beg end) | ||
| 4851 | "Find the leftmost column in the region from BEG to END." | ||
| 4852 | (let ((mincol 1000)) | ||
| 4853 | (save-excursion | ||
| 4854 | (goto-char beg) | ||
| 4855 | (while (< (point) end) | ||
| 4856 | (back-to-indentation) | ||
| 4857 | (unless (looking-at-p "[ \t]*$") | ||
| 4858 | (setq mincol (min mincol (current-column)))) | ||
| 4859 | (forward-line 1) | ||
| 4860 | )) | ||
| 4861 | mincol)) | ||
| 4862 | |||
| 4863 | (defun markdown-indent-region (beg end arg) | ||
| 4864 | "Indent the region from BEG to END using some heuristics. | ||
| 4865 | When ARG is non-nil, outdent the region instead. | ||
| 4866 | See `markdown-indent-line' and `markdown-indent-line'." | ||
| 4867 | (interactive "*r\nP") | ||
| 4868 | (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) | ||
| 4869 | (leftmostcol (markdown-find-leftmost-column beg end)) | ||
| 4870 | (next-pos (if arg | ||
| 4871 | (markdown-outdent-find-next-position leftmostcol positions) | ||
| 4872 | (markdown-indent-find-next-position leftmostcol positions)))) | ||
| 4873 | (indent-rigidly beg end (- next-pos leftmostcol)) | ||
| 4874 | (setq deactivate-mark nil))) | ||
| 4875 | |||
| 4876 | (defun markdown-outdent-region (beg end) | ||
| 4877 | "Call `markdown-indent-region' on region from BEG to END with prefix." | ||
| 4878 | (interactive "*r") | ||
| 4879 | (markdown-indent-region beg end t)) | ||
| 4880 | |||
| 4881 | (defun markdown--indent-region (start end) | ||
| 4882 | (let ((deactivate-mark nil)) | ||
| 4883 | (save-excursion | ||
| 4884 | (goto-char end) | ||
| 4885 | (setq end (point-marker)) | ||
| 4886 | (goto-char start) | ||
| 4887 | (when (bolp) | ||
| 4888 | (forward-line 1)) | ||
| 4889 | (while (< (point) end) | ||
| 4890 | (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) | ||
| 4891 | (indent-according-to-mode)) | ||
| 4892 | (forward-line 1)) | ||
| 4893 | (move-marker end nil)))) | ||
| 4894 | |||
| 4895 | |||
| 4896 | ;;; Markup Completion ========================================================= | ||
| 4897 | |||
| 4898 | (defconst markdown-complete-alist | ||
| 4899 | '((markdown-regex-header-atx . markdown-complete-atx) | ||
| 4900 | (markdown-regex-header-setext . markdown-complete-setext) | ||
| 4901 | (markdown-regex-hr . markdown-complete-hr)) | ||
| 4902 | "Association list of form (regexp . function) for markup completion.") | ||
| 4903 | |||
| 4904 | (defun markdown-incomplete-atx-p () | ||
| 4905 | "Return t if ATX header markup is incomplete and nil otherwise. | ||
| 4906 | Assumes match data is available for `markdown-regex-header-atx'. | ||
| 4907 | Checks that the number of trailing hash marks equals the number of leading | ||
| 4908 | hash marks, that there is only a single space before and after the text, | ||
| 4909 | and that there is no extraneous whitespace in the text." | ||
| 4910 | (or | ||
| 4911 | ;; Number of starting and ending hash marks differs | ||
| 4912 | (not (= (length (match-string 1)) (length (match-string 3)))) | ||
| 4913 | ;; When the header text is not empty... | ||
| 4914 | (and (> (length (match-string 2)) 0) | ||
| 4915 | ;; ...if there are extra leading, trailing, or interior spaces | ||
| 4916 | (or (not (= (match-beginning 2) (1+ (match-end 1)))) | ||
| 4917 | (not (= (match-beginning 3) (1+ (match-end 2)))) | ||
| 4918 | (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) | ||
| 4919 | ;; When the header text is empty... | ||
| 4920 | (and (= (length (match-string 2)) 0) | ||
| 4921 | ;; ...if there are too many or too few spaces | ||
| 4922 | (not (= (match-beginning 3) (+ (match-end 1) 2)))))) | ||
| 4923 | |||
| 4924 | (defun markdown-complete-atx () | ||
| 4925 | "Complete and normalize ATX headers. | ||
| 4926 | Add or remove hash marks to the end of the header to match the | ||
| 4927 | beginning. Ensure that there is only a single space between hash | ||
| 4928 | marks and header text. Removes extraneous whitespace from header text. | ||
| 4929 | Assumes match data is available for `markdown-regex-header-atx'. | ||
| 4930 | Return nil if markup was complete and non-nil if markup was completed." | ||
| 4931 | (when (markdown-incomplete-atx-p) | ||
| 4932 | (let* ((new-marker (make-marker)) | ||
| 4933 | (new-marker (set-marker new-marker (match-end 2)))) | ||
| 4934 | ;; Hash marks and spacing at end | ||
| 4935 | (goto-char (match-end 2)) | ||
| 4936 | (delete-region (match-end 2) (match-end 3)) | ||
| 4937 | (insert " " (match-string 1)) | ||
| 4938 | ;; Remove extraneous whitespace from title | ||
| 4939 | (replace-match (markdown-compress-whitespace-string (match-string 2)) | ||
| 4940 | t t nil 2) | ||
| 4941 | ;; Spacing at beginning | ||
| 4942 | (goto-char (match-end 1)) | ||
| 4943 | (delete-region (match-end 1) (match-beginning 2)) | ||
| 4944 | (insert " ") | ||
| 4945 | ;; Leave point at end of text | ||
| 4946 | (goto-char new-marker)))) | ||
| 4947 | |||
| 4948 | (defun markdown-incomplete-setext-p () | ||
| 4949 | "Return t if setext header markup is incomplete and nil otherwise. | ||
| 4950 | Assumes match data is available for `markdown-regex-header-setext'. | ||
| 4951 | Checks that length of underline matches text and that there is no | ||
| 4952 | extraneous whitespace in the text." | ||
| 4953 | (or (not (= (length (match-string 1)) (length (match-string 2)))) | ||
| 4954 | (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) | ||
| 4955 | |||
| 4956 | (defun markdown-complete-setext () | ||
| 4957 | "Complete and normalize setext headers. | ||
| 4958 | Add or remove underline characters to match length of header | ||
| 4959 | text. Removes extraneous whitespace from header text. Assumes | ||
| 4960 | match data is available for `markdown-regex-header-setext'. | ||
| 4961 | Return nil if markup was complete and non-nil if markup was completed." | ||
| 4962 | (when (markdown-incomplete-setext-p) | ||
| 4963 | (let* ((text (markdown-compress-whitespace-string (match-string 1))) | ||
| 4964 | (char (char-after (match-beginning 2))) | ||
| 4965 | (level (if (char-equal char ?-) 2 1))) | ||
| 4966 | (goto-char (match-beginning 0)) | ||
| 4967 | (delete-region (match-beginning 0) (match-end 0)) | ||
| 4968 | (markdown-insert-header level text t) | ||
| 4969 | t))) | ||
| 4970 | |||
| 4971 | (defun markdown-incomplete-hr-p () | ||
| 4972 | "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. | ||
| 4973 | Assumes match data is available for `markdown-regex-hr'." | ||
| 4974 | (not (member (match-string 0) markdown-hr-strings))) | ||
| 4975 | |||
| 4976 | (defun markdown-complete-hr () | ||
| 4977 | "Complete horizontal rules. | ||
| 4978 | If horizontal rule string is a member of `markdown-hr-strings', | ||
| 4979 | do nothing. Otherwise, replace with the car of | ||
| 4980 | `markdown-hr-strings'. | ||
| 4981 | Assumes match data is available for `markdown-regex-hr'. | ||
| 4982 | Return nil if markup was complete and non-nil if markup was completed." | ||
| 4983 | (when (markdown-incomplete-hr-p) | ||
| 4984 | (replace-match (car markdown-hr-strings)) | ||
| 4985 | t)) | ||
| 4986 | |||
| 4987 | (defun markdown-complete () | ||
| 4988 | "Complete markup of object near point or in region when active. | ||
| 4989 | Handle all objects in `markdown-complete-alist', in order. | ||
| 4990 | See `markdown-complete-at-point' and `markdown-complete-region'." | ||
| 4991 | (interactive "*") | ||
| 4992 | (if (use-region-p) | ||
| 4993 | (markdown-complete-region (region-beginning) (region-end)) | ||
| 4994 | (markdown-complete-at-point))) | ||
| 4995 | |||
| 4996 | (defun markdown-complete-at-point () | ||
| 4997 | "Complete markup of object near point. | ||
| 4998 | Handle all elements of `markdown-complete-alist' in order." | ||
| 4999 | (interactive "*") | ||
| 5000 | (let ((list markdown-complete-alist) found changed) | ||
| 5001 | (while list | ||
| 5002 | (let ((regexp (eval (caar list))) | ||
| 5003 | (function (cdar list))) | ||
| 5004 | (setq list (cdr list)) | ||
| 5005 | (when (thing-at-point-looking-at regexp) | ||
| 5006 | (setq found t) | ||
| 5007 | (setq changed (funcall function)) | ||
| 5008 | (setq list nil)))) | ||
| 5009 | (if found | ||
| 5010 | (or changed (user-error "Markup at point is complete")) | ||
| 5011 | (user-error "Nothing to complete at point")))) | ||
| 5012 | |||
| 5013 | (defun markdown-complete-region (beg end) | ||
| 5014 | "Complete markup of objects in region from BEG to END. | ||
| 5015 | Handle all objects in `markdown-complete-alist', in order. Each | ||
| 5016 | match is checked to ensure that a previous regexp does not also | ||
| 5017 | match." | ||
| 5018 | (interactive "*r") | ||
| 5019 | (let ((end-marker (set-marker (make-marker) end)) | ||
| 5020 | previous) | ||
| 5021 | (dolist (element markdown-complete-alist) | ||
| 5022 | (let ((regexp (eval (car element))) | ||
| 5023 | (function (cdr element))) | ||
| 5024 | (goto-char beg) | ||
| 5025 | (while (re-search-forward regexp end-marker 'limit) | ||
| 5026 | (when (match-string 0) | ||
| 5027 | ;; Make sure this is not a match for any of the preceding regexps. | ||
| 5028 | ;; This prevents mistaking an HR for a Setext subheading. | ||
| 5029 | (let (match) | ||
| 5030 | (save-match-data | ||
| 5031 | (dolist (prev-regexp previous) | ||
| 5032 | (or match (setq match (looking-back prev-regexp nil))))) | ||
| 5033 | (unless match | ||
| 5034 | (save-excursion (funcall function)))))) | ||
| 5035 | (cl-pushnew regexp previous :test #'equal))) | ||
| 5036 | previous)) | ||
| 5037 | |||
| 5038 | (defun markdown-complete-buffer () | ||
| 5039 | "Complete markup for all objects in the current buffer." | ||
| 5040 | (interactive "*") | ||
| 5041 | (markdown-complete-region (point-min) (point-max))) | ||
| 5042 | |||
| 5043 | |||
| 5044 | ;;; Markup Cycling ============================================================ | ||
| 5045 | |||
| 5046 | (defun markdown-cycle-atx (arg &optional remove) | ||
| 5047 | "Cycle ATX header markup. | ||
| 5048 | Promote header (decrease level) when ARG is 1 and demote | ||
| 5049 | header (increase level) if arg is -1. When REMOVE is non-nil, | ||
| 5050 | remove the header when the level reaches zero and stop cycling | ||
| 5051 | when it reaches six. Otherwise, perform a proper cycling through | ||
| 5052 | levels one through six. Assumes match data is available for | ||
| 5053 | `markdown-regex-header-atx'." | ||
| 5054 | (let* ((old-level (length (match-string 1))) | ||
| 5055 | (new-level (+ old-level arg)) | ||
| 5056 | (text (match-string 2))) | ||
| 5057 | (when (not remove) | ||
| 5058 | (setq new-level (% new-level 6)) | ||
| 5059 | (setq new-level (cond ((= new-level 0) 6) | ||
| 5060 | ((< new-level 0) (+ new-level 6)) | ||
| 5061 | (t new-level)))) | ||
| 5062 | (cond | ||
| 5063 | ((= new-level 0) | ||
| 5064 | (markdown-unwrap-thing-at-point nil 0 2)) | ||
| 5065 | ((<= new-level 6) | ||
| 5066 | (goto-char (match-beginning 0)) | ||
| 5067 | (delete-region (match-beginning 0) (match-end 0)) | ||
| 5068 | (markdown-insert-header new-level text nil))))) | ||
| 5069 | |||
| 5070 | (defun markdown-cycle-setext (arg &optional remove) | ||
| 5071 | "Cycle setext header markup. | ||
| 5072 | Promote header (increase level) when ARG is 1 and demote | ||
| 5073 | header (decrease level or remove) if arg is -1. When demoting a | ||
| 5074 | level-two setext header, replace with a level-three atx header. | ||
| 5075 | When REMOVE is non-nil, remove the header when the level reaches | ||
| 5076 | zero. Otherwise, cycle back to a level six atx header. Assumes | ||
| 5077 | match data is available for `markdown-regex-header-setext'." | ||
| 5078 | (let* ((char (char-after (match-beginning 2))) | ||
| 5079 | (old-level (if (char-equal char ?=) 1 2)) | ||
| 5080 | (new-level (+ old-level arg))) | ||
| 5081 | (when (and (not remove) (= new-level 0)) | ||
| 5082 | (setq new-level 6)) | ||
| 5083 | (cond | ||
| 5084 | ((= new-level 0) | ||
| 5085 | (markdown-unwrap-thing-at-point nil 0 1)) | ||
| 5086 | ((<= new-level 2) | ||
| 5087 | (markdown-insert-header new-level nil t)) | ||
| 5088 | ((<= new-level 6) | ||
| 5089 | (markdown-insert-header new-level nil nil))))) | ||
| 5090 | |||
| 5091 | (defun markdown-cycle-hr (arg &optional remove) | ||
| 5092 | "Cycle string used for horizontal rule from `markdown-hr-strings'. | ||
| 5093 | When ARG is 1, cycle forward (demote), and when ARG is -1, cycle | ||
| 5094 | backwards (promote). When REMOVE is non-nil, remove the hr instead | ||
| 5095 | of cycling when the end of the list is reached. | ||
| 5096 | Assumes match data is available for `markdown-regex-hr'." | ||
| 5097 | (let* ((strings (if (= arg -1) | ||
| 5098 | (reverse markdown-hr-strings) | ||
| 5099 | markdown-hr-strings)) | ||
| 5100 | (tail (member (match-string 0) strings)) | ||
| 5101 | (new (or (cadr tail) | ||
| 5102 | (if remove | ||
| 5103 | (if (= arg 1) | ||
| 5104 | "" | ||
| 5105 | (car tail)) | ||
| 5106 | (car strings))))) | ||
| 5107 | (replace-match new))) | ||
| 5108 | |||
| 5109 | (defun markdown-cycle-bold () | ||
| 5110 | "Cycle bold markup between underscores and asterisks. | ||
| 5111 | Assumes match data is available for `markdown-regex-bold'." | ||
| 5112 | (save-excursion | ||
| 5113 | (let* ((old-delim (match-string 3)) | ||
| 5114 | (new-delim (if (string-equal old-delim "**") "__" "**"))) | ||
| 5115 | (replace-match new-delim t t nil 3) | ||
| 5116 | (replace-match new-delim t t nil 5)))) | ||
| 5117 | |||
| 5118 | (defun markdown-cycle-italic () | ||
| 5119 | "Cycle italic markup between underscores and asterisks. | ||
| 5120 | Assumes match data is available for `markdown-regex-italic'." | ||
| 5121 | (save-excursion | ||
| 5122 | (let* ((old-delim (match-string 2)) | ||
| 5123 | (new-delim (if (string-equal old-delim "*") "_" "*"))) | ||
| 5124 | (replace-match new-delim t t nil 2) | ||
| 5125 | (replace-match new-delim t t nil 4)))) | ||
| 5126 | |||
| 5127 | |||
| 5128 | ;;; Keymap ==================================================================== | ||
| 5129 | |||
| 5130 | (defun markdown--style-map-prompt () | ||
| 5131 | "Return a formatted prompt for Markdown markup insertion." | ||
| 5132 | (when markdown-enable-prefix-prompts | ||
| 5133 | (concat | ||
| 5134 | "Markdown: " | ||
| 5135 | (propertize "bold" 'face 'markdown-bold-face) ", " | ||
| 5136 | (propertize "italic" 'face 'markdown-italic-face) ", " | ||
| 5137 | (propertize "code" 'face 'markdown-inline-code-face) ", " | ||
| 5138 | (propertize "C = GFM code" 'face 'markdown-code-face) ", " | ||
| 5139 | (propertize "pre" 'face 'markdown-pre-face) ", " | ||
| 5140 | (propertize "footnote" 'face 'markdown-footnote-text-face) ", " | ||
| 5141 | (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " | ||
| 5142 | (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " | ||
| 5143 | (propertize "- = hr" 'face 'markdown-hr-face) ", " | ||
| 5144 | "C-h = more"))) | ||
| 5145 | |||
| 5146 | (defun markdown--command-map-prompt () | ||
| 5147 | "Return prompt for Markdown buffer-wide commands." | ||
| 5148 | (when markdown-enable-prefix-prompts | ||
| 5149 | (concat | ||
| 5150 | "Command: " | ||
| 5151 | (propertize "m" 'face 'markdown-bold-face) "arkdown, " | ||
| 5152 | (propertize "p" 'face 'markdown-bold-face) "review, " | ||
| 5153 | (propertize "o" 'face 'markdown-bold-face) "pen, " | ||
| 5154 | (propertize "e" 'face 'markdown-bold-face) "xport, " | ||
| 5155 | "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " | ||
| 5156 | (propertize "c" 'face 'markdown-bold-face) "heck refs, " | ||
| 5157 | (propertize "u" 'face 'markdown-bold-face) "nused refs, " | ||
| 5158 | "C-h = more"))) | ||
| 5159 | |||
| 5160 | (defvar markdown-mode-style-map | ||
| 5161 | (let ((map (make-keymap (markdown--style-map-prompt)))) | ||
| 5162 | (define-key map (kbd "1") 'markdown-insert-header-atx-1) | ||
| 5163 | (define-key map (kbd "2") 'markdown-insert-header-atx-2) | ||
| 5164 | (define-key map (kbd "3") 'markdown-insert-header-atx-3) | ||
| 5165 | (define-key map (kbd "4") 'markdown-insert-header-atx-4) | ||
| 5166 | (define-key map (kbd "5") 'markdown-insert-header-atx-5) | ||
| 5167 | (define-key map (kbd "6") 'markdown-insert-header-atx-6) | ||
| 5168 | (define-key map (kbd "!") 'markdown-insert-header-setext-1) | ||
| 5169 | (define-key map (kbd "@") 'markdown-insert-header-setext-2) | ||
| 5170 | (define-key map (kbd "b") 'markdown-insert-bold) | ||
| 5171 | (define-key map (kbd "c") 'markdown-insert-code) | ||
| 5172 | (define-key map (kbd "C") 'markdown-insert-gfm-code-block) | ||
| 5173 | (define-key map (kbd "f") 'markdown-insert-footnote) | ||
| 5174 | (define-key map (kbd "h") 'markdown-insert-header-dwim) | ||
| 5175 | (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) | ||
| 5176 | (define-key map (kbd "i") 'markdown-insert-italic) | ||
| 5177 | (define-key map (kbd "k") 'markdown-insert-kbd) | ||
| 5178 | (define-key map (kbd "l") 'markdown-insert-link) | ||
| 5179 | (define-key map (kbd "p") 'markdown-insert-pre) | ||
| 5180 | (define-key map (kbd "P") 'markdown-pre-region) | ||
| 5181 | (define-key map (kbd "q") 'markdown-insert-blockquote) | ||
| 5182 | (define-key map (kbd "s") 'markdown-insert-strike-through) | ||
| 5183 | (define-key map (kbd "t") 'markdown-insert-table) | ||
| 5184 | (define-key map (kbd "Q") 'markdown-blockquote-region) | ||
| 5185 | (define-key map (kbd "w") 'markdown-insert-wiki-link) | ||
| 5186 | (define-key map (kbd "-") 'markdown-insert-hr) | ||
| 5187 | (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) | ||
| 5188 | ;; Deprecated keys that may be removed in a future version | ||
| 5189 | (define-key map (kbd "e") 'markdown-insert-italic) | ||
| 5190 | map) | ||
| 5191 | "Keymap for Markdown text styling commands.") | ||
| 5192 | |||
| 5193 | (defvar markdown-mode-command-map | ||
| 5194 | (let ((map (make-keymap (markdown--command-map-prompt)))) | ||
| 5195 | (define-key map (kbd "m") 'markdown-other-window) | ||
| 5196 | (define-key map (kbd "p") 'markdown-preview) | ||
| 5197 | (define-key map (kbd "e") 'markdown-export) | ||
| 5198 | (define-key map (kbd "v") 'markdown-export-and-preview) | ||
| 5199 | (define-key map (kbd "o") 'markdown-open) | ||
| 5200 | (define-key map (kbd "l") 'markdown-live-preview-mode) | ||
| 5201 | (define-key map (kbd "w") 'markdown-kill-ring-save) | ||
| 5202 | (define-key map (kbd "c") 'markdown-check-refs) | ||
| 5203 | (define-key map (kbd "u") 'markdown-unused-refs) | ||
| 5204 | (define-key map (kbd "n") 'markdown-cleanup-list-numbers) | ||
| 5205 | (define-key map (kbd "]") 'markdown-complete-buffer) | ||
| 5206 | (define-key map (kbd "^") 'markdown-table-sort-lines) | ||
| 5207 | (define-key map (kbd "|") 'markdown-table-convert-region) | ||
| 5208 | (define-key map (kbd "t") 'markdown-table-transpose) | ||
| 5209 | map) | ||
| 5210 | "Keymap for Markdown buffer-wide commands.") | ||
| 5211 | |||
| 5212 | (defvar markdown-mode-map | ||
| 5213 | (let ((map (make-keymap))) | ||
| 5214 | ;; Markup insertion & removal | ||
| 5215 | (define-key map (kbd "C-c C-s") markdown-mode-style-map) | ||
| 5216 | (define-key map (kbd "C-c C-l") 'markdown-insert-link) | ||
| 5217 | (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) | ||
| 5218 | ;; Promotion, demotion, and cycling | ||
| 5219 | (define-key map (kbd "C-c C--") 'markdown-promote) | ||
| 5220 | (define-key map (kbd "C-c C-=") 'markdown-demote) | ||
| 5221 | (define-key map (kbd "C-c C-]") 'markdown-complete) | ||
| 5222 | ;; Following and doing things | ||
| 5223 | (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) | ||
| 5224 | (define-key map (kbd "C-c C-d") 'markdown-do) | ||
| 5225 | (define-key map (kbd "C-c '") 'markdown-edit-code-block) | ||
| 5226 | ;; Indentation | ||
| 5227 | (define-key map (kbd "C-m") 'markdown-enter-key) | ||
| 5228 | (define-key map (kbd "DEL") 'markdown-outdent-or-delete) | ||
| 5229 | (define-key map (kbd "C-c >") 'markdown-indent-region) | ||
| 5230 | (define-key map (kbd "C-c <") 'markdown-outdent-region) | ||
| 5231 | ;; Visibility cycling | ||
| 5232 | (define-key map (kbd "TAB") 'markdown-cycle) | ||
| 5233 | (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) | ||
| 5234 | (define-key map (kbd "<S-tab>") 'markdown-shifttab) | ||
| 5235 | (define-key map (kbd "<backtab>") 'markdown-shifttab) | ||
| 5236 | ;; Heading and list navigation | ||
| 5237 | (define-key map (kbd "C-c C-n") 'markdown-outline-next) | ||
| 5238 | (define-key map (kbd "C-c C-p") 'markdown-outline-previous) | ||
| 5239 | (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) | ||
| 5240 | (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) | ||
| 5241 | (define-key map (kbd "C-c C-u") 'markdown-outline-up) | ||
| 5242 | ;; Buffer-wide commands | ||
| 5243 | (define-key map (kbd "C-c C-c") markdown-mode-command-map) | ||
| 5244 | ;; Subtree, list, and table editing | ||
| 5245 | (define-key map (kbd "C-c <up>") 'markdown-move-up) | ||
| 5246 | (define-key map (kbd "C-c <down>") 'markdown-move-down) | ||
| 5247 | (define-key map (kbd "C-c <left>") 'markdown-promote) | ||
| 5248 | (define-key map (kbd "C-c <right>") 'markdown-demote) | ||
| 5249 | (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) | ||
| 5250 | (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) | ||
| 5251 | (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) | ||
| 5252 | (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) | ||
| 5253 | (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) | ||
| 5254 | (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) | ||
| 5255 | (define-key map (kbd "M-RET") 'markdown-insert-list-item) | ||
| 5256 | (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) | ||
| 5257 | ;; Paragraphs (Markdown context aware) | ||
| 5258 | (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) | ||
| 5259 | (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) | ||
| 5260 | (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) | ||
| 5261 | ;; Blocks (one or more paragraphs) | ||
| 5262 | (define-key map (kbd "C-M-{") 'markdown-backward-block) | ||
| 5263 | (define-key map (kbd "C-M-}") 'markdown-forward-block) | ||
| 5264 | (define-key map (kbd "C-c M-h") 'markdown-mark-block) | ||
| 5265 | (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) | ||
| 5266 | ;; Pages (top-level sections) | ||
| 5267 | (define-key map [remap backward-page] 'markdown-backward-page) | ||
| 5268 | (define-key map [remap forward-page] 'markdown-forward-page) | ||
| 5269 | (define-key map [remap mark-page] 'markdown-mark-page) | ||
| 5270 | (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) | ||
| 5271 | ;; Link Movement | ||
| 5272 | (define-key map (kbd "M-n") 'markdown-next-link) | ||
| 5273 | (define-key map (kbd "M-p") 'markdown-previous-link) | ||
| 5274 | ;; Toggling functionality | ||
| 5275 | (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) | ||
| 5276 | (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) | ||
| 5277 | (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) | ||
| 5278 | (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) | ||
| 5279 | (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) | ||
| 5280 | ;; Alternative keys (in case of problems with the arrow keys) | ||
| 5281 | (define-key map (kbd "C-c C-x u") 'markdown-move-up) | ||
| 5282 | (define-key map (kbd "C-c C-x d") 'markdown-move-down) | ||
| 5283 | (define-key map (kbd "C-c C-x l") 'markdown-promote) | ||
| 5284 | (define-key map (kbd "C-c C-x r") 'markdown-demote) | ||
| 5285 | ;; Deprecated keys that may be removed in a future version | ||
| 5286 | (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l | ||
| 5287 | (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l | ||
| 5288 | (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l | ||
| 5289 | (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l | ||
| 5290 | (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) | ||
| 5291 | (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) | ||
| 5292 | (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) | ||
| 5293 | (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) | ||
| 5294 | (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) | ||
| 5295 | (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) | ||
| 5296 | (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) | ||
| 5297 | (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) | ||
| 5298 | (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) | ||
| 5299 | (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) | ||
| 5300 | (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) | ||
| 5301 | (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) | ||
| 5302 | (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) | ||
| 5303 | (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) | ||
| 5304 | (define-key map (kbd "C-c C-i") 'markdown-insert-image) | ||
| 5305 | (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j | ||
| 5306 | (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d | ||
| 5307 | (define-key map (kbd "C-c -") 'markdown-insert-hr) | ||
| 5308 | map) | ||
| 5309 | "Keymap for Markdown major mode.") | ||
| 5310 | |||
| 5311 | (defvar markdown-mode-mouse-map | ||
| 5312 | (when markdown-mouse-follow-link | ||
| 5313 | (let ((map (make-sparse-keymap))) | ||
| 5314 | (define-key map [follow-link] 'mouse-face) | ||
| 5315 | (define-key map [mouse-2] #'markdown-follow-thing-at-point) | ||
| 5316 | map)) | ||
| 5317 | "Keymap for following links with mouse.") | ||
| 5318 | |||
| 5319 | (defvar gfm-mode-map | ||
| 5320 | (let ((map (make-sparse-keymap))) | ||
| 5321 | (set-keymap-parent map markdown-mode-map) | ||
| 5322 | (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) | ||
| 5323 | (define-key map "`" 'markdown-electric-backquote) | ||
| 5324 | map) | ||
| 5325 | "Keymap for `gfm-mode'. | ||
| 5326 | See also `markdown-mode-map'.") | ||
| 5327 | |||
| 5328 | |||
| 5329 | ;;; Menu ====================================================================== | ||
| 5330 | |||
| 5331 | (easy-menu-define markdown-mode-menu markdown-mode-map | ||
| 5332 | "Menu for Markdown mode" | ||
| 5333 | '("Markdown" | ||
| 5334 | "---" | ||
| 5335 | ("Movement" | ||
| 5336 | ["Jump" markdown-do] | ||
| 5337 | ["Follow Link" markdown-follow-thing-at-point] | ||
| 5338 | ["Next Link" markdown-next-link] | ||
| 5339 | ["Previous Link" markdown-previous-link] | ||
| 5340 | "---" | ||
| 5341 | ["Next Heading or List Item" markdown-outline-next] | ||
| 5342 | ["Previous Heading or List Item" markdown-outline-previous] | ||
| 5343 | ["Next at Same Level" markdown-outline-next-same-level] | ||
| 5344 | ["Previous at Same Level" markdown-outline-previous-same-level] | ||
| 5345 | ["Up to Parent" markdown-outline-up] | ||
| 5346 | "---" | ||
| 5347 | ["Forward Paragraph" markdown-forward-paragraph] | ||
| 5348 | ["Backward Paragraph" markdown-backward-paragraph] | ||
| 5349 | ["Forward Block" markdown-forward-block] | ||
| 5350 | ["Backward Block" markdown-backward-block]) | ||
| 5351 | ("Show & Hide" | ||
| 5352 | ["Cycle Heading Visibility" markdown-cycle | ||
| 5353 | :enable (markdown-on-heading-p)] | ||
| 5354 | ["Cycle Heading Visibility (Global)" markdown-shifttab] | ||
| 5355 | "---" | ||
| 5356 | ["Narrow to Region" narrow-to-region] | ||
| 5357 | ["Narrow to Block" markdown-narrow-to-block] | ||
| 5358 | ["Narrow to Section" narrow-to-defun] | ||
| 5359 | ["Narrow to Subtree" markdown-narrow-to-subtree] | ||
| 5360 | ["Widen" widen (buffer-narrowed-p)] | ||
| 5361 | "---" | ||
| 5362 | ["Toggle Markup Hiding" markdown-toggle-markup-hiding | ||
| 5363 | :keys "C-c C-x C-m" | ||
| 5364 | :style radio | ||
| 5365 | :selected markdown-hide-markup]) | ||
| 5366 | "---" | ||
| 5367 | ("Headings & Structure" | ||
| 5368 | ["Automatic Heading" markdown-insert-header-dwim | ||
| 5369 | :keys "C-c C-s h"] | ||
| 5370 | ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim | ||
| 5371 | :keys "C-c C-s H"] | ||
| 5372 | ("Specific Heading (atx)" | ||
| 5373 | ["First Level atx" markdown-insert-header-atx-1 | ||
| 5374 | :keys "C-c C-s 1"] | ||
| 5375 | ["Second Level atx" markdown-insert-header-atx-2 | ||
| 5376 | :keys "C-c C-s 2"] | ||
| 5377 | ["Third Level atx" markdown-insert-header-atx-3 | ||
| 5378 | :keys "C-c C-s 3"] | ||
| 5379 | ["Fourth Level atx" markdown-insert-header-atx-4 | ||
| 5380 | :keys "C-c C-s 4"] | ||
| 5381 | ["Fifth Level atx" markdown-insert-header-atx-5 | ||
| 5382 | :keys "C-c C-s 5"] | ||
| 5383 | ["Sixth Level atx" markdown-insert-header-atx-6 | ||
| 5384 | :keys "C-c C-s 6"]) | ||
| 5385 | ("Specific Heading (Setext)" | ||
| 5386 | ["First Level Setext" markdown-insert-header-setext-1 | ||
| 5387 | :keys "C-c C-s !"] | ||
| 5388 | ["Second Level Setext" markdown-insert-header-setext-2 | ||
| 5389 | :keys "C-c C-s @"]) | ||
| 5390 | ["Horizontal Rule" markdown-insert-hr | ||
| 5391 | :keys "C-c C-s -"] | ||
| 5392 | "---" | ||
| 5393 | ["Move Subtree Up" markdown-move-up | ||
| 5394 | :keys "C-c <up>"] | ||
| 5395 | ["Move Subtree Down" markdown-move-down | ||
| 5396 | :keys "C-c <down>"] | ||
| 5397 | ["Promote Subtree" markdown-promote | ||
| 5398 | :keys "C-c <left>"] | ||
| 5399 | ["Demote Subtree" markdown-demote | ||
| 5400 | :keys "C-c <right>"]) | ||
| 5401 | ("Region & Mark" | ||
| 5402 | ["Indent Region" markdown-indent-region] | ||
| 5403 | ["Outdent Region" markdown-outdent-region] | ||
| 5404 | "--" | ||
| 5405 | ["Mark Paragraph" mark-paragraph] | ||
| 5406 | ["Mark Block" markdown-mark-block] | ||
| 5407 | ["Mark Section" mark-defun] | ||
| 5408 | ["Mark Subtree" markdown-mark-subtree]) | ||
| 5409 | ("Tables" | ||
| 5410 | ["Move Row Up" markdown-move-up | ||
| 5411 | :enable (markdown-table-at-point-p) | ||
| 5412 | :keys "C-c <up>"] | ||
| 5413 | ["Move Row Down" markdown-move-down | ||
| 5414 | :enable (markdown-table-at-point-p) | ||
| 5415 | :keys "C-c <down>"] | ||
| 5416 | ["Move Column Left" markdown-demote | ||
| 5417 | :enable (markdown-table-at-point-p) | ||
| 5418 | :keys "C-c <left>"] | ||
| 5419 | ["Move Column Right" markdown-promote | ||
| 5420 | :enable (markdown-table-at-point-p) | ||
| 5421 | :keys "C-c <right>"] | ||
| 5422 | ["Delete Row" markdown-table-delete-row | ||
| 5423 | :enable (markdown-table-at-point-p)] | ||
| 5424 | ["Insert Row" markdown-table-insert-row | ||
| 5425 | :enable (markdown-table-at-point-p)] | ||
| 5426 | ["Delete Column" markdown-table-delete-column | ||
| 5427 | :enable (markdown-table-at-point-p)] | ||
| 5428 | ["Insert Column" markdown-table-insert-column | ||
| 5429 | :enable (markdown-table-at-point-p)] | ||
| 5430 | ["Insert Table" markdown-insert-table] | ||
| 5431 | "--" | ||
| 5432 | ["Convert Region to Table" markdown-table-convert-region] | ||
| 5433 | ["Sort Table Lines" markdown-table-sort-lines | ||
| 5434 | :enable (markdown-table-at-point-p)] | ||
| 5435 | ["Transpose Table" markdown-table-transpose | ||
| 5436 | :enable (markdown-table-at-point-p)]) | ||
| 5437 | ("Lists" | ||
| 5438 | ["Insert List Item" markdown-insert-list-item] | ||
| 5439 | ["Move Subtree Up" markdown-move-up | ||
| 5440 | :keys "C-c <up>"] | ||
| 5441 | ["Move Subtree Down" markdown-move-down | ||
| 5442 | :keys "C-c <down>"] | ||
| 5443 | ["Indent Subtree" markdown-demote | ||
| 5444 | :keys "C-c <right>"] | ||
| 5445 | ["Outdent Subtree" markdown-promote | ||
| 5446 | :keys "C-c <left>"] | ||
| 5447 | ["Renumber List" markdown-cleanup-list-numbers] | ||
| 5448 | ["Insert Task List Item" markdown-insert-gfm-checkbox | ||
| 5449 | :keys "C-c C-x ["] | ||
| 5450 | ["Toggle Task List Item" markdown-toggle-gfm-checkbox | ||
| 5451 | :enable (markdown-gfm-task-list-item-at-point) | ||
| 5452 | :keys "C-c C-d"]) | ||
| 5453 | ("Links & Images" | ||
| 5454 | ["Insert Link" markdown-insert-link] | ||
| 5455 | ["Insert Image" markdown-insert-image] | ||
| 5456 | ["Insert Footnote" markdown-insert-footnote | ||
| 5457 | :keys "C-c C-s f"] | ||
| 5458 | ["Insert Wiki Link" markdown-insert-wiki-link | ||
| 5459 | :keys "C-c C-s w"] | ||
| 5460 | "---" | ||
| 5461 | ["Check References" markdown-check-refs] | ||
| 5462 | ["Find Unused References" markdown-unused-refs] | ||
| 5463 | ["Toggle URL Hiding" markdown-toggle-url-hiding | ||
| 5464 | :style radio | ||
| 5465 | :selected markdown-hide-urls] | ||
| 5466 | ["Toggle Inline Images" markdown-toggle-inline-images | ||
| 5467 | :keys "C-c C-x C-i" | ||
| 5468 | :style radio | ||
| 5469 | :selected markdown-inline-image-overlays] | ||
| 5470 | ["Toggle Wiki Links" markdown-toggle-wiki-links | ||
| 5471 | :style radio | ||
| 5472 | :selected markdown-enable-wiki-links]) | ||
| 5473 | ("Styles" | ||
| 5474 | ["Bold" markdown-insert-bold] | ||
| 5475 | ["Italic" markdown-insert-italic] | ||
| 5476 | ["Code" markdown-insert-code] | ||
| 5477 | ["Strikethrough" markdown-insert-strike-through] | ||
| 5478 | ["Keyboard" markdown-insert-kbd] | ||
| 5479 | "---" | ||
| 5480 | ["Blockquote" markdown-insert-blockquote] | ||
| 5481 | ["Preformatted" markdown-insert-pre] | ||
| 5482 | ["GFM Code Block" markdown-insert-gfm-code-block] | ||
| 5483 | ["Edit Code Block" markdown-edit-code-block | ||
| 5484 | :enable (markdown-code-block-at-point-p)] | ||
| 5485 | "---" | ||
| 5486 | ["Blockquote Region" markdown-blockquote-region] | ||
| 5487 | ["Preformatted Region" markdown-pre-region] | ||
| 5488 | "---" | ||
| 5489 | ["Fontify Code Blocks Natively" | ||
| 5490 | markdown-toggle-fontify-code-blocks-natively | ||
| 5491 | :style radio | ||
| 5492 | :selected markdown-fontify-code-blocks-natively] | ||
| 5493 | ["LaTeX Math Support" markdown-toggle-math | ||
| 5494 | :style radio | ||
| 5495 | :selected markdown-enable-math]) | ||
| 5496 | "---" | ||
| 5497 | ("Preview & Export" | ||
| 5498 | ["Compile" markdown-other-window] | ||
| 5499 | ["Preview" markdown-preview] | ||
| 5500 | ["Export" markdown-export] | ||
| 5501 | ["Export & View" markdown-export-and-preview] | ||
| 5502 | ["Open" markdown-open] | ||
| 5503 | ["Live Export" markdown-live-preview-mode | ||
| 5504 | :style radio | ||
| 5505 | :selected markdown-live-preview-mode] | ||
| 5506 | ["Kill ring save" markdown-kill-ring-save]) | ||
| 5507 | ("Markup Completion and Cycling" | ||
| 5508 | ["Complete Markup" markdown-complete] | ||
| 5509 | ["Promote Element" markdown-promote | ||
| 5510 | :keys "C-c C--"] | ||
| 5511 | ["Demote Element" markdown-demote | ||
| 5512 | :keys "C-c C-="]) | ||
| 5513 | "---" | ||
| 5514 | ["Kill Element" markdown-kill-thing-at-point] | ||
| 5515 | "---" | ||
| 5516 | ("Documentation" | ||
| 5517 | ["Version" markdown-show-version] | ||
| 5518 | ["Homepage" markdown-mode-info] | ||
| 5519 | ["Describe Mode" (describe-function 'markdown-mode)] | ||
| 5520 | ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) | ||
| 5521 | |||
| 5522 | |||
| 5523 | ;;; imenu ===================================================================== | ||
| 5524 | |||
| 5525 | (defun markdown-imenu-create-nested-index () | ||
| 5526 | "Create and return a nested imenu index alist for the current buffer. | ||
| 5527 | See `imenu-create-index-function' and `imenu--index-alist' for details." | ||
| 5528 | (let* ((root '(nil . nil)) | ||
| 5529 | cur-alist | ||
| 5530 | (cur-level 0) | ||
| 5531 | (empty-heading "-") | ||
| 5532 | (self-heading ".") | ||
| 5533 | hashes pos level heading) | ||
| 5534 | (save-excursion | ||
| 5535 | ;; Headings | ||
| 5536 | (goto-char (point-min)) | ||
| 5537 | (while (re-search-forward markdown-regex-header (point-max) t) | ||
| 5538 | (unless (markdown-code-block-at-point-p) | ||
| 5539 | (cond | ||
| 5540 | ((match-string-no-properties 2) ;; level 1 setext | ||
| 5541 | (setq heading (match-string-no-properties 1)) | ||
| 5542 | (setq pos (match-beginning 1) | ||
| 5543 | level 1)) | ||
| 5544 | ((match-string-no-properties 3) ;; level 2 setext | ||
| 5545 | (setq heading (match-string-no-properties 1)) | ||
| 5546 | (setq pos (match-beginning 1) | ||
| 5547 | level 2)) | ||
| 5548 | ((setq hashes (markdown-trim-whitespace | ||
| 5549 | (match-string-no-properties 4))) | ||
| 5550 | (setq heading (match-string-no-properties 5) | ||
| 5551 | pos (match-beginning 4) | ||
| 5552 | level (length hashes)))) | ||
| 5553 | (let ((alist (list (cons heading pos)))) | ||
| 5554 | (cond | ||
| 5555 | ((= cur-level level) ; new sibling | ||
| 5556 | (setcdr cur-alist alist) | ||
| 5557 | (setq cur-alist alist)) | ||
| 5558 | ((< cur-level level) ; first child | ||
| 5559 | (dotimes (_ (- level cur-level 1)) | ||
| 5560 | (setq alist (list (cons empty-heading alist)))) | ||
| 5561 | (if cur-alist | ||
| 5562 | (let* ((parent (car cur-alist)) | ||
| 5563 | (self-pos (cdr parent))) | ||
| 5564 | (setcdr parent (cons (cons self-heading self-pos) alist))) | ||
| 5565 | (setcdr root alist)) ; primogenitor | ||
| 5566 | (setq cur-alist alist) | ||
| 5567 | (setq cur-level level)) | ||
| 5568 | (t ; new sibling of an ancestor | ||
| 5569 | (let ((sibling-alist (last (cdr root)))) | ||
| 5570 | (dotimes (_ (1- level)) | ||
| 5571 | (setq sibling-alist (last (cdar sibling-alist)))) | ||
| 5572 | (setcdr sibling-alist alist) | ||
| 5573 | (setq cur-alist alist)) | ||
| 5574 | (setq cur-level level)))))) | ||
| 5575 | ;; Footnotes | ||
| 5576 | (let ((fn (markdown-get-defined-footnotes))) | ||
| 5577 | (if (or (zerop (length fn)) | ||
| 5578 | (null markdown-add-footnotes-to-imenu)) | ||
| 5579 | (cdr root) | ||
| 5580 | (nconc (cdr root) (list (cons "Footnotes" fn)))))))) | ||
| 5581 | |||
| 5582 | (defun markdown-imenu-create-flat-index () | ||
| 5583 | "Create and return a flat imenu index alist for the current buffer. | ||
| 5584 | See `imenu-create-index-function' and `imenu--index-alist' for details." | ||
| 5585 | (let* ((empty-heading "-") index heading pos) | ||
| 5586 | (save-excursion | ||
| 5587 | ;; Headings | ||
| 5588 | (goto-char (point-min)) | ||
| 5589 | (while (re-search-forward markdown-regex-header (point-max) t) | ||
| 5590 | (when (and (not (markdown-code-block-at-point-p (point-at-bol))) | ||
| 5591 | (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) | ||
| 5592 | (cond | ||
| 5593 | ((setq heading (match-string-no-properties 1)) | ||
| 5594 | (setq pos (match-beginning 1))) | ||
| 5595 | ((setq heading (match-string-no-properties 5)) | ||
| 5596 | (setq pos (match-beginning 4)))) | ||
| 5597 | (or (> (length heading) 0) | ||
| 5598 | (setq heading empty-heading)) | ||
| 5599 | (setq index (append index (list (cons heading pos)))))) | ||
| 5600 | ;; Footnotes | ||
| 5601 | (when markdown-add-footnotes-to-imenu | ||
| 5602 | (nconc index (markdown-get-defined-footnotes))) | ||
| 5603 | index))) | ||
| 5604 | |||
| 5605 | |||
| 5606 | ;;; References ================================================================ | ||
| 5607 | |||
| 5608 | (defun markdown-reference-goto-definition () | ||
| 5609 | "Jump to the definition of the reference at point or create it." | ||
| 5610 | (interactive) | ||
| 5611 | (when (thing-at-point-looking-at markdown-regex-link-reference) | ||
| 5612 | (let* ((text (match-string-no-properties 3)) | ||
| 5613 | (reference (match-string-no-properties 6)) | ||
| 5614 | (target (downcase (if (string= reference "") text reference))) | ||
| 5615 | (loc (cadr (save-match-data (markdown-reference-definition target))))) | ||
| 5616 | (if loc | ||
| 5617 | (goto-char loc) | ||
| 5618 | (goto-char (match-beginning 0)) | ||
| 5619 | (markdown-insert-reference-definition target))))) | ||
| 5620 | |||
| 5621 | (defun markdown-reference-find-links (reference) | ||
| 5622 | "Return a list of all links for REFERENCE. | ||
| 5623 | REFERENCE should not include the surrounding square brackets. | ||
| 5624 | Elements of the list have the form (text start line), where | ||
| 5625 | text is the link text, start is the location at the beginning of | ||
| 5626 | the link, and line is the line number on which the link appears." | ||
| 5627 | (let* ((ref-quote (regexp-quote reference)) | ||
| 5628 | (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" | ||
| 5629 | ref-quote ref-quote)) | ||
| 5630 | links) | ||
| 5631 | (save-excursion | ||
| 5632 | (goto-char (point-min)) | ||
| 5633 | (while (re-search-forward regexp nil t) | ||
| 5634 | (let* ((text (or (match-string-no-properties 1) | ||
| 5635 | (match-string-no-properties 2))) | ||
| 5636 | (start (match-beginning 0)) | ||
| 5637 | (line (markdown-line-number-at-pos))) | ||
| 5638 | (cl-pushnew (list text start line) links :test #'equal)))) | ||
| 5639 | links)) | ||
| 5640 | |||
| 5641 | (defmacro markdown-for-all-refs (f) | ||
| 5642 | `(let ((result)) | ||
| 5643 | (save-excursion | ||
| 5644 | (goto-char (point-min)) | ||
| 5645 | (while | ||
| 5646 | (re-search-forward markdown-regex-link-reference nil t) | ||
| 5647 | (let* ((text (match-string-no-properties 3)) | ||
| 5648 | (reference (match-string-no-properties 6)) | ||
| 5649 | (target (downcase (if (string= reference "") text reference)))) | ||
| 5650 | (,f text target result)))) | ||
| 5651 | (reverse result))) | ||
| 5652 | |||
| 5653 | (defmacro markdown-collect-always (_ target result) | ||
| 5654 | `(cl-pushnew ,target ,result :test #'equal)) | ||
| 5655 | |||
| 5656 | (defmacro markdown-collect-undefined (text target result) | ||
| 5657 | `(unless (markdown-reference-definition target) | ||
| 5658 | (let ((entry (assoc ,target ,result))) | ||
| 5659 | (if (not entry) | ||
| 5660 | (cl-pushnew | ||
| 5661 | (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) | ||
| 5662 | ,result :test #'equal) | ||
| 5663 | (setcdr entry | ||
| 5664 | (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) | ||
| 5665 | |||
| 5666 | (defun markdown-get-all-refs () | ||
| 5667 | "Return a list of all Markdown references." | ||
| 5668 | (markdown-for-all-refs markdown-collect-always)) | ||
| 5669 | |||
| 5670 | (defun markdown-get-undefined-refs () | ||
| 5671 | "Return a list of undefined Markdown references. | ||
| 5672 | Result is an alist of pairs (reference . occurrences), where | ||
| 5673 | occurrences is itself another alist of pairs (label . line-number). | ||
| 5674 | For example, an alist corresponding to [Nice editor][Emacs] at line 12, | ||
| 5675 | \[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is | ||
| 5676 | \((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." | ||
| 5677 | (markdown-for-all-refs markdown-collect-undefined)) | ||
| 5678 | |||
| 5679 | (defun markdown-get-unused-refs () | ||
| 5680 | (cl-sort | ||
| 5681 | (cl-set-difference | ||
| 5682 | (markdown-get-defined-references) (markdown-get-all-refs) | ||
| 5683 | :test (lambda (e1 e2) (equal (car e1) e2))) | ||
| 5684 | #'< :key #'cdr)) | ||
| 5685 | |||
| 5686 | (defmacro defun-markdown-buffer (name docstring) | ||
| 5687 | "Define a function to name and return a buffer. | ||
| 5688 | |||
| 5689 | By convention, NAME must be a name of a string constant with | ||
| 5690 | %buffer% placeholder used to name the buffer, and will also be | ||
| 5691 | used as a name of the function defined. | ||
| 5692 | |||
| 5693 | DOCSTRING will be used as the first part of the docstring." | ||
| 5694 | `(defun ,name (&optional buffer-name) | ||
| 5695 | ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") | ||
| 5696 | (or buffer-name (setq buffer-name (buffer-name))) | ||
| 5697 | (let ((refbuf (get-buffer-create (replace-regexp-in-string | ||
| 5698 | "%buffer%" buffer-name | ||
| 5699 | ,name)))) | ||
| 5700 | (with-current-buffer refbuf | ||
| 5701 | (when view-mode | ||
| 5702 | (View-exit-and-edit)) | ||
| 5703 | (use-local-map button-buffer-map) | ||
| 5704 | (erase-buffer)) | ||
| 5705 | refbuf))) | ||
| 5706 | |||
| 5707 | (defconst markdown-reference-check-buffer | ||
| 5708 | "*Undefined references for %buffer%*" | ||
| 5709 | "Pattern for name of buffer for listing undefined references. | ||
| 5710 | The string %buffer% will be replaced by the corresponding | ||
| 5711 | `markdown-mode' buffer name.") | ||
| 5712 | |||
| 5713 | (defun-markdown-buffer | ||
| 5714 | markdown-reference-check-buffer | ||
| 5715 | "Name and return buffer for reference checking.") | ||
| 5716 | |||
| 5717 | (defconst markdown-unused-references-buffer | ||
| 5718 | "*Unused references for %buffer%*" | ||
| 5719 | "Pattern for name of buffer for listing unused references. | ||
| 5720 | The string %buffer% will be replaced by the corresponding | ||
| 5721 | `markdown-mode' buffer name.") | ||
| 5722 | |||
| 5723 | (defun-markdown-buffer | ||
| 5724 | markdown-unused-references-buffer | ||
| 5725 | "Name and return buffer for unused reference checking.") | ||
| 5726 | |||
| 5727 | (defconst markdown-reference-links-buffer | ||
| 5728 | "*Reference links for %buffer%*" | ||
| 5729 | "Pattern for name of buffer for listing references. | ||
| 5730 | The string %buffer% will be replaced by the corresponding buffer name.") | ||
| 5731 | |||
| 5732 | (defun-markdown-buffer | ||
| 5733 | markdown-reference-links-buffer | ||
| 5734 | "Name, setup, and return a buffer for listing links.") | ||
| 5735 | |||
| 5736 | ;; Add an empty Markdown reference definition to buffer | ||
| 5737 | ;; specified in the 'target-buffer property. The reference name is | ||
| 5738 | ;; the button's label. | ||
| 5739 | (define-button-type 'markdown-undefined-reference-button | ||
| 5740 | 'help-echo "mouse-1, RET: create definition for undefined reference" | ||
| 5741 | 'follow-link t | ||
| 5742 | 'face 'bold | ||
| 5743 | 'action (lambda (b) | ||
| 5744 | (let ((buffer (button-get b 'target-buffer)) | ||
| 5745 | (line (button-get b 'target-line)) | ||
| 5746 | (label (button-label b))) | ||
| 5747 | (switch-to-buffer-other-window buffer) | ||
| 5748 | (goto-char (point-min)) | ||
| 5749 | (forward-line line) | ||
| 5750 | (markdown-insert-reference-definition label) | ||
| 5751 | (markdown-check-refs t)))) | ||
| 5752 | |||
| 5753 | ;; Jump to line in buffer specified by 'target-buffer property. | ||
| 5754 | ;; Line number is button's 'target-line property. | ||
| 5755 | (define-button-type 'markdown-goto-line-button | ||
| 5756 | 'help-echo "mouse-1, RET: go to line" | ||
| 5757 | 'follow-link t | ||
| 5758 | 'face 'italic | ||
| 5759 | 'action (lambda (b) | ||
| 5760 | (switch-to-buffer-other-window (button-get b 'target-buffer)) | ||
| 5761 | ;; use call-interactively to silence compiler | ||
| 5762 | (let ((current-prefix-arg (button-get b 'target-line))) | ||
| 5763 | (call-interactively 'goto-line)))) | ||
| 5764 | |||
| 5765 | ;; Kill a line in buffer specified by 'target-buffer property. | ||
| 5766 | ;; Line number is button's 'target-line property. | ||
| 5767 | (define-button-type 'markdown-kill-line-button | ||
| 5768 | 'help-echo "mouse-1, RET: kill line" | ||
| 5769 | 'follow-link t | ||
| 5770 | 'face 'italic | ||
| 5771 | 'action (lambda (b) | ||
| 5772 | (switch-to-buffer-other-window (button-get b 'target-buffer)) | ||
| 5773 | ;; use call-interactively to silence compiler | ||
| 5774 | (let ((current-prefix-arg (button-get b 'target-line))) | ||
| 5775 | (call-interactively 'goto-line)) | ||
| 5776 | (kill-line 1) | ||
| 5777 | (markdown-unused-refs t))) | ||
| 5778 | |||
| 5779 | ;; Jumps to a particular link at location given by 'target-char | ||
| 5780 | ;; property in buffer given by 'target-buffer property. | ||
| 5781 | (define-button-type 'markdown-location-button | ||
| 5782 | 'help-echo "mouse-1, RET: jump to location of link" | ||
| 5783 | 'follow-link t | ||
| 5784 | 'face 'bold | ||
| 5785 | 'action (lambda (b) | ||
| 5786 | (let ((target (button-get b 'target-buffer)) | ||
| 5787 | (loc (button-get b 'target-char))) | ||
| 5788 | (kill-buffer-and-window) | ||
| 5789 | (switch-to-buffer target) | ||
| 5790 | (goto-char loc)))) | ||
| 5791 | |||
| 5792 | (defun markdown-insert-undefined-reference-button (reference oldbuf) | ||
| 5793 | "Insert a button for creating REFERENCE in buffer OLDBUF. | ||
| 5794 | REFERENCE should be a list of the form (reference . occurrences), | ||
| 5795 | as returned by `markdown-get-undefined-refs'." | ||
| 5796 | (let ((label (car reference))) | ||
| 5797 | ;; Create a reference button | ||
| 5798 | (insert-button label | ||
| 5799 | :type 'markdown-undefined-reference-button | ||
| 5800 | 'target-buffer oldbuf | ||
| 5801 | 'target-line (cdr (car (cdr reference)))) | ||
| 5802 | (insert " (") | ||
| 5803 | (dolist (occurrence (cdr reference)) | ||
| 5804 | (let ((line (cdr occurrence))) | ||
| 5805 | ;; Create a line number button | ||
| 5806 | (insert-button (number-to-string line) | ||
| 5807 | :type 'markdown-goto-line-button | ||
| 5808 | 'target-buffer oldbuf | ||
| 5809 | 'target-line line) | ||
| 5810 | (insert " "))) | ||
| 5811 | (delete-char -1) | ||
| 5812 | (insert ")") | ||
| 5813 | (newline))) | ||
| 5814 | |||
| 5815 | (defun markdown-insert-unused-reference-button (reference oldbuf) | ||
| 5816 | "Insert a button for creating REFERENCE in buffer OLDBUF. | ||
| 5817 | REFERENCE must be a pair of (ref . line-number)." | ||
| 5818 | (let ((label (car reference)) | ||
| 5819 | (line (cdr reference))) | ||
| 5820 | ;; Create a reference button | ||
| 5821 | (insert-button label | ||
| 5822 | :type 'markdown-goto-line-button | ||
| 5823 | 'face 'bold | ||
| 5824 | 'target-buffer oldbuf | ||
| 5825 | 'target-line line) | ||
| 5826 | (insert (format " (%d) [" line)) | ||
| 5827 | (insert-button "X" | ||
| 5828 | :type 'markdown-kill-line-button | ||
| 5829 | 'face 'bold | ||
| 5830 | 'target-buffer oldbuf | ||
| 5831 | 'target-line line) | ||
| 5832 | (insert "]") | ||
| 5833 | (newline))) | ||
| 5834 | |||
| 5835 | (defun markdown-insert-link-button (link oldbuf) | ||
| 5836 | "Insert a button for jumping to LINK in buffer OLDBUF. | ||
| 5837 | LINK should be a list of the form (text char line) containing | ||
| 5838 | the link text, location, and line number." | ||
| 5839 | (let ((label (cl-first link)) | ||
| 5840 | (char (cl-second link)) | ||
| 5841 | (line (cl-third link))) | ||
| 5842 | ;; Create a reference button | ||
| 5843 | (insert-button label | ||
| 5844 | :type 'markdown-location-button | ||
| 5845 | 'target-buffer oldbuf | ||
| 5846 | 'target-char char) | ||
| 5847 | (insert (format " (line %d)\n" line)))) | ||
| 5848 | |||
| 5849 | (defun markdown-reference-goto-link (&optional reference) | ||
| 5850 | "Jump to the location of the first use of REFERENCE." | ||
| 5851 | (interactive) | ||
| 5852 | (unless reference | ||
| 5853 | (if (thing-at-point-looking-at markdown-regex-reference-definition) | ||
| 5854 | (setq reference (match-string-no-properties 2)) | ||
| 5855 | (user-error "No reference definition at point"))) | ||
| 5856 | (let ((links (markdown-reference-find-links reference))) | ||
| 5857 | (cond ((= (length links) 1) | ||
| 5858 | (goto-char (cadr (car links)))) | ||
| 5859 | ((> (length links) 1) | ||
| 5860 | (let ((oldbuf (current-buffer)) | ||
| 5861 | (linkbuf (markdown-reference-links-buffer))) | ||
| 5862 | (with-current-buffer linkbuf | ||
| 5863 | (insert "Links using reference " reference ":\n\n") | ||
| 5864 | (dolist (link (reverse links)) | ||
| 5865 | (markdown-insert-link-button link oldbuf))) | ||
| 5866 | (view-buffer-other-window linkbuf) | ||
| 5867 | (goto-char (point-min)) | ||
| 5868 | (forward-line 2))) | ||
| 5869 | (t | ||
| 5870 | (error "No links for reference %s" reference))))) | ||
| 5871 | |||
| 5872 | (defmacro defun-markdown-ref-checker | ||
| 5873 | (name docstring checker-function buffer-function none-message buffer-header insert-reference) | ||
| 5874 | "Define a function NAME acting on result of CHECKER-FUNCTION. | ||
| 5875 | |||
| 5876 | DOCSTRING is used as a docstring for the defined function. | ||
| 5877 | |||
| 5878 | BUFFER-FUNCTION should name and return an auxiliary buffer to put | ||
| 5879 | results in. | ||
| 5880 | |||
| 5881 | NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. | ||
| 5882 | |||
| 5883 | BUFFER-HEADER is put into the auxiliary buffer first, followed by | ||
| 5884 | calling INSERT-REFERENCE for each element in the list returned by | ||
| 5885 | CHECKER-FUNCTION." | ||
| 5886 | `(defun ,name (&optional silent) | ||
| 5887 | ,(concat | ||
| 5888 | docstring | ||
| 5889 | "\n\nIf SILENT is non-nil, do not message anything when no | ||
| 5890 | such references found.") | ||
| 5891 | (interactive "P") | ||
| 5892 | (unless (derived-mode-p 'markdown-mode) | ||
| 5893 | (user-error "Not available in current mode")) | ||
| 5894 | (let ((oldbuf (current-buffer)) | ||
| 5895 | (refs (,checker-function)) | ||
| 5896 | (refbuf (,buffer-function))) | ||
| 5897 | (if (null refs) | ||
| 5898 | (progn | ||
| 5899 | (when (not silent) | ||
| 5900 | (message ,none-message)) | ||
| 5901 | (kill-buffer refbuf)) | ||
| 5902 | (with-current-buffer refbuf | ||
| 5903 | (insert ,buffer-header) | ||
| 5904 | (dolist (ref refs) | ||
| 5905 | (,insert-reference ref oldbuf)) | ||
| 5906 | (view-buffer-other-window refbuf) | ||
| 5907 | (goto-char (point-min)) | ||
| 5908 | (forward-line 2)))))) | ||
| 5909 | |||
| 5910 | (defun-markdown-ref-checker | ||
| 5911 | markdown-check-refs | ||
| 5912 | "Show all undefined Markdown references in current `markdown-mode' buffer. | ||
| 5913 | |||
| 5914 | Links which have empty reference definitions are considered to be | ||
| 5915 | defined." | ||
| 5916 | markdown-get-undefined-refs | ||
| 5917 | markdown-reference-check-buffer | ||
| 5918 | "No undefined references found" | ||
| 5919 | "The following references are undefined:\n\n" | ||
| 5920 | markdown-insert-undefined-reference-button) | ||
| 5921 | |||
| 5922 | |||
| 5923 | (defun-markdown-ref-checker | ||
| 5924 | markdown-unused-refs | ||
| 5925 | "Show all unused Markdown references in current `markdown-mode' buffer." | ||
| 5926 | markdown-get-unused-refs | ||
| 5927 | markdown-unused-references-buffer | ||
| 5928 | "No unused references found" | ||
| 5929 | "The following references are unused:\n\n" | ||
| 5930 | markdown-insert-unused-reference-button) | ||
| 5931 | |||
| 5932 | |||
| 5933 | |||
| 5934 | ;;; Lists ===================================================================== | ||
| 5935 | |||
| 5936 | (defun markdown-insert-list-item (&optional arg) | ||
| 5937 | "Insert a new list item. | ||
| 5938 | If the point is inside unordered list, insert a bullet mark. If | ||
| 5939 | the point is inside ordered list, insert the next number followed | ||
| 5940 | by a period. Use the previous list item to determine the amount | ||
| 5941 | of whitespace to place before and after list markers. | ||
| 5942 | |||
| 5943 | With a \\[universal-argument] prefix (i.e., when ARG is (4)), | ||
| 5944 | decrease the indentation by one level. | ||
| 5945 | |||
| 5946 | With two \\[universal-argument] prefixes (i.e., when ARG is (16)), | ||
| 5947 | increase the indentation by one level." | ||
| 5948 | (interactive "p") | ||
| 5949 | (let (bounds cur-indent marker indent new-indent new-loc) | ||
| 5950 | (save-match-data | ||
| 5951 | ;; Look for a list item on current or previous non-blank line | ||
| 5952 | (save-excursion | ||
| 5953 | (while (and (not (setq bounds (markdown-cur-list-item-bounds))) | ||
| 5954 | (not (bobp)) | ||
| 5955 | (markdown-cur-line-blank-p)) | ||
| 5956 | (forward-line -1))) | ||
| 5957 | (when bounds | ||
| 5958 | (cond ((save-excursion | ||
| 5959 | (skip-chars-backward " \t") | ||
| 5960 | (looking-at-p markdown-regex-list)) | ||
| 5961 | (beginning-of-line) | ||
| 5962 | (insert "\n") | ||
| 5963 | (forward-line -1)) | ||
| 5964 | ((not (markdown-cur-line-blank-p)) | ||
| 5965 | (newline))) | ||
| 5966 | (setq new-loc (point))) | ||
| 5967 | ;; Look ahead for a list item on next non-blank line | ||
| 5968 | (unless bounds | ||
| 5969 | (save-excursion | ||
| 5970 | (while (and (null bounds) | ||
| 5971 | (not (eobp)) | ||
| 5972 | (markdown-cur-line-blank-p)) | ||
| 5973 | (forward-line) | ||
| 5974 | (setq bounds (markdown-cur-list-item-bounds)))) | ||
| 5975 | (when bounds | ||
| 5976 | (setq new-loc (point)) | ||
| 5977 | (unless (markdown-cur-line-blank-p) | ||
| 5978 | (newline)))) | ||
| 5979 | (if (not bounds) | ||
| 5980 | ;; When not in a list, start a new unordered one | ||
| 5981 | (progn | ||
| 5982 | (unless (markdown-cur-line-blank-p) | ||
| 5983 | (insert "\n")) | ||
| 5984 | (insert markdown-unordered-list-item-prefix)) | ||
| 5985 | ;; Compute indentation and marker for new list item | ||
| 5986 | (setq cur-indent (nth 2 bounds)) | ||
| 5987 | (setq marker (nth 4 bounds)) | ||
| 5988 | ;; If current item is a GFM checkbox, insert new unchecked checkbox. | ||
| 5989 | (when (nth 5 bounds) | ||
| 5990 | (setq marker | ||
| 5991 | (concat marker | ||
| 5992 | (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) | ||
| 5993 | (cond | ||
| 5994 | ;; Dedent: decrement indentation, find previous marker. | ||
| 5995 | ((= arg 4) | ||
| 5996 | (setq indent (max (- cur-indent markdown-list-indent-width) 0)) | ||
| 5997 | (let ((prev-bounds | ||
| 5998 | (save-excursion | ||
| 5999 | (goto-char (nth 0 bounds)) | ||
| 6000 | (when (markdown-up-list) | ||
| 6001 | (markdown-cur-list-item-bounds))))) | ||
| 6002 | (when prev-bounds | ||
| 6003 | (setq marker (nth 4 prev-bounds))))) | ||
| 6004 | ;; Indent: increment indentation by 4, use same marker. | ||
| 6005 | ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) | ||
| 6006 | ;; Same level: keep current indentation and marker. | ||
| 6007 | (t (setq indent cur-indent))) | ||
| 6008 | (setq new-indent (make-string indent 32)) | ||
| 6009 | (goto-char new-loc) | ||
| 6010 | (cond | ||
| 6011 | ;; Ordered list | ||
| 6012 | ((string-match-p "[0-9]" marker) | ||
| 6013 | (if (= arg 16) ;; starting a new column indented one more level | ||
| 6014 | (insert (concat new-indent "1. ")) | ||
| 6015 | ;; Don't use previous match-data | ||
| 6016 | (set-match-data nil) | ||
| 6017 | ;; travel up to the last item and pick the correct number. If | ||
| 6018 | ;; the argument was nil, "new-indent = cur-indent" is the same, | ||
| 6019 | ;; so we don't need special treatment. Neat. | ||
| 6020 | (save-excursion | ||
| 6021 | (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) | ||
| 6022 | (>= (forward-line -1) 0)))) | ||
| 6023 | (let* ((old-prefix (match-string 1)) | ||
| 6024 | (old-spacing (match-string 2)) | ||
| 6025 | (new-prefix (if old-prefix | ||
| 6026 | (int-to-string (1+ (string-to-number old-prefix))) | ||
| 6027 | "1")) | ||
| 6028 | (space-adjust (- (length old-prefix) (length new-prefix))) | ||
| 6029 | (new-spacing (if (and (match-string 2) | ||
| 6030 | (not (string-match-p "\t" old-spacing)) | ||
| 6031 | (< space-adjust 0) | ||
| 6032 | (> space-adjust (- 1 (length (match-string 2))))) | ||
| 6033 | (substring (match-string 2) 0 space-adjust) | ||
| 6034 | (or old-spacing ". ")))) | ||
| 6035 | (insert (concat new-indent new-prefix new-spacing))))) | ||
| 6036 | ;; Unordered list, GFM task list, or ordered list with hash mark | ||
| 6037 | ((string-match-p "[\\*\\+-]\\|#\\." marker) | ||
| 6038 | (insert new-indent marker)))) | ||
| 6039 | ;; Propertize the newly inserted list item now | ||
| 6040 | (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol))))) | ||
| 6041 | |||
| 6042 | (defun markdown-move-list-item-up () | ||
| 6043 | "Move the current list item up in the list when possible. | ||
| 6044 | In nested lists, move child items with the parent item." | ||
| 6045 | (interactive) | ||
| 6046 | (let (cur prev old) | ||
| 6047 | (when (setq cur (markdown-cur-list-item-bounds)) | ||
| 6048 | (setq old (point)) | ||
| 6049 | (goto-char (nth 0 cur)) | ||
| 6050 | (if (markdown-prev-list-item (nth 3 cur)) | ||
| 6051 | (progn | ||
| 6052 | (setq prev (markdown-cur-list-item-bounds)) | ||
| 6053 | (condition-case nil | ||
| 6054 | (progn | ||
| 6055 | (transpose-regions (nth 0 prev) (nth 1 prev) | ||
| 6056 | (nth 0 cur) (nth 1 cur) t) | ||
| 6057 | (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) | ||
| 6058 | ;; Catch error in case regions overlap. | ||
| 6059 | (error (goto-char old)))) | ||
| 6060 | (goto-char old))))) | ||
| 6061 | |||
| 6062 | (defun markdown-move-list-item-down () | ||
| 6063 | "Move the current list item down in the list when possible. | ||
| 6064 | In nested lists, move child items with the parent item." | ||
| 6065 | (interactive) | ||
| 6066 | (let (cur next old) | ||
| 6067 | (when (setq cur (markdown-cur-list-item-bounds)) | ||
| 6068 | (setq old (point)) | ||
| 6069 | (if (markdown-next-list-item (nth 3 cur)) | ||
| 6070 | (progn | ||
| 6071 | (setq next (markdown-cur-list-item-bounds)) | ||
| 6072 | (condition-case nil | ||
| 6073 | (progn | ||
| 6074 | (transpose-regions (nth 0 cur) (nth 1 cur) | ||
| 6075 | (nth 0 next) (nth 1 next) nil) | ||
| 6076 | (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) | ||
| 6077 | ;; Catch error in case regions overlap. | ||
| 6078 | (error (goto-char old)))) | ||
| 6079 | (goto-char old))))) | ||
| 6080 | |||
| 6081 | (defun markdown-demote-list-item (&optional bounds) | ||
| 6082 | "Indent (or demote) the current list item. | ||
| 6083 | Optionally, BOUNDS of the current list item may be provided if available. | ||
| 6084 | In nested lists, demote child items as well." | ||
| 6085 | (interactive) | ||
| 6086 | (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) | ||
| 6087 | (save-excursion | ||
| 6088 | (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) | ||
| 6089 | (item-end (set-marker (make-marker) (nth 1 bounds))) | ||
| 6090 | (list-start (progn (markdown-beginning-of-list) | ||
| 6091 | (set-marker (make-marker) (point)))) | ||
| 6092 | (list-end (progn (markdown-end-of-list) | ||
| 6093 | (set-marker (make-marker) (point))))) | ||
| 6094 | (goto-char item-start) | ||
| 6095 | (while (< (point) item-end) | ||
| 6096 | (unless (markdown-cur-line-blank-p) | ||
| 6097 | (insert (make-string markdown-list-indent-width ? ))) | ||
| 6098 | (forward-line)) | ||
| 6099 | (markdown-syntax-propertize-list-items list-start list-end))))) | ||
| 6100 | |||
| 6101 | (defun markdown-promote-list-item (&optional bounds) | ||
| 6102 | "Unindent (or promote) the current list item. | ||
| 6103 | Optionally, BOUNDS of the current list item may be provided if available. | ||
| 6104 | In nested lists, demote child items as well." | ||
| 6105 | (interactive) | ||
| 6106 | (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) | ||
| 6107 | (save-excursion | ||
| 6108 | (save-match-data | ||
| 6109 | (let ((item-start (set-marker (make-marker) (nth 0 bounds))) | ||
| 6110 | (item-end (set-marker (make-marker) (nth 1 bounds))) | ||
| 6111 | (list-start (progn (markdown-beginning-of-list) | ||
| 6112 | (set-marker (make-marker) (point)))) | ||
| 6113 | (list-end (progn (markdown-end-of-list) | ||
| 6114 | (set-marker (make-marker) (point)))) | ||
| 6115 | num regexp) | ||
| 6116 | (goto-char item-start) | ||
| 6117 | (when (looking-at (format "^[ ]\\{1,%d\\}" | ||
| 6118 | markdown-list-indent-width)) | ||
| 6119 | (setq num (- (match-end 0) (match-beginning 0))) | ||
| 6120 | (setq regexp (format "^[ ]\\{1,%d\\}" num)) | ||
| 6121 | (while (and (< (point) item-end) | ||
| 6122 | (re-search-forward regexp item-end t)) | ||
| 6123 | (replace-match "" nil nil) | ||
| 6124 | (forward-line)) | ||
| 6125 | (markdown-syntax-propertize-list-items list-start list-end))))))) | ||
| 6126 | |||
| 6127 | (defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) | ||
| 6128 | "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. | ||
| 6129 | PREV-ITEM is width of previous-indentation and list number | ||
| 6130 | |||
| 6131 | Assume that the previously found match was for a numbered item in | ||
| 6132 | a list." | ||
| 6133 | (let ((cpfx pfx) | ||
| 6134 | (cur-item nil) | ||
| 6135 | (idx 0) | ||
| 6136 | (continue t) | ||
| 6137 | (step t) | ||
| 6138 | (sep nil)) | ||
| 6139 | (while (and continue (not (eobp))) | ||
| 6140 | (setq step t) | ||
| 6141 | (cond | ||
| 6142 | ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") | ||
| 6143 | (setq cpfx (match-string-no-properties 2)) | ||
| 6144 | (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker | ||
| 6145 | (cond | ||
| 6146 | ((or (= (length cpfx) (length pfx)) | ||
| 6147 | (= (length cur-item) (length prev-item))) | ||
| 6148 | (save-excursion | ||
| 6149 | (replace-match | ||
| 6150 | (concat pfx (number-to-string (setq idx (1+ idx))) ". "))) | ||
| 6151 | (setq sep nil)) | ||
| 6152 | ;; indented a level | ||
| 6153 | ((< (length pfx) (length cpfx)) | ||
| 6154 | (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) | ||
| 6155 | (setq step nil)) | ||
| 6156 | ;; exit the loop | ||
| 6157 | (t | ||
| 6158 | (setq step nil) | ||
| 6159 | (setq continue nil)))) | ||
| 6160 | |||
| 6161 | ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") | ||
| 6162 | (setq cpfx (match-string-no-properties 1)) | ||
| 6163 | (cond | ||
| 6164 | ;; reset if separated before | ||
| 6165 | ((string= cpfx pfx) (when sep (setq idx 0))) | ||
| 6166 | ((string< cpfx pfx) | ||
| 6167 | (setq step nil) | ||
| 6168 | (setq continue nil)))) | ||
| 6169 | (t (setq sep t))) | ||
| 6170 | |||
| 6171 | (when step | ||
| 6172 | (beginning-of-line) | ||
| 6173 | (setq continue (= (forward-line) 0)))) | ||
| 6174 | sep)) | ||
| 6175 | |||
| 6176 | (defun markdown-cleanup-list-numbers () | ||
| 6177 | "Update the numbering of ordered lists." | ||
| 6178 | (interactive) | ||
| 6179 | (save-excursion | ||
| 6180 | (goto-char (point-min)) | ||
| 6181 | (markdown-cleanup-list-numbers-level ""))) | ||
| 6182 | |||
| 6183 | |||
| 6184 | ;;; Movement ================================================================== | ||
| 6185 | |||
| 6186 | (defun markdown-beginning-of-defun (&optional arg) | ||
| 6187 | "`beginning-of-defun-function' for Markdown. | ||
| 6188 | This is used to find the beginning of the defun and should behave | ||
| 6189 | like ‘beginning-of-defun’, returning non-nil if it found the | ||
| 6190 | beginning of a defun. It moves the point backward, right before a | ||
| 6191 | heading which defines a defun. When ARG is non-nil, repeat that | ||
| 6192 | many times. When ARG is negative, move forward to the ARG-th | ||
| 6193 | following section." | ||
| 6194 | (or arg (setq arg 1)) | ||
| 6195 | (when (< arg 0) (end-of-line)) | ||
| 6196 | ;; Adjust position for setext headings. | ||
| 6197 | (when (and (thing-at-point-looking-at markdown-regex-header-setext) | ||
| 6198 | (not (= (point) (match-beginning 0))) | ||
| 6199 | (not (markdown-code-block-at-point-p))) | ||
| 6200 | (goto-char (match-end 0))) | ||
| 6201 | (let (found) | ||
| 6202 | ;; Move backward with positive argument. | ||
| 6203 | (while (and (not (bobp)) (> arg 0)) | ||
| 6204 | (setq found nil) | ||
| 6205 | (while (and (not found) | ||
| 6206 | (not (bobp)) | ||
| 6207 | (re-search-backward markdown-regex-header nil 'move)) | ||
| 6208 | (when (not (markdown-code-block-at-pos (match-beginning 0)))) | ||
| 6209 | (setq found (match-beginning 0))) | ||
| 6210 | (setq arg (1- arg))) | ||
| 6211 | ;; Move forward with negative argument. | ||
| 6212 | (while (and (not (eobp)) (< arg 0)) | ||
| 6213 | (setq found nil) | ||
| 6214 | (while (and (not found) | ||
| 6215 | (not (eobp)) | ||
| 6216 | (re-search-forward markdown-regex-header nil 'move)) | ||
| 6217 | (when (not (markdown-code-block-at-pos (match-beginning 0)))) | ||
| 6218 | (setq found (match-beginning 0))) | ||
| 6219 | (setq arg (1+ arg))) | ||
| 6220 | (when found | ||
| 6221 | (beginning-of-line) | ||
| 6222 | t))) | ||
| 6223 | |||
| 6224 | (defun markdown-end-of-defun () | ||
| 6225 | "`end-of-defun-function’ for Markdown. | ||
| 6226 | This is used to find the end of the defun at point. | ||
| 6227 | It is called with no argument, right after calling ‘beginning-of-defun-raw’, | ||
| 6228 | so it can assume that point is at the beginning of the defun body. | ||
| 6229 | It should move point to the first position after the defun." | ||
| 6230 | (or (eobp) (forward-char 1)) | ||
| 6231 | (let (found) | ||
| 6232 | (while (and (not found) | ||
| 6233 | (not (eobp)) | ||
| 6234 | (re-search-forward markdown-regex-header nil 'move)) | ||
| 6235 | (when (not (markdown-code-block-at-pos (match-beginning 0))) | ||
| 6236 | (setq found (match-beginning 0)))) | ||
| 6237 | (when found | ||
| 6238 | (goto-char found) | ||
| 6239 | (skip-syntax-backward "-")))) | ||
| 6240 | |||
| 6241 | (defun markdown-beginning-of-text-block () | ||
| 6242 | "Move backward to previous beginning of a plain text block. | ||
| 6243 | This function simply looks for blank lines without considering | ||
| 6244 | the surrounding context in light of Markdown syntax. For that, see | ||
| 6245 | `markdown-backward-block'." | ||
| 6246 | (interactive) | ||
| 6247 | (let ((start (point))) | ||
| 6248 | (if (re-search-backward markdown-regex-block-separator nil t) | ||
| 6249 | (goto-char (match-end 0)) | ||
| 6250 | (goto-char (point-min))) | ||
| 6251 | (when (and (= start (point)) (not (bobp))) | ||
| 6252 | (forward-line -1) | ||
| 6253 | (if (re-search-backward markdown-regex-block-separator nil t) | ||
| 6254 | (goto-char (match-end 0)) | ||
| 6255 | (goto-char (point-min)))))) | ||
| 6256 | |||
| 6257 | (defun markdown-end-of-text-block () | ||
| 6258 | "Move forward to next beginning of a plain text block. | ||
| 6259 | This function simply looks for blank lines without considering | ||
| 6260 | the surrounding context in light of Markdown syntax. For that, see | ||
| 6261 | `markdown-forward-block'." | ||
| 6262 | (interactive) | ||
| 6263 | (beginning-of-line) | ||
| 6264 | (skip-chars-forward " \t\n") | ||
| 6265 | (when (= (point) (point-min)) | ||
| 6266 | (forward-char)) | ||
| 6267 | (if (re-search-forward markdown-regex-block-separator nil t) | ||
| 6268 | (goto-char (match-end 0)) | ||
| 6269 | (goto-char (point-max))) | ||
| 6270 | (skip-chars-backward " \t\n") | ||
| 6271 | (forward-line)) | ||
| 6272 | |||
| 6273 | (defun markdown-backward-paragraph (&optional arg) | ||
| 6274 | "Move the point to the start of the current paragraph. | ||
| 6275 | With argument ARG, do it ARG times; a negative argument ARG = -N | ||
| 6276 | means move forward N blocks." | ||
| 6277 | (interactive "^p") | ||
| 6278 | (or arg (setq arg 1)) | ||
| 6279 | (if (< arg 0) | ||
| 6280 | (markdown-forward-paragraph (- arg)) | ||
| 6281 | (dotimes (_ arg) | ||
| 6282 | ;; Skip over whitespace in between paragraphs when moving backward. | ||
| 6283 | (skip-chars-backward " \t\n") | ||
| 6284 | (beginning-of-line) | ||
| 6285 | ;; Skip over code block endings. | ||
| 6286 | (when (markdown-range-properties-exist | ||
| 6287 | (point-at-bol) (point-at-eol) | ||
| 6288 | '(markdown-gfm-block-end | ||
| 6289 | markdown-tilde-fence-end)) | ||
| 6290 | (forward-line -1)) | ||
| 6291 | ;; Skip over blank lines inside blockquotes. | ||
| 6292 | (while (and (not (eobp)) | ||
| 6293 | (looking-at markdown-regex-blockquote) | ||
| 6294 | (= (length (match-string 3)) 0)) | ||
| 6295 | (forward-line -1)) | ||
| 6296 | ;; Proceed forward based on the type of block of paragraph. | ||
| 6297 | (let (bounds skip) | ||
| 6298 | (cond | ||
| 6299 | ;; Blockquotes | ||
| 6300 | ((looking-at markdown-regex-blockquote) | ||
| 6301 | (while (and (not (bobp)) | ||
| 6302 | (looking-at markdown-regex-blockquote) | ||
| 6303 | (> (length (match-string 3)) 0)) ;; not blank | ||
| 6304 | (forward-line -1)) | ||
| 6305 | (forward-line)) | ||
| 6306 | ;; List items | ||
| 6307 | ((setq bounds (markdown-cur-list-item-bounds)) | ||
| 6308 | (goto-char (nth 0 bounds))) | ||
| 6309 | ;; Other | ||
| 6310 | (t | ||
| 6311 | (while (and (not (bobp)) | ||
| 6312 | (not skip) | ||
| 6313 | (not (markdown-cur-line-blank-p)) | ||
| 6314 | (not (looking-at markdown-regex-blockquote)) | ||
| 6315 | (not (markdown-range-properties-exist | ||
| 6316 | (point-at-bol) (point-at-eol) | ||
| 6317 | '(markdown-gfm-block-end | ||
| 6318 | markdown-tilde-fence-end)))) | ||
| 6319 | (setq skip (markdown-range-properties-exist | ||
| 6320 | (point-at-bol) (point-at-eol) | ||
| 6321 | '(markdown-gfm-block-begin | ||
| 6322 | markdown-tilde-fence-begin))) | ||
| 6323 | (forward-line -1)) | ||
| 6324 | (unless (bobp) | ||
| 6325 | (forward-line 1)))))))) | ||
| 6326 | |||
| 6327 | (defun markdown-forward-paragraph (&optional arg) | ||
| 6328 | "Move forward to the next end of a paragraph. | ||
| 6329 | With argument ARG, do it ARG times; a negative argument ARG = -N | ||
| 6330 | means move backward N blocks." | ||
| 6331 | (interactive "^p") | ||
| 6332 | (or arg (setq arg 1)) | ||
| 6333 | (if (< arg 0) | ||
| 6334 | (markdown-backward-paragraph (- arg)) | ||
| 6335 | (dotimes (_ arg) | ||
| 6336 | ;; Skip whitespace in between paragraphs. | ||
| 6337 | (when (markdown-cur-line-blank-p) | ||
| 6338 | (skip-syntax-forward "-") | ||
| 6339 | (beginning-of-line)) | ||
| 6340 | ;; Proceed forward based on the type of block. | ||
| 6341 | (let (bounds skip) | ||
| 6342 | (cond | ||
| 6343 | ;; Blockquotes | ||
| 6344 | ((looking-at markdown-regex-blockquote) | ||
| 6345 | ;; Skip over blank lines inside blockquotes. | ||
| 6346 | (while (and (not (eobp)) | ||
| 6347 | (looking-at markdown-regex-blockquote) | ||
| 6348 | (= (length (match-string 3)) 0)) | ||
| 6349 | (forward-line)) | ||
| 6350 | ;; Move to end of quoted text block | ||
| 6351 | (while (and (not (eobp)) | ||
| 6352 | (looking-at markdown-regex-blockquote) | ||
| 6353 | (> (length (match-string 3)) 0)) ;; not blank | ||
| 6354 | (forward-line))) | ||
| 6355 | ;; List items | ||
| 6356 | ((and (markdown-cur-list-item-bounds) | ||
| 6357 | (setq bounds (markdown-next-list-item-bounds))) | ||
| 6358 | (goto-char (nth 0 bounds))) | ||
| 6359 | ;; Other | ||
| 6360 | (t | ||
| 6361 | (forward-line) | ||
| 6362 | (while (and (not (eobp)) | ||
| 6363 | (not skip) | ||
| 6364 | (not (markdown-cur-line-blank-p)) | ||
| 6365 | (not (looking-at markdown-regex-blockquote)) | ||
| 6366 | (not (markdown-range-properties-exist | ||
| 6367 | (point-at-bol) (point-at-eol) | ||
| 6368 | '(markdown-gfm-block-begin | ||
| 6369 | markdown-tilde-fence-begin)))) | ||
| 6370 | (setq skip (markdown-range-properties-exist | ||
| 6371 | (point-at-bol) (point-at-eol) | ||
| 6372 | '(markdown-gfm-block-end | ||
| 6373 | markdown-tilde-fence-end))) | ||
| 6374 | (forward-line)))))))) | ||
| 6375 | |||
| 6376 | (defun markdown-backward-block (&optional arg) | ||
| 6377 | "Move the point to the start of the current Markdown block. | ||
| 6378 | Moves across complete code blocks, list items, and blockquotes, | ||
| 6379 | but otherwise stops at blank lines, headers, and horizontal | ||
| 6380 | rules. With argument ARG, do it ARG times; a negative argument | ||
| 6381 | ARG = -N means move forward N blocks." | ||
| 6382 | (interactive "^p") | ||
| 6383 | (or arg (setq arg 1)) | ||
| 6384 | (if (< arg 0) | ||
| 6385 | (markdown-forward-block (- arg)) | ||
| 6386 | (dotimes (_ arg) | ||
| 6387 | ;; Skip over whitespace in between blocks when moving backward, | ||
| 6388 | ;; unless at a block boundary with no whitespace. | ||
| 6389 | (skip-syntax-backward "-") | ||
| 6390 | (beginning-of-line) | ||
| 6391 | ;; Proceed forward based on the type of block. | ||
| 6392 | (cond | ||
| 6393 | ;; Code blocks | ||
| 6394 | ((and (markdown-code-block-at-pos (point)) ;; this line | ||
| 6395 | (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line | ||
| 6396 | (forward-line -1) | ||
| 6397 | (while (and (markdown-code-block-at-point-p) (not (bobp))) | ||
| 6398 | (forward-line -1)) | ||
| 6399 | (forward-line)) | ||
| 6400 | ;; Headings | ||
| 6401 | ((markdown-heading-at-point) | ||
| 6402 | (goto-char (match-beginning 0))) | ||
| 6403 | ;; Horizontal rules | ||
| 6404 | ((looking-at markdown-regex-hr)) | ||
| 6405 | ;; Blockquotes | ||
| 6406 | ((looking-at markdown-regex-blockquote) | ||
| 6407 | (forward-line -1) | ||
| 6408 | (while (and (looking-at markdown-regex-blockquote) | ||
| 6409 | (not (bobp))) | ||
| 6410 | (forward-line -1)) | ||
| 6411 | (forward-line)) | ||
| 6412 | ;; List items | ||
| 6413 | ((markdown-cur-list-item-bounds) | ||
| 6414 | (markdown-beginning-of-list)) | ||
| 6415 | ;; Other | ||
| 6416 | (t | ||
| 6417 | ;; Move forward in case it is a one line regular paragraph. | ||
| 6418 | (unless (markdown-next-line-blank-p) | ||
| 6419 | (forward-line)) | ||
| 6420 | (unless (markdown-prev-line-blank-p) | ||
| 6421 | (markdown-backward-paragraph))))))) | ||
| 6422 | |||
| 6423 | (defun markdown-forward-block (&optional arg) | ||
| 6424 | "Move forward to the next end of a Markdown block. | ||
| 6425 | Moves across complete code blocks, list items, and blockquotes, | ||
| 6426 | but otherwise stops at blank lines, headers, and horizontal | ||
| 6427 | rules. With argument ARG, do it ARG times; a negative argument | ||
| 6428 | ARG = -N means move backward N blocks." | ||
| 6429 | (interactive "^p") | ||
| 6430 | (or arg (setq arg 1)) | ||
| 6431 | (if (< arg 0) | ||
| 6432 | (markdown-backward-block (- arg)) | ||
| 6433 | (dotimes (_ arg) | ||
| 6434 | ;; Skip over whitespace in between blocks when moving forward. | ||
| 6435 | (if (markdown-cur-line-blank-p) | ||
| 6436 | (skip-syntax-forward "-") | ||
| 6437 | (beginning-of-line)) | ||
| 6438 | ;; Proceed forward based on the type of block. | ||
| 6439 | (cond | ||
| 6440 | ;; Code blocks | ||
| 6441 | ((markdown-code-block-at-point-p) | ||
| 6442 | (forward-line) | ||
| 6443 | (while (and (markdown-code-block-at-point-p) (not (eobp))) | ||
| 6444 | (forward-line))) | ||
| 6445 | ;; Headings | ||
| 6446 | ((looking-at markdown-regex-header) | ||
| 6447 | (goto-char (or (match-end 4) (match-end 2) (match-end 3))) | ||
| 6448 | (forward-line)) | ||
| 6449 | ;; Horizontal rules | ||
| 6450 | ((looking-at markdown-regex-hr) | ||
| 6451 | (forward-line)) | ||
| 6452 | ;; Blockquotes | ||
| 6453 | ((looking-at markdown-regex-blockquote) | ||
| 6454 | (forward-line) | ||
| 6455 | (while (and (looking-at markdown-regex-blockquote) (not (eobp))) | ||
| 6456 | (forward-line))) | ||
| 6457 | ;; List items | ||
| 6458 | ((markdown-cur-list-item-bounds) | ||
| 6459 | (markdown-end-of-list) | ||
| 6460 | (forward-line)) | ||
| 6461 | ;; Other | ||
| 6462 | (t (markdown-forward-paragraph)))) | ||
| 6463 | (skip-syntax-backward "-") | ||
| 6464 | (unless (eobp) | ||
| 6465 | (forward-char 1)))) | ||
| 6466 | |||
| 6467 | (defun markdown-backward-page (&optional count) | ||
| 6468 | "Move backward to boundary of the current toplevel section. | ||
| 6469 | With COUNT, repeat, or go forward if negative." | ||
| 6470 | (interactive "p") | ||
| 6471 | (or count (setq count 1)) | ||
| 6472 | (if (< count 0) | ||
| 6473 | (markdown-forward-page (- count)) | ||
| 6474 | (skip-syntax-backward "-") | ||
| 6475 | (or (markdown-back-to-heading-over-code-block t t) | ||
| 6476 | (goto-char (point-min))) | ||
| 6477 | (when (looking-at markdown-regex-header) | ||
| 6478 | (let ((level (markdown-outline-level))) | ||
| 6479 | (when (> level 1) (markdown-up-heading level)) | ||
| 6480 | (when (> count 1) | ||
| 6481 | (condition-case nil | ||
| 6482 | (markdown-backward-same-level (1- count)) | ||
| 6483 | (error (goto-char (point-min))))))))) | ||
| 6484 | |||
| 6485 | (defun markdown-forward-page (&optional count) | ||
| 6486 | "Move forward to boundary of the current toplevel section. | ||
| 6487 | With COUNT, repeat, or go backward if negative." | ||
| 6488 | (interactive "p") | ||
| 6489 | (or count (setq count 1)) | ||
| 6490 | (if (< count 0) | ||
| 6491 | (markdown-backward-page (- count)) | ||
| 6492 | (if (markdown-back-to-heading-over-code-block t t) | ||
| 6493 | (let ((level (markdown-outline-level))) | ||
| 6494 | (when (> level 1) (markdown-up-heading level)) | ||
| 6495 | (condition-case nil | ||
| 6496 | (markdown-forward-same-level count) | ||
| 6497 | (error (goto-char (point-max))))) | ||
| 6498 | (markdown-next-visible-heading 1)))) | ||
| 6499 | |||
| 6500 | (defun markdown-next-link () | ||
| 6501 | "Jump to next inline, reference, or wiki link. | ||
| 6502 | If successful, return point. Otherwise, return nil. | ||
| 6503 | See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." | ||
| 6504 | (interactive) | ||
| 6505 | (let ((opoint (point))) | ||
| 6506 | (when (or (markdown-link-p) (markdown-wiki-link-p)) | ||
| 6507 | ;; At a link already, move past it. | ||
| 6508 | (goto-char (+ (match-end 0) 1))) | ||
| 6509 | ;; Search for the next wiki link and move to the beginning. | ||
| 6510 | (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) | ||
| 6511 | (markdown-code-block-at-point-p) | ||
| 6512 | (< (point) (point-max)))) | ||
| 6513 | (if (and (not (eq (point) opoint)) | ||
| 6514 | (or (markdown-link-p) (markdown-wiki-link-p))) | ||
| 6515 | ;; Group 1 will move past non-escape character in wiki link regexp. | ||
| 6516 | ;; Go to beginning of group zero for all other link types. | ||
| 6517 | (goto-char (or (match-beginning 1) (match-beginning 0))) | ||
| 6518 | (goto-char opoint) | ||
| 6519 | nil))) | ||
| 6520 | |||
| 6521 | (defun markdown-previous-link () | ||
| 6522 | "Jump to previous wiki link. | ||
| 6523 | If successful, return point. Otherwise, return nil. | ||
| 6524 | See `markdown-wiki-link-p' and `markdown-next-wiki-link'." | ||
| 6525 | (interactive) | ||
| 6526 | (let ((opoint (point))) | ||
| 6527 | (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) | ||
| 6528 | (markdown-code-block-at-point-p) | ||
| 6529 | (> (point) (point-min)))) | ||
| 6530 | (if (and (not (eq (point) opoint)) | ||
| 6531 | (or (markdown-link-p) (markdown-wiki-link-p))) | ||
| 6532 | (goto-char (or (match-beginning 1) (match-beginning 0))) | ||
| 6533 | (goto-char opoint) | ||
| 6534 | nil))) | ||
| 6535 | |||
| 6536 | |||
| 6537 | ;;; Outline =================================================================== | ||
| 6538 | |||
| 6539 | (defun markdown-move-heading-common (move-fn &optional arg adjust) | ||
| 6540 | "Wrapper for `outline-mode' functions to skip false positives. | ||
| 6541 | MOVE-FN is a function and ARG is its argument. For example, | ||
| 6542 | headings inside preformatted code blocks may match | ||
| 6543 | `outline-regexp' but should not be considered as headings. | ||
| 6544 | When ADJUST is non-nil, adjust the point for interactive calls | ||
| 6545 | to avoid leaving the point at invisible markup. This adjustment | ||
| 6546 | generally should only be done for interactive calls, since other | ||
| 6547 | functions may expect the point to be at the beginning of the | ||
| 6548 | regular expression." | ||
| 6549 | (let ((prev -1) (start (point))) | ||
| 6550 | (if arg (funcall move-fn arg) (funcall move-fn)) | ||
| 6551 | (while (and (/= prev (point)) (markdown-code-block-at-point-p)) | ||
| 6552 | (setq prev (point)) | ||
| 6553 | (if arg (funcall move-fn arg) (funcall move-fn))) | ||
| 6554 | ;; Adjust point for setext headings and invisible text. | ||
| 6555 | (save-match-data | ||
| 6556 | (when (and adjust (thing-at-point-looking-at markdown-regex-header)) | ||
| 6557 | (if markdown-hide-markup | ||
| 6558 | ;; Move to beginning of heading text if markup is hidden. | ||
| 6559 | (goto-char (or (match-beginning 1) (match-beginning 5))) | ||
| 6560 | ;; Move to beginning of markup otherwise. | ||
| 6561 | (goto-char (or (match-beginning 1) (match-beginning 4)))))) | ||
| 6562 | (if (= (point) start) nil (point)))) | ||
| 6563 | |||
| 6564 | (defun markdown-next-visible-heading (arg) | ||
| 6565 | "Move to the next visible heading line of any level. | ||
| 6566 | With argument, repeats or can move backward if negative. ARG is | ||
| 6567 | passed to `outline-next-visible-heading'." | ||
| 6568 | (interactive "p") | ||
| 6569 | (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) | ||
| 6570 | |||
| 6571 | (defun markdown-previous-visible-heading (arg) | ||
| 6572 | "Move to the previous visible heading line of any level. | ||
| 6573 | With argument, repeats or can move backward if negative. ARG is | ||
| 6574 | passed to `outline-previous-visible-heading'." | ||
| 6575 | (interactive "p") | ||
| 6576 | (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) | ||
| 6577 | |||
| 6578 | (defun markdown-next-heading () | ||
| 6579 | "Move to the next heading line of any level." | ||
| 6580 | (markdown-move-heading-common #'outline-next-heading)) | ||
| 6581 | |||
| 6582 | (defun markdown-previous-heading () | ||
| 6583 | "Move to the previous heading line of any level." | ||
| 6584 | (markdown-move-heading-common #'outline-previous-heading)) | ||
| 6585 | |||
| 6586 | (defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) | ||
| 6587 | "Move back to the beginning of the previous heading. | ||
| 6588 | Returns t if the point is at a heading, the location if a heading | ||
| 6589 | was found, and nil otherwise. | ||
| 6590 | Only visible heading lines are considered, unless INVISIBLE-OK is | ||
| 6591 | non-nil. Throw an error if there is no previous heading unless | ||
| 6592 | NO-ERROR is non-nil. | ||
| 6593 | Leaves match data intact for `markdown-regex-header'." | ||
| 6594 | (beginning-of-line) | ||
| 6595 | (or (and (markdown-heading-at-point) | ||
| 6596 | (not (markdown-code-block-at-point-p))) | ||
| 6597 | (let (found) | ||
| 6598 | (save-excursion | ||
| 6599 | (while (and (not found) | ||
| 6600 | (re-search-backward markdown-regex-header nil t)) | ||
| 6601 | (when (and (or invisible-ok (not (outline-invisible-p))) | ||
| 6602 | (not (markdown-code-block-at-point-p))) | ||
| 6603 | (setq found (point)))) | ||
| 6604 | (if (not found) | ||
| 6605 | (unless no-error (user-error "Before first heading")) | ||
| 6606 | (setq found (point)))) | ||
| 6607 | (when found (goto-char found))))) | ||
| 6608 | |||
| 6609 | (defun markdown-forward-same-level (arg) | ||
| 6610 | "Move forward to the ARG'th heading at same level as this one. | ||
| 6611 | Stop at the first and last headings of a superior heading." | ||
| 6612 | (interactive "p") | ||
| 6613 | (markdown-back-to-heading-over-code-block) | ||
| 6614 | (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) | ||
| 6615 | |||
| 6616 | (defun markdown-backward-same-level (arg) | ||
| 6617 | "Move backward to the ARG'th heading at same level as this one. | ||
| 6618 | Stop at the first and last headings of a superior heading." | ||
| 6619 | (interactive "p") | ||
| 6620 | (markdown-back-to-heading-over-code-block) | ||
| 6621 | (while (> arg 0) | ||
| 6622 | (let ((point-to-move-to | ||
| 6623 | (save-excursion | ||
| 6624 | (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) | ||
| 6625 | (if point-to-move-to | ||
| 6626 | (progn | ||
| 6627 | (goto-char point-to-move-to) | ||
| 6628 | (setq arg (1- arg))) | ||
| 6629 | (user-error "No previous same-level heading"))))) | ||
| 6630 | |||
| 6631 | (defun markdown-up-heading (arg &optional interactive) | ||
| 6632 | "Move to the visible heading line of which the present line is a subheading. | ||
| 6633 | With argument, move up ARG levels. When called interactively (or | ||
| 6634 | INTERACTIVE is non-nil), also push the mark." | ||
| 6635 | (interactive "p\np") | ||
| 6636 | (and interactive (not (eq last-command 'markdown-up-heading)) | ||
| 6637 | (push-mark)) | ||
| 6638 | (markdown-move-heading-common #'outline-up-heading arg 'adjust)) | ||
| 6639 | |||
| 6640 | (defun markdown-back-to-heading (&optional invisible-ok) | ||
| 6641 | "Move to previous heading line, or beg of this line if it's a heading. | ||
| 6642 | Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | ||
| 6643 | (interactive) | ||
| 6644 | (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) | ||
| 6645 | |||
| 6646 | (defalias 'markdown-end-of-heading 'outline-end-of-heading) | ||
| 6647 | |||
| 6648 | (defun markdown-on-heading-p () | ||
| 6649 | "Return non-nil if point is on a heading line." | ||
| 6650 | (get-text-property (point-at-bol) 'markdown-heading)) | ||
| 6651 | |||
| 6652 | (defun markdown-end-of-subtree (&optional invisible-OK) | ||
| 6653 | "Move to the end of the current subtree. | ||
| 6654 | Only visible heading lines are considered, unless INVISIBLE-OK is | ||
| 6655 | non-nil. | ||
| 6656 | Derived from `org-end-of-subtree'." | ||
| 6657 | (markdown-back-to-heading invisible-OK) | ||
| 6658 | (let ((first t) | ||
| 6659 | (level (markdown-outline-level))) | ||
| 6660 | (while (and (not (eobp)) | ||
| 6661 | (or first (> (markdown-outline-level) level))) | ||
| 6662 | (setq first nil) | ||
| 6663 | (markdown-next-heading)) | ||
| 6664 | (if (memq (preceding-char) '(?\n ?\^M)) | ||
| 6665 | (progn | ||
| 6666 | ;; Go to end of line before heading | ||
| 6667 | (forward-char -1) | ||
| 6668 | (if (memq (preceding-char) '(?\n ?\^M)) | ||
| 6669 | ;; leave blank line before heading | ||
| 6670 | (forward-char -1))))) | ||
| 6671 | (point)) | ||
| 6672 | |||
| 6673 | (defun markdown-outline-fix-visibility () | ||
| 6674 | "Hide any false positive headings that should not be shown. | ||
| 6675 | For example, headings inside preformatted code blocks may match | ||
| 6676 | `outline-regexp' but should not be shown as headings when cycling. | ||
| 6677 | Also, the ending --- line in metadata blocks appears to be a | ||
| 6678 | setext header, but should not be folded." | ||
| 6679 | (save-excursion | ||
| 6680 | (goto-char (point-min)) | ||
| 6681 | ;; Unhide any false positives in metadata blocks | ||
| 6682 | (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) | ||
| 6683 | (let ((body (progn (forward-line) | ||
| 6684 | (markdown-text-property-at-point | ||
| 6685 | 'markdown-yaml-metadata-section)))) | ||
| 6686 | (when body | ||
| 6687 | (let ((end (progn (goto-char (cl-second body)) | ||
| 6688 | (markdown-text-property-at-point | ||
| 6689 | 'markdown-yaml-metadata-end)))) | ||
| 6690 | (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) | ||
| 6691 | ;; Hide any false positives in code blocks | ||
| 6692 | (unless (outline-on-heading-p) | ||
| 6693 | (outline-next-visible-heading 1)) | ||
| 6694 | (while (< (point) (point-max)) | ||
| 6695 | (when (markdown-code-block-at-point-p) | ||
| 6696 | (outline-flag-region (1- (point-at-bol)) (point-at-eol) t)) | ||
| 6697 | (outline-next-visible-heading 1)))) | ||
| 6698 | |||
| 6699 | (defvar markdown-cycle-global-status 1) | ||
| 6700 | (defvar markdown-cycle-subtree-status nil) | ||
| 6701 | |||
| 6702 | (defun markdown-next-preface () | ||
| 6703 | (let (finish) | ||
| 6704 | (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") | ||
| 6705 | nil 'move)) | ||
| 6706 | (unless (markdown-code-block-at-point-p) | ||
| 6707 | (goto-char (match-beginning 0)) | ||
| 6708 | (setq finish t)))) | ||
| 6709 | (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) | ||
| 6710 | (forward-char -1))) | ||
| 6711 | |||
| 6712 | (defun markdown-show-entry () | ||
| 6713 | (save-excursion | ||
| 6714 | (outline-back-to-heading t) | ||
| 6715 | (outline-flag-region (1- (point)) | ||
| 6716 | (progn | ||
| 6717 | (markdown-next-preface) | ||
| 6718 | (if (= 1 (- (point-max) (point))) | ||
| 6719 | (point-max) | ||
| 6720 | (point))) | ||
| 6721 | nil))) | ||
| 6722 | |||
| 6723 | ;; This function was originally derived from `org-cycle' from org.el. | ||
| 6724 | (defun markdown-cycle (&optional arg) | ||
| 6725 | "Visibility cycling for Markdown mode. | ||
| 6726 | This function is called with a `\\[universal-argument]' or if ARG is t, perform | ||
| 6727 | global visibility cycling. If the point is at an atx-style header, cycle | ||
| 6728 | visibility of the corresponding subtree. Otherwise, indent the current line | ||
| 6729 | or insert a tab, as appropriate, by calling `indent-for-tab-command'." | ||
| 6730 | (interactive "P") | ||
| 6731 | (cond | ||
| 6732 | |||
| 6733 | ;; Global cycling | ||
| 6734 | (arg | ||
| 6735 | (cond | ||
| 6736 | ;; Move from overview to contents | ||
| 6737 | ((and (eq last-command this-command) | ||
| 6738 | (eq markdown-cycle-global-status 2)) | ||
| 6739 | (outline-hide-sublevels 1) | ||
| 6740 | (message "CONTENTS") | ||
| 6741 | (setq markdown-cycle-global-status 3) | ||
| 6742 | (markdown-outline-fix-visibility)) | ||
| 6743 | ;; Move from contents to all | ||
| 6744 | ((and (eq last-command this-command) | ||
| 6745 | (eq markdown-cycle-global-status 3)) | ||
| 6746 | (outline-show-all) | ||
| 6747 | (message "SHOW ALL") | ||
| 6748 | (setq markdown-cycle-global-status 1)) | ||
| 6749 | ;; Defaults to overview | ||
| 6750 | (t | ||
| 6751 | (outline-hide-body) | ||
| 6752 | (message "OVERVIEW") | ||
| 6753 | (setq markdown-cycle-global-status 2) | ||
| 6754 | (markdown-outline-fix-visibility)))) | ||
| 6755 | |||
| 6756 | ;; At a heading: rotate between three different views | ||
| 6757 | ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) | ||
| 6758 | (markdown-back-to-heading) | ||
| 6759 | (let ((goal-column 0) eoh eol eos) | ||
| 6760 | ;; Determine boundaries | ||
| 6761 | (save-excursion | ||
| 6762 | (markdown-back-to-heading) | ||
| 6763 | (save-excursion | ||
| 6764 | (beginning-of-line 2) | ||
| 6765 | (while (and (not (eobp)) ;; this is like `next-line' | ||
| 6766 | (get-char-property (1- (point)) 'invisible)) | ||
| 6767 | (beginning-of-line 2)) (setq eol (point))) | ||
| 6768 | (markdown-end-of-heading) (setq eoh (point)) | ||
| 6769 | (markdown-end-of-subtree t) | ||
| 6770 | (skip-chars-forward " \t\n") | ||
| 6771 | (beginning-of-line 1) ; in case this is an item | ||
| 6772 | (setq eos (1- (point)))) | ||
| 6773 | ;; Find out what to do next and set `this-command' | ||
| 6774 | (cond | ||
| 6775 | ;; Nothing is hidden behind this heading | ||
| 6776 | ((= eos eoh) | ||
| 6777 | (message "EMPTY ENTRY") | ||
| 6778 | (setq markdown-cycle-subtree-status nil)) | ||
| 6779 | ;; Entire subtree is hidden in one line: open it | ||
| 6780 | ((>= eol eos) | ||
| 6781 | (markdown-show-entry) | ||
| 6782 | (outline-show-children) | ||
| 6783 | (message "CHILDREN") | ||
| 6784 | (setq markdown-cycle-subtree-status 'children)) | ||
| 6785 | ;; We just showed the children, now show everything. | ||
| 6786 | ((and (eq last-command this-command) | ||
| 6787 | (eq markdown-cycle-subtree-status 'children)) | ||
| 6788 | (outline-show-subtree) | ||
| 6789 | (message "SUBTREE") | ||
| 6790 | (setq markdown-cycle-subtree-status 'subtree)) | ||
| 6791 | ;; Default action: hide the subtree. | ||
| 6792 | (t | ||
| 6793 | (outline-hide-subtree) | ||
| 6794 | (message "FOLDED") | ||
| 6795 | (setq markdown-cycle-subtree-status 'folded))))) | ||
| 6796 | |||
| 6797 | ;; In a table, move forward by one cell | ||
| 6798 | ((markdown-table-at-point-p) | ||
| 6799 | (call-interactively #'markdown-table-forward-cell)) | ||
| 6800 | |||
| 6801 | ;; Otherwise, indent as appropriate | ||
| 6802 | (t | ||
| 6803 | (indent-for-tab-command)))) | ||
| 6804 | |||
| 6805 | (defun markdown-shifttab () | ||
| 6806 | "Handle S-TAB keybinding based on context. | ||
| 6807 | When in a table, move backward one cell. | ||
| 6808 | Otherwise, cycle global heading visibility by calling | ||
| 6809 | `markdown-cycle' with argument t." | ||
| 6810 | (interactive) | ||
| 6811 | (cond ((markdown-table-at-point-p) | ||
| 6812 | (call-interactively #'markdown-table-backward-cell)) | ||
| 6813 | (t (markdown-cycle t)))) | ||
| 6814 | |||
| 6815 | (defun markdown-outline-level () | ||
| 6816 | "Return the depth to which a statement is nested in the outline." | ||
| 6817 | (cond | ||
| 6818 | ((and (match-beginning 0) | ||
| 6819 | (markdown-code-block-at-pos (match-beginning 0))) | ||
| 6820 | 7) ;; Only 6 header levels are defined. | ||
| 6821 | ((match-end 2) 1) | ||
| 6822 | ((match-end 3) 2) | ||
| 6823 | ((match-end 4) | ||
| 6824 | (length (markdown-trim-whitespace (match-string-no-properties 4)))))) | ||
| 6825 | |||
| 6826 | (defun markdown-promote-subtree (&optional arg) | ||
| 6827 | "Promote the current subtree of ATX headings. | ||
| 6828 | Note that Markdown does not support heading levels higher than | ||
| 6829 | six and therefore level-six headings will not be promoted | ||
| 6830 | further. If ARG is non-nil promote the heading, otherwise | ||
| 6831 | demote." | ||
| 6832 | (interactive "*P") | ||
| 6833 | (save-excursion | ||
| 6834 | (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) | ||
| 6835 | (re-search-backward markdown-regex-header-atx nil t)) | ||
| 6836 | (not (markdown-code-block-at-point-p))) | ||
| 6837 | (let ((level (length (match-string 1))) | ||
| 6838 | (promote-or-demote (if arg 1 -1)) | ||
| 6839 | (remove 't)) | ||
| 6840 | (markdown-cycle-atx promote-or-demote remove) | ||
| 6841 | (catch 'end-of-subtree | ||
| 6842 | (while (and (markdown-next-heading) | ||
| 6843 | (looking-at markdown-regex-header-atx)) | ||
| 6844 | ;; Exit if this not a higher level heading; promote otherwise. | ||
| 6845 | (if (and (looking-at markdown-regex-header-atx) | ||
| 6846 | (<= (length (match-string-no-properties 1)) level)) | ||
| 6847 | (throw 'end-of-subtree nil) | ||
| 6848 | (markdown-cycle-atx promote-or-demote remove)))))))) | ||
| 6849 | |||
| 6850 | (defun markdown-demote-subtree () | ||
| 6851 | "Demote the current subtree of ATX headings." | ||
| 6852 | (interactive) | ||
| 6853 | (markdown-promote-subtree t)) | ||
| 6854 | |||
| 6855 | (defun markdown-move-subtree-up () | ||
| 6856 | "Move the current subtree of ATX headings up." | ||
| 6857 | (interactive) | ||
| 6858 | (outline-move-subtree-up 1)) | ||
| 6859 | |||
| 6860 | (defun markdown-move-subtree-down () | ||
| 6861 | "Move the current subtree of ATX headings down." | ||
| 6862 | (interactive) | ||
| 6863 | (outline-move-subtree-down 1)) | ||
| 6864 | |||
| 6865 | (defun markdown-outline-next () | ||
| 6866 | "Move to next list item, when in a list, or next visible heading." | ||
| 6867 | (interactive) | ||
| 6868 | (let ((bounds (markdown-next-list-item-bounds))) | ||
| 6869 | (if bounds | ||
| 6870 | (goto-char (nth 0 bounds)) | ||
| 6871 | (markdown-next-visible-heading 1)))) | ||
| 6872 | |||
| 6873 | (defun markdown-outline-previous () | ||
| 6874 | "Move to previous list item, when in a list, or previous visible heading." | ||
| 6875 | (interactive) | ||
| 6876 | (let ((bounds (markdown-prev-list-item-bounds))) | ||
| 6877 | (if bounds | ||
| 6878 | (goto-char (nth 0 bounds)) | ||
| 6879 | (markdown-previous-visible-heading 1)))) | ||
| 6880 | |||
| 6881 | (defun markdown-outline-next-same-level () | ||
| 6882 | "Move to next list item or heading of same level." | ||
| 6883 | (interactive) | ||
| 6884 | (let ((bounds (markdown-cur-list-item-bounds))) | ||
| 6885 | (if bounds | ||
| 6886 | (markdown-next-list-item (nth 3 bounds)) | ||
| 6887 | (markdown-forward-same-level 1)))) | ||
| 6888 | |||
| 6889 | (defun markdown-outline-previous-same-level () | ||
| 6890 | "Move to previous list item or heading of same level." | ||
| 6891 | (interactive) | ||
| 6892 | (let ((bounds (markdown-cur-list-item-bounds))) | ||
| 6893 | (if bounds | ||
| 6894 | (markdown-prev-list-item (nth 3 bounds)) | ||
| 6895 | (markdown-backward-same-level 1)))) | ||
| 6896 | |||
| 6897 | (defun markdown-outline-up () | ||
| 6898 | "Move to previous list item, when in a list, or next heading." | ||
| 6899 | (interactive) | ||
| 6900 | (unless (markdown-up-list) | ||
| 6901 | (markdown-up-heading 1))) | ||
| 6902 | |||
| 6903 | |||
| 6904 | ;;; Marking and Narrowing ===================================================== | ||
| 6905 | |||
| 6906 | (defun markdown-mark-paragraph () | ||
| 6907 | "Put mark at end of this block, point at beginning. | ||
| 6908 | The block marked is the one that contains point or follows point. | ||
| 6909 | |||
| 6910 | Interactively, if this command is repeated or (in Transient Mark | ||
| 6911 | mode) if the mark is active, it marks the next block after the | ||
| 6912 | ones already marked." | ||
| 6913 | (interactive) | ||
| 6914 | (if (or (and (eq last-command this-command) (mark t)) | ||
| 6915 | (and transient-mark-mode mark-active)) | ||
| 6916 | (set-mark | ||
| 6917 | (save-excursion | ||
| 6918 | (goto-char (mark)) | ||
| 6919 | (markdown-forward-paragraph) | ||
| 6920 | (point))) | ||
| 6921 | (let ((beginning-of-defun-function 'markdown-backward-paragraph) | ||
| 6922 | (end-of-defun-function 'markdown-forward-paragraph)) | ||
| 6923 | (mark-defun)))) | ||
| 6924 | |||
| 6925 | (defun markdown-mark-block () | ||
| 6926 | "Put mark at end of this block, point at beginning. | ||
| 6927 | The block marked is the one that contains point or follows point. | ||
| 6928 | |||
| 6929 | Interactively, if this command is repeated or (in Transient Mark | ||
| 6930 | mode) if the mark is active, it marks the next block after the | ||
| 6931 | ones already marked." | ||
| 6932 | (interactive) | ||
| 6933 | (if (or (and (eq last-command this-command) (mark t)) | ||
| 6934 | (and transient-mark-mode mark-active)) | ||
| 6935 | (set-mark | ||
| 6936 | (save-excursion | ||
| 6937 | (goto-char (mark)) | ||
| 6938 | (markdown-forward-block) | ||
| 6939 | (point))) | ||
| 6940 | (let ((beginning-of-defun-function 'markdown-backward-block) | ||
| 6941 | (end-of-defun-function 'markdown-forward-block)) | ||
| 6942 | (mark-defun)))) | ||
| 6943 | |||
| 6944 | (defun markdown-narrow-to-block () | ||
| 6945 | "Make text outside current block invisible. | ||
| 6946 | The current block is the one that contains point or follows point." | ||
| 6947 | (interactive) | ||
| 6948 | (let ((beginning-of-defun-function 'markdown-backward-block) | ||
| 6949 | (end-of-defun-function 'markdown-forward-block)) | ||
| 6950 | (narrow-to-defun))) | ||
| 6951 | |||
| 6952 | (defun markdown-mark-text-block () | ||
| 6953 | "Put mark at end of this plain text block, point at beginning. | ||
| 6954 | The block marked is the one that contains point or follows point. | ||
| 6955 | |||
| 6956 | Interactively, if this command is repeated or (in Transient Mark | ||
| 6957 | mode) if the mark is active, it marks the next block after the | ||
| 6958 | ones already marked." | ||
| 6959 | (interactive) | ||
| 6960 | (if (or (and (eq last-command this-command) (mark t)) | ||
| 6961 | (and transient-mark-mode mark-active)) | ||
| 6962 | (set-mark | ||
| 6963 | (save-excursion | ||
| 6964 | (goto-char (mark)) | ||
| 6965 | (markdown-end-of-text-block) | ||
| 6966 | (point))) | ||
| 6967 | (let ((beginning-of-defun-function 'markdown-beginning-of-text-block) | ||
| 6968 | (end-of-defun-function 'markdown-end-of-text-block)) | ||
| 6969 | (mark-defun)))) | ||
| 6970 | |||
| 6971 | (defun markdown-mark-page () | ||
| 6972 | "Put mark at end of this top level section, point at beginning. | ||
| 6973 | The top level section marked is the one that contains point or | ||
| 6974 | follows point. | ||
| 6975 | |||
| 6976 | Interactively, if this command is repeated or (in Transient Mark | ||
| 6977 | mode) if the mark is active, it marks the next page after the | ||
| 6978 | ones already marked." | ||
| 6979 | (interactive) | ||
| 6980 | (if (or (and (eq last-command this-command) (mark t)) | ||
| 6981 | (and transient-mark-mode mark-active)) | ||
| 6982 | (set-mark | ||
| 6983 | (save-excursion | ||
| 6984 | (goto-char (mark)) | ||
| 6985 | (markdown-forward-page) | ||
| 6986 | (point))) | ||
| 6987 | (let ((beginning-of-defun-function 'markdown-backward-page) | ||
| 6988 | (end-of-defun-function 'markdown-forward-page)) | ||
| 6989 | (mark-defun)))) | ||
| 6990 | |||
| 6991 | (defun markdown-narrow-to-page () | ||
| 6992 | "Make text outside current top level section invisible. | ||
| 6993 | The current section is the one that contains point or follows point." | ||
| 6994 | (interactive) | ||
| 6995 | (let ((beginning-of-defun-function 'markdown-backward-page) | ||
| 6996 | (end-of-defun-function 'markdown-forward-page)) | ||
| 6997 | (narrow-to-defun))) | ||
| 6998 | |||
| 6999 | (defun markdown-mark-subtree () | ||
| 7000 | "Mark the current subtree. | ||
| 7001 | This puts point at the start of the current subtree, and mark at the end." | ||
| 7002 | (interactive) | ||
| 7003 | (let ((beg)) | ||
| 7004 | (if (markdown-heading-at-point) | ||
| 7005 | (beginning-of-line) | ||
| 7006 | (markdown-previous-visible-heading 1)) | ||
| 7007 | (setq beg (point)) | ||
| 7008 | (markdown-end-of-subtree) | ||
| 7009 | (push-mark (point) nil t) | ||
| 7010 | (goto-char beg))) | ||
| 7011 | |||
| 7012 | (defun markdown-narrow-to-subtree () | ||
| 7013 | "Narrow buffer to the current subtree." | ||
| 7014 | (interactive) | ||
| 7015 | (save-excursion | ||
| 7016 | (save-match-data | ||
| 7017 | (narrow-to-region | ||
| 7018 | (progn (markdown-back-to-heading-over-code-block t) (point)) | ||
| 7019 | (progn (markdown-end-of-subtree) | ||
| 7020 | (if (and (markdown-heading-at-point) (not (eobp))) | ||
| 7021 | (backward-char 1)) | ||
| 7022 | (point)))))) | ||
| 7023 | |||
| 7024 | |||
| 7025 | ;;; Generic Structure Editing, Completion, and Cycling Commands =============== | ||
| 7026 | |||
| 7027 | (defun markdown-move-up () | ||
| 7028 | "Move thing at point up. | ||
| 7029 | When in a list item, call `markdown-move-list-item-up'. | ||
| 7030 | When in a table, call `markdown-table-move-row-up'. | ||
| 7031 | Otherwise, move the current heading subtree up with | ||
| 7032 | `markdown-move-subtree-up'." | ||
| 7033 | (interactive) | ||
| 7034 | (cond | ||
| 7035 | ((markdown-list-item-at-point-p) | ||
| 7036 | (call-interactively #'markdown-move-list-item-up)) | ||
| 7037 | ((markdown-table-at-point-p) | ||
| 7038 | (call-interactively #'markdown-table-move-row-up)) | ||
| 7039 | (t | ||
| 7040 | (call-interactively #'markdown-move-subtree-up)))) | ||
| 7041 | |||
| 7042 | (defun markdown-move-down () | ||
| 7043 | "Move thing at point down. | ||
| 7044 | When in a list item, call `markdown-move-list-item-down'. | ||
| 7045 | Otherwise, move the current heading subtree up with | ||
| 7046 | `markdown-move-subtree-down'." | ||
| 7047 | (interactive) | ||
| 7048 | (cond | ||
| 7049 | ((markdown-list-item-at-point-p) | ||
| 7050 | (call-interactively #'markdown-move-list-item-down)) | ||
| 7051 | ((markdown-table-at-point-p) | ||
| 7052 | (call-interactively #'markdown-table-move-row-down)) | ||
| 7053 | (t | ||
| 7054 | (call-interactively #'markdown-move-subtree-down)))) | ||
| 7055 | |||
| 7056 | (defun markdown-promote () | ||
| 7057 | "Promote or move element at point to the left. | ||
| 7058 | Depending on the context, this function will promote a heading or | ||
| 7059 | list item at the point, move a table column to the left, or cycle | ||
| 7060 | markup." | ||
| 7061 | (interactive) | ||
| 7062 | (let (bounds) | ||
| 7063 | (cond | ||
| 7064 | ;; Promote atx heading subtree | ||
| 7065 | ((thing-at-point-looking-at markdown-regex-header-atx) | ||
| 7066 | (markdown-promote-subtree)) | ||
| 7067 | ;; Promote setext heading | ||
| 7068 | ((thing-at-point-looking-at markdown-regex-header-setext) | ||
| 7069 | (markdown-cycle-setext -1)) | ||
| 7070 | ;; Promote horizontal rule | ||
| 7071 | ((thing-at-point-looking-at markdown-regex-hr) | ||
| 7072 | (markdown-cycle-hr -1)) | ||
| 7073 | ;; Promote list item | ||
| 7074 | ((setq bounds (markdown-cur-list-item-bounds)) | ||
| 7075 | (markdown-promote-list-item bounds)) | ||
| 7076 | ;; Move table column to the left | ||
| 7077 | ((markdown-table-at-point-p) | ||
| 7078 | (call-interactively #'markdown-table-move-column-left)) | ||
| 7079 | ;; Promote bold | ||
| 7080 | ((thing-at-point-looking-at markdown-regex-bold) | ||
| 7081 | (markdown-cycle-bold)) | ||
| 7082 | ;; Promote italic | ||
| 7083 | ((thing-at-point-looking-at markdown-regex-italic) | ||
| 7084 | (markdown-cycle-italic)) | ||
| 7085 | (t | ||
| 7086 | (user-error "Nothing to promote at point"))))) | ||
| 7087 | |||
| 7088 | (defun markdown-demote () | ||
| 7089 | "Demote or move element at point to the right. | ||
| 7090 | Depending on the context, this function will demote a heading or | ||
| 7091 | list item at the point, move a table column to the right, or cycle | ||
| 7092 | or remove markup." | ||
| 7093 | (interactive) | ||
| 7094 | (let (bounds) | ||
| 7095 | (cond | ||
| 7096 | ;; Demote atx heading subtree | ||
| 7097 | ((thing-at-point-looking-at markdown-regex-header-atx) | ||
| 7098 | (markdown-demote-subtree)) | ||
| 7099 | ;; Demote setext heading | ||
| 7100 | ((thing-at-point-looking-at markdown-regex-header-setext) | ||
| 7101 | (markdown-cycle-setext 1)) | ||
| 7102 | ;; Demote horizontal rule | ||
| 7103 | ((thing-at-point-looking-at markdown-regex-hr) | ||
| 7104 | (markdown-cycle-hr 1)) | ||
| 7105 | ;; Demote list item | ||
| 7106 | ((setq bounds (markdown-cur-list-item-bounds)) | ||
| 7107 | (markdown-demote-list-item bounds)) | ||
| 7108 | ;; Move table column to the right | ||
| 7109 | ((markdown-table-at-point-p) | ||
| 7110 | (call-interactively #'markdown-table-move-column-right)) | ||
| 7111 | ;; Demote bold | ||
| 7112 | ((thing-at-point-looking-at markdown-regex-bold) | ||
| 7113 | (markdown-cycle-bold)) | ||
| 7114 | ;; Demote italic | ||
| 7115 | ((thing-at-point-looking-at markdown-regex-italic) | ||
| 7116 | (markdown-cycle-italic)) | ||
| 7117 | (t | ||
| 7118 | (user-error "Nothing to demote at point"))))) | ||
| 7119 | |||
| 7120 | |||
| 7121 | ;;; Commands ================================================================== | ||
| 7122 | |||
| 7123 | (defun markdown (&optional output-buffer-name) | ||
| 7124 | "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. | ||
| 7125 | The output buffer name defaults to `markdown-output-buffer-name'. | ||
| 7126 | Return the name of the output buffer used." | ||
| 7127 | (interactive) | ||
| 7128 | (save-window-excursion | ||
| 7129 | (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) | ||
| 7130 | ((listp markdown-command) markdown-command))) | ||
| 7131 | (command (car-safe commands)) | ||
| 7132 | (command-args (cdr-safe commands)) | ||
| 7133 | begin-region end-region) | ||
| 7134 | (if (use-region-p) | ||
| 7135 | (setq begin-region (region-beginning) | ||
| 7136 | end-region (region-end)) | ||
| 7137 | (setq begin-region (point-min) | ||
| 7138 | end-region (point-max))) | ||
| 7139 | |||
| 7140 | (unless output-buffer-name | ||
| 7141 | (setq output-buffer-name markdown-output-buffer-name)) | ||
| 7142 | (when (and (stringp command) (not (executable-find command))) | ||
| 7143 | (user-error "Markdown command %s is not found" command)) | ||
| 7144 | (let ((exit-code | ||
| 7145 | (cond | ||
| 7146 | ;; Handle case when `markdown-command' does not read from stdin | ||
| 7147 | ((and (stringp command) markdown-command-needs-filename) | ||
| 7148 | (if (not buffer-file-name) | ||
| 7149 | (user-error "Must be visiting a file") | ||
| 7150 | ;; Don’t use ‘shell-command’ because it’s not guaranteed to | ||
| 7151 | ;; return the exit code of the process. | ||
| 7152 | (let ((command (if (listp markdown-command) | ||
| 7153 | (string-join markdown-command " ") | ||
| 7154 | markdown-command))) | ||
| 7155 | (shell-command-on-region | ||
| 7156 | ;; Pass an empty region so that stdin is empty. | ||
| 7157 | (point) (point) | ||
| 7158 | (concat command " " | ||
| 7159 | (shell-quote-argument buffer-file-name)) | ||
| 7160 | output-buffer-name)))) | ||
| 7161 | ;; Pass region to `markdown-command' via stdin | ||
| 7162 | (t | ||
| 7163 | (let ((buf (get-buffer-create output-buffer-name))) | ||
| 7164 | (with-current-buffer buf | ||
| 7165 | (setq buffer-read-only nil) | ||
| 7166 | (erase-buffer)) | ||
| 7167 | (if (stringp command) | ||
| 7168 | (if (not (null command-args)) | ||
| 7169 | (apply #'call-process-region begin-region end-region command nil buf nil command-args) | ||
| 7170 | (call-process-region begin-region end-region command nil buf)) | ||
| 7171 | (funcall markdown-command begin-region end-region buf) | ||
| 7172 | ;; If the ‘markdown-command’ function didn’t signal an | ||
| 7173 | ;; error, assume it succeeded by binding ‘exit-code’ to 0. | ||
| 7174 | 0)))))) | ||
| 7175 | ;; The exit code can be a signal description string, so don’t use ‘=’ | ||
| 7176 | ;; or ‘zerop’. | ||
| 7177 | (unless (eq exit-code 0) | ||
| 7178 | (user-error "%s failed with exit code %s" | ||
| 7179 | markdown-command exit-code)))) | ||
| 7180 | output-buffer-name)) | ||
| 7181 | |||
| 7182 | (defun markdown-standalone (&optional output-buffer-name) | ||
| 7183 | "Special function to provide standalone HTML output. | ||
| 7184 | Insert the output in the buffer named OUTPUT-BUFFER-NAME." | ||
| 7185 | (interactive) | ||
| 7186 | (setq output-buffer-name (markdown output-buffer-name)) | ||
| 7187 | (with-current-buffer output-buffer-name | ||
| 7188 | (set-buffer output-buffer-name) | ||
| 7189 | (unless (markdown-output-standalone-p) | ||
| 7190 | (markdown-add-xhtml-header-and-footer output-buffer-name)) | ||
| 7191 | (goto-char (point-min)) | ||
| 7192 | (html-mode)) | ||
| 7193 | output-buffer-name) | ||
| 7194 | |||
| 7195 | (defun markdown-other-window (&optional output-buffer-name) | ||
| 7196 | "Run `markdown-command' on current buffer and display in other window. | ||
| 7197 | When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with | ||
| 7198 | that name." | ||
| 7199 | (interactive) | ||
| 7200 | (markdown-display-buffer-other-window | ||
| 7201 | (markdown-standalone output-buffer-name))) | ||
| 7202 | |||
| 7203 | (defun markdown-output-standalone-p () | ||
| 7204 | "Determine whether `markdown-command' output is standalone XHTML. | ||
| 7205 | Standalone XHTML output is identified by an occurrence of | ||
| 7206 | `markdown-xhtml-standalone-regexp' in the first five lines of output." | ||
| 7207 | (save-excursion | ||
| 7208 | (goto-char (point-min)) | ||
| 7209 | (save-match-data | ||
| 7210 | (re-search-forward | ||
| 7211 | markdown-xhtml-standalone-regexp | ||
| 7212 | (save-excursion (goto-char (point-min)) (forward-line 4) (point)) | ||
| 7213 | t)))) | ||
| 7214 | |||
| 7215 | (defun markdown-stylesheet-link-string (stylesheet-path) | ||
| 7216 | (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" | ||
| 7217 | (or (and (string-prefix-p "~" stylesheet-path) | ||
| 7218 | (expand-file-name stylesheet-path)) | ||
| 7219 | stylesheet-path) | ||
| 7220 | "\" />")) | ||
| 7221 | |||
| 7222 | (defun markdown-add-xhtml-header-and-footer (title) | ||
| 7223 | "Wrap XHTML header and footer with given TITLE around current buffer." | ||
| 7224 | (goto-char (point-min)) | ||
| 7225 | (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" | ||
| 7226 | "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" | ||
| 7227 | "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" | ||
| 7228 | "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" | ||
| 7229 | "<head>\n<title>") | ||
| 7230 | (insert title) | ||
| 7231 | (insert "</title>\n") | ||
| 7232 | (unless (= (length markdown-content-type) 0) | ||
| 7233 | (insert | ||
| 7234 | (format | ||
| 7235 | "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" | ||
| 7236 | markdown-content-type | ||
| 7237 | (or (and markdown-coding-system | ||
| 7238 | (coding-system-get markdown-coding-system | ||
| 7239 | 'mime-charset)) | ||
| 7240 | (coding-system-get buffer-file-coding-system | ||
| 7241 | 'mime-charset) | ||
| 7242 | "utf-8")))) | ||
| 7243 | (if (> (length markdown-css-paths) 0) | ||
| 7244 | (insert (mapconcat #'markdown-stylesheet-link-string | ||
| 7245 | markdown-css-paths "\n"))) | ||
| 7246 | (when (> (length markdown-xhtml-header-content) 0) | ||
| 7247 | (insert markdown-xhtml-header-content)) | ||
| 7248 | (insert "\n</head>\n\n" | ||
| 7249 | "<body>\n\n") | ||
| 7250 | (when (> (length markdown-xhtml-body-preamble) 0) | ||
| 7251 | (insert markdown-xhtml-body-preamble "\n")) | ||
| 7252 | (goto-char (point-max)) | ||
| 7253 | (when (> (length markdown-xhtml-body-epilogue) 0) | ||
| 7254 | (insert "\n" markdown-xhtml-body-epilogue)) | ||
| 7255 | (insert "\n" | ||
| 7256 | "</body>\n" | ||
| 7257 | "</html>\n")) | ||
| 7258 | |||
| 7259 | (defun markdown-preview (&optional output-buffer-name) | ||
| 7260 | "Run `markdown-command' on the current buffer and view output in browser. | ||
| 7261 | When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with | ||
| 7262 | that name." | ||
| 7263 | (interactive) | ||
| 7264 | (browse-url-of-buffer | ||
| 7265 | (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) | ||
| 7266 | |||
| 7267 | (defun markdown-export-file-name (&optional extension) | ||
| 7268 | "Attempt to generate a filename for Markdown output. | ||
| 7269 | The file extension will be EXTENSION if given, or .html by default. | ||
| 7270 | If the current buffer is visiting a file, we construct a new | ||
| 7271 | output filename based on that filename. Otherwise, return nil." | ||
| 7272 | (when (buffer-file-name) | ||
| 7273 | (unless extension | ||
| 7274 | (setq extension ".html")) | ||
| 7275 | (let ((candidate | ||
| 7276 | (concat | ||
| 7277 | (cond | ||
| 7278 | ((buffer-file-name) | ||
| 7279 | (file-name-sans-extension (buffer-file-name))) | ||
| 7280 | (t (buffer-name))) | ||
| 7281 | extension))) | ||
| 7282 | (cond | ||
| 7283 | ((equal candidate (buffer-file-name)) | ||
| 7284 | (concat candidate extension)) | ||
| 7285 | (t | ||
| 7286 | candidate))))) | ||
| 7287 | |||
| 7288 | (defun markdown-export (&optional output-file) | ||
| 7289 | "Run Markdown on the current buffer, save to file, and return the filename. | ||
| 7290 | If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename | ||
| 7291 | generated by `markdown-export-file-name', which will be constructed using the | ||
| 7292 | current filename, but with the extension removed and replaced with .html." | ||
| 7293 | (interactive) | ||
| 7294 | (unless output-file | ||
| 7295 | (setq output-file (markdown-export-file-name ".html"))) | ||
| 7296 | (when output-file | ||
| 7297 | (let* ((init-buf (current-buffer)) | ||
| 7298 | (init-point (point)) | ||
| 7299 | (init-buf-string (buffer-string)) | ||
| 7300 | (output-buffer (find-file-noselect output-file)) | ||
| 7301 | (output-buffer-name (buffer-name output-buffer))) | ||
| 7302 | (run-hooks 'markdown-before-export-hook) | ||
| 7303 | (markdown-standalone output-buffer-name) | ||
| 7304 | (with-current-buffer output-buffer | ||
| 7305 | (run-hooks 'markdown-after-export-hook) | ||
| 7306 | (save-buffer) | ||
| 7307 | (when markdown-export-kill-buffer (kill-buffer))) | ||
| 7308 | ;; if modified, restore initial buffer | ||
| 7309 | (when (buffer-modified-p init-buf) | ||
| 7310 | (erase-buffer) | ||
| 7311 | (insert init-buf-string) | ||
| 7312 | (save-buffer) | ||
| 7313 | (goto-char init-point)) | ||
| 7314 | output-file))) | ||
| 7315 | |||
| 7316 | (defun markdown-export-and-preview () | ||
| 7317 | "Export to XHTML using `markdown-export' and browse the resulting file." | ||
| 7318 | (interactive) | ||
| 7319 | (browse-url-of-file (markdown-export))) | ||
| 7320 | |||
| 7321 | (defvar-local markdown-live-preview-buffer nil | ||
| 7322 | "Buffer used to preview markdown output in `markdown-live-preview-export'.") | ||
| 7323 | |||
| 7324 | (defvar-local markdown-live-preview-source-buffer nil | ||
| 7325 | "Source buffer from which current buffer was generated. | ||
| 7326 | This is the inverse of `markdown-live-preview-buffer'.") | ||
| 7327 | |||
| 7328 | (defvar markdown-live-preview-currently-exporting nil) | ||
| 7329 | |||
| 7330 | (defun markdown-live-preview-get-filename () | ||
| 7331 | "Standardize the filename exported by `markdown-live-preview-export'." | ||
| 7332 | (markdown-export-file-name ".html")) | ||
| 7333 | |||
| 7334 | (defun markdown-live-preview-window-eww (file) | ||
| 7335 | "Preview FILE with eww. | ||
| 7336 | To be used with `markdown-live-preview-window-function'." | ||
| 7337 | (eww-open-file file) | ||
| 7338 | (get-buffer "*eww*")) | ||
| 7339 | |||
| 7340 | (defun markdown-visual-lines-between-points (beg end) | ||
| 7341 | (save-excursion | ||
| 7342 | (goto-char beg) | ||
| 7343 | (cl-loop with count = 0 | ||
| 7344 | while (progn (end-of-visual-line) | ||
| 7345 | (and (< (point) end) (line-move-visual 1 t))) | ||
| 7346 | do (cl-incf count) | ||
| 7347 | finally return count))) | ||
| 7348 | |||
| 7349 | (defun markdown-live-preview-window-serialize (buf) | ||
| 7350 | "Get window point and scroll data for all windows displaying BUF." | ||
| 7351 | (when (buffer-live-p buf) | ||
| 7352 | (with-current-buffer buf | ||
| 7353 | (mapcar | ||
| 7354 | (lambda (win) | ||
| 7355 | (with-selected-window win | ||
| 7356 | (let* ((start (window-start)) | ||
| 7357 | (pt (window-point)) | ||
| 7358 | (pt-or-sym (cond ((= pt (point-min)) 'min) | ||
| 7359 | ((= pt (point-max)) 'max) | ||
| 7360 | (t pt))) | ||
| 7361 | (diff (markdown-visual-lines-between-points | ||
| 7362 | start pt))) | ||
| 7363 | (list win pt-or-sym diff)))) | ||
| 7364 | (get-buffer-window-list buf))))) | ||
| 7365 | |||
| 7366 | (defun markdown-get-point-back-lines (pt num-lines) | ||
| 7367 | (save-excursion | ||
| 7368 | (goto-char pt) | ||
| 7369 | (line-move-visual (- num-lines) t) | ||
| 7370 | ;; in testing, can occasionally overshoot the number of lines to traverse | ||
| 7371 | (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) | ||
| 7372 | (when (> actual-num-lines num-lines) | ||
| 7373 | (line-move-visual (- actual-num-lines num-lines) t))) | ||
| 7374 | (point))) | ||
| 7375 | |||
| 7376 | (defun markdown-live-preview-window-deserialize (window-posns) | ||
| 7377 | "Apply window point and scroll data from WINDOW-POSNS. | ||
| 7378 | WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." | ||
| 7379 | (cl-destructuring-bind (win pt-or-sym diff) window-posns | ||
| 7380 | (when (window-live-p win) | ||
| 7381 | (with-current-buffer markdown-live-preview-buffer | ||
| 7382 | (set-window-buffer win (current-buffer)) | ||
| 7383 | (cl-destructuring-bind (actual-pt actual-diff) | ||
| 7384 | (cl-case pt-or-sym | ||
| 7385 | (min (list (point-min) 0)) | ||
| 7386 | (max (list (point-max) diff)) | ||
| 7387 | (t (list pt-or-sym diff))) | ||
| 7388 | (set-window-start | ||
| 7389 | win (markdown-get-point-back-lines actual-pt actual-diff)) | ||
| 7390 | (set-window-point win actual-pt)))))) | ||
| 7391 | |||
| 7392 | (defun markdown-live-preview-export () | ||
| 7393 | "Export to XHTML using `markdown-export'. | ||
| 7394 | Browse the resulting file within Emacs using | ||
| 7395 | `markdown-live-preview-window-function' Return the buffer | ||
| 7396 | displaying the rendered output." | ||
| 7397 | (interactive) | ||
| 7398 | (let ((filename (markdown-live-preview-get-filename))) | ||
| 7399 | (when filename | ||
| 7400 | (let* ((markdown-live-preview-currently-exporting t) | ||
| 7401 | (cur-buf (current-buffer)) | ||
| 7402 | (export-file (markdown-export filename)) | ||
| 7403 | ;; get positions in all windows currently displaying output buffer | ||
| 7404 | (window-data | ||
| 7405 | (markdown-live-preview-window-serialize | ||
| 7406 | markdown-live-preview-buffer))) | ||
| 7407 | (save-window-excursion | ||
| 7408 | (let ((output-buffer | ||
| 7409 | (funcall markdown-live-preview-window-function export-file))) | ||
| 7410 | (with-current-buffer output-buffer | ||
| 7411 | (setq markdown-live-preview-source-buffer cur-buf) | ||
| 7412 | (add-hook 'kill-buffer-hook | ||
| 7413 | #'markdown-live-preview-remove-on-kill t t)) | ||
| 7414 | (with-current-buffer cur-buf | ||
| 7415 | (setq markdown-live-preview-buffer output-buffer)))) | ||
| 7416 | (with-current-buffer cur-buf | ||
| 7417 | ;; reset all windows displaying output buffer to where they were, | ||
| 7418 | ;; now with the new output | ||
| 7419 | (mapc #'markdown-live-preview-window-deserialize window-data) | ||
| 7420 | ;; delete html editing buffer | ||
| 7421 | (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) | ||
| 7422 | (when (and export-file (file-exists-p export-file) | ||
| 7423 | (eq markdown-live-preview-delete-export | ||
| 7424 | 'delete-on-export)) | ||
| 7425 | (delete-file export-file)) | ||
| 7426 | markdown-live-preview-buffer))))) | ||
| 7427 | |||
| 7428 | (defun markdown-live-preview-remove () | ||
| 7429 | (when (buffer-live-p markdown-live-preview-buffer) | ||
| 7430 | (kill-buffer markdown-live-preview-buffer)) | ||
| 7431 | (setq markdown-live-preview-buffer nil) | ||
| 7432 | ;; if set to 'delete-on-export, the output has already been deleted | ||
| 7433 | (when (eq markdown-live-preview-delete-export 'delete-on-destroy) | ||
| 7434 | (let ((outfile-name (markdown-live-preview-get-filename))) | ||
| 7435 | (when (and outfile-name (file-exists-p outfile-name)) | ||
| 7436 | (delete-file outfile-name))))) | ||
| 7437 | |||
| 7438 | (defun markdown-get-other-window () | ||
| 7439 | "Find another window to display preview or output content." | ||
| 7440 | (cond | ||
| 7441 | ((memq markdown-split-window-direction '(vertical below)) | ||
| 7442 | (or (window-in-direction 'below) (split-window-vertically))) | ||
| 7443 | ((memq markdown-split-window-direction '(horizontal right)) | ||
| 7444 | (or (window-in-direction 'right) (split-window-horizontally))) | ||
| 7445 | (t (split-window-sensibly (get-buffer-window))))) | ||
| 7446 | |||
| 7447 | (defun markdown-display-buffer-other-window (buf) | ||
| 7448 | "Display preview or output buffer BUF in another window." | ||
| 7449 | (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) | ||
| 7450 | (display-buffer buf) | ||
| 7451 | (let ((cur-buf (current-buffer)) | ||
| 7452 | (window (markdown-get-other-window))) | ||
| 7453 | (set-window-buffer window buf) | ||
| 7454 | (set-buffer cur-buf)))) | ||
| 7455 | |||
| 7456 | (defun markdown-live-preview-if-markdown () | ||
| 7457 | (when (and (derived-mode-p 'markdown-mode) | ||
| 7458 | markdown-live-preview-mode) | ||
| 7459 | (unless markdown-live-preview-currently-exporting | ||
| 7460 | (if (buffer-live-p markdown-live-preview-buffer) | ||
| 7461 | (markdown-live-preview-export) | ||
| 7462 | (markdown-display-buffer-other-window | ||
| 7463 | (markdown-live-preview-export)))))) | ||
| 7464 | |||
| 7465 | (defun markdown-live-preview-remove-on-kill () | ||
| 7466 | (cond ((and (derived-mode-p 'markdown-mode) | ||
| 7467 | markdown-live-preview-mode) | ||
| 7468 | (markdown-live-preview-remove)) | ||
| 7469 | (markdown-live-preview-source-buffer | ||
| 7470 | (with-current-buffer markdown-live-preview-source-buffer | ||
| 7471 | (setq markdown-live-preview-buffer nil)) | ||
| 7472 | (setq markdown-live-preview-source-buffer nil)))) | ||
| 7473 | |||
| 7474 | (defun markdown-live-preview-switch-to-output () | ||
| 7475 | "Switch to output buffer." | ||
| 7476 | (interactive) | ||
| 7477 | "Turn on `markdown-live-preview-mode' if not already on, and switch to its | ||
| 7478 | output buffer in another window." | ||
| 7479 | (if markdown-live-preview-mode | ||
| 7480 | (markdown-display-buffer-other-window (markdown-live-preview-export))) | ||
| 7481 | (markdown-live-preview-mode)) | ||
| 7482 | |||
| 7483 | (defun markdown-live-preview-re-export () | ||
| 7484 | "Re export source buffer." | ||
| 7485 | (interactive) | ||
| 7486 | "If the current buffer is a buffer displaying the exported version of a | ||
| 7487 | `markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and | ||
| 7488 | update this buffer's contents." | ||
| 7489 | (when markdown-live-preview-source-buffer | ||
| 7490 | (with-current-buffer markdown-live-preview-source-buffer | ||
| 7491 | (markdown-live-preview-export)))) | ||
| 7492 | |||
| 7493 | (defun markdown-open () | ||
| 7494 | "Open file for the current buffer with `markdown-open-command'." | ||
| 7495 | (interactive) | ||
| 7496 | (unless markdown-open-command | ||
| 7497 | (user-error "Variable `markdown-open-command' must be set")) | ||
| 7498 | (if (stringp markdown-open-command) | ||
| 7499 | (if (not buffer-file-name) | ||
| 7500 | (user-error "Must be visiting a file") | ||
| 7501 | (save-buffer) | ||
| 7502 | (let ((exit-code (call-process markdown-open-command nil nil nil | ||
| 7503 | buffer-file-name))) | ||
| 7504 | ;; The exit code can be a signal description string, so don’t use ‘=’ | ||
| 7505 | ;; or ‘zerop’. | ||
| 7506 | (unless (eq exit-code 0) | ||
| 7507 | (user-error "%s failed with exit code %s" | ||
| 7508 | markdown-open-command exit-code)))) | ||
| 7509 | (funcall markdown-open-command)) | ||
| 7510 | nil) | ||
| 7511 | |||
| 7512 | (defun markdown-kill-ring-save () | ||
| 7513 | "Run Markdown on file and store output in the kill ring." | ||
| 7514 | (interactive) | ||
| 7515 | (save-window-excursion | ||
| 7516 | (markdown) | ||
| 7517 | (with-current-buffer markdown-output-buffer-name | ||
| 7518 | (kill-ring-save (point-min) (point-max))))) | ||
| 7519 | |||
| 7520 | |||
| 7521 | ;;; Links ===================================================================== | ||
| 7522 | |||
| 7523 | (defun markdown-backward-to-link-start () | ||
| 7524 | "Backward link start position if current position is in link title." | ||
| 7525 | ;; Issue #305 | ||
| 7526 | (when (eq (get-text-property (point) 'face) 'markdown-link-face) | ||
| 7527 | (skip-chars-backward "^[") | ||
| 7528 | (forward-char -1))) | ||
| 7529 | |||
| 7530 | (defun markdown-link-p () | ||
| 7531 | "Return non-nil when `point' is at a non-wiki link. | ||
| 7532 | See `markdown-wiki-link-p' for more information." | ||
| 7533 | (save-excursion | ||
| 7534 | (let ((case-fold-search nil)) | ||
| 7535 | (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) | ||
| 7536 | (markdown-backward-to-link-start) | ||
| 7537 | (or (thing-at-point-looking-at markdown-regex-link-inline) | ||
| 7538 | (thing-at-point-looking-at markdown-regex-link-reference) | ||
| 7539 | (thing-at-point-looking-at markdown-regex-uri) | ||
| 7540 | (thing-at-point-looking-at markdown-regex-angle-uri)))))) | ||
| 7541 | |||
| 7542 | (defun markdown-link-at-pos (pos) | ||
| 7543 | "Return properties of link or image at position POS. | ||
| 7544 | Value is a list of elements describing the link: | ||
| 7545 | 0. beginning position | ||
| 7546 | 1. end position | ||
| 7547 | 2. link text | ||
| 7548 | 3. URL | ||
| 7549 | 4. reference label | ||
| 7550 | 5. title text | ||
| 7551 | 6. bang (nil or \"!\")" | ||
| 7552 | (save-excursion | ||
| 7553 | (goto-char pos) | ||
| 7554 | (markdown-backward-to-link-start) | ||
| 7555 | (let (begin end text url reference title bang) | ||
| 7556 | (cond | ||
| 7557 | ;; Inline image or link at point. | ||
| 7558 | ((thing-at-point-looking-at markdown-regex-link-inline) | ||
| 7559 | (setq bang (match-string-no-properties 1) | ||
| 7560 | begin (match-beginning 0) | ||
| 7561 | end (match-end 0) | ||
| 7562 | text (match-string-no-properties 3) | ||
| 7563 | url (match-string-no-properties 6)) | ||
| 7564 | (if (match-end 7) | ||
| 7565 | (setq title (substring (match-string-no-properties 7) 1 -1)) | ||
| 7566 | ;; #408 URL contains close parenthesis case | ||
| 7567 | (goto-char (match-beginning 5)) | ||
| 7568 | (let ((paren-end (scan-sexps (point) 1))) | ||
| 7569 | (when (and paren-end (< end paren-end)) | ||
| 7570 | (setq url (buffer-substring (match-beginning 6) (1- paren-end))))))) | ||
| 7571 | ;; Reference link at point. | ||
| 7572 | ((or (thing-at-point-looking-at markdown-regex-link-inline) | ||
| 7573 | (thing-at-point-looking-at markdown-regex-link-reference)) | ||
| 7574 | (setq bang (match-string-no-properties 1) | ||
| 7575 | begin (match-beginning 0) | ||
| 7576 | end (match-end 0) | ||
| 7577 | text (match-string-no-properties 3)) | ||
| 7578 | (when (char-equal (char-after (match-beginning 5)) ?\[) | ||
| 7579 | (setq reference (match-string-no-properties 6)))) | ||
| 7580 | ;; Angle bracket URI at point. | ||
| 7581 | ((thing-at-point-looking-at markdown-regex-angle-uri) | ||
| 7582 | (setq begin (match-beginning 0) | ||
| 7583 | end (match-end 0) | ||
| 7584 | url (match-string-no-properties 2))) | ||
| 7585 | ;; Plain URI at point. | ||
| 7586 | ((thing-at-point-looking-at markdown-regex-uri) | ||
| 7587 | (setq begin (match-beginning 0) | ||
| 7588 | end (match-end 0) | ||
| 7589 | url (match-string-no-properties 1)))) | ||
| 7590 | (list begin end text url reference title bang)))) | ||
| 7591 | |||
| 7592 | (defun markdown-link-url () | ||
| 7593 | "Return the URL part of the regular (non-wiki) link at point. | ||
| 7594 | Works with both inline and reference style links, and with images. | ||
| 7595 | If point is not at a link or the link reference is not defined | ||
| 7596 | returns nil." | ||
| 7597 | (let* ((values (markdown-link-at-pos (point))) | ||
| 7598 | (text (nth 2 values)) | ||
| 7599 | (url (nth 3 values)) | ||
| 7600 | (ref (nth 4 values))) | ||
| 7601 | (or url (and ref (car (markdown-reference-definition | ||
| 7602 | (downcase (if (string= ref "") text ref)))))))) | ||
| 7603 | |||
| 7604 | (defun markdown--browse-url (url) | ||
| 7605 | (let* ((struct (url-generic-parse-url url)) | ||
| 7606 | (full (url-fullness struct)) | ||
| 7607 | (file url)) | ||
| 7608 | ;; Parse URL, determine fullness, strip query string | ||
| 7609 | (setq file (car (url-path-and-query struct))) | ||
| 7610 | ;; Open full URLs in browser, files in Emacs | ||
| 7611 | (if full | ||
| 7612 | (browse-url url) | ||
| 7613 | (when (and file (> (length file) 0)) | ||
| 7614 | (let ((link-file (funcall markdown-translate-filename-function file))) | ||
| 7615 | (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) | ||
| 7616 | (if (functionp markdown-open-image-command) | ||
| 7617 | (funcall markdown-open-image-command link-file) | ||
| 7618 | (process-file markdown-open-image-command nil nil nil link-file)) | ||
| 7619 | (find-file link-file))))))) | ||
| 7620 | |||
| 7621 | (defun markdown-follow-link-at-point () | ||
| 7622 | "Open the current non-wiki link. | ||
| 7623 | If the link is a complete URL, open in browser with `browse-url'. | ||
| 7624 | Otherwise, open with `find-file' after stripping anchor and/or query string. | ||
| 7625 | Translate filenames using `markdown-filename-translate-function'." | ||
| 7626 | (interactive) | ||
| 7627 | (if (markdown-link-p) | ||
| 7628 | (markdown--browse-url (markdown-link-url)) | ||
| 7629 | (user-error "Point is not at a Markdown link or URL"))) | ||
| 7630 | |||
| 7631 | (defun markdown-fontify-inline-links (last) | ||
| 7632 | "Add text properties to next inline link from point to LAST." | ||
| 7633 | (when (markdown-match-generic-links last nil) | ||
| 7634 | (let* ((link-start (match-beginning 3)) | ||
| 7635 | (link-end (match-end 3)) | ||
| 7636 | (url-start (match-beginning 6)) | ||
| 7637 | (url-end (match-end 6)) | ||
| 7638 | (url (match-string-no-properties 6)) | ||
| 7639 | (title-start (match-beginning 7)) | ||
| 7640 | (title-end (match-end 7)) | ||
| 7641 | (title (match-string-no-properties 7)) | ||
| 7642 | ;; Markup part | ||
| 7643 | (mp (list 'face 'markdown-markup-face | ||
| 7644 | 'invisible 'markdown-markup | ||
| 7645 | 'rear-nonsticky t | ||
| 7646 | 'font-lock-multiline t)) | ||
| 7647 | ;; Link part (without face) | ||
| 7648 | (lp (list 'keymap markdown-mode-mouse-map | ||
| 7649 | 'mouse-face 'markdown-highlight-face | ||
| 7650 | 'font-lock-multiline t | ||
| 7651 | 'help-echo (if title (concat title "\n" url) url))) | ||
| 7652 | ;; URL part | ||
| 7653 | (up (list 'keymap markdown-mode-mouse-map | ||
| 7654 | 'face 'markdown-url-face | ||
| 7655 | 'invisible 'markdown-markup | ||
| 7656 | 'mouse-face 'markdown-highlight-face | ||
| 7657 | 'font-lock-multiline t)) | ||
| 7658 | ;; URL composition character | ||
| 7659 | (url-char (markdown--first-displayable markdown-url-compose-char)) | ||
| 7660 | ;; Title part | ||
| 7661 | (tp (list 'face 'markdown-link-title-face | ||
| 7662 | 'invisible 'markdown-markup | ||
| 7663 | 'font-lock-multiline t))) | ||
| 7664 | (dolist (g '(1 2 4 5 8)) | ||
| 7665 | (when (match-end g) | ||
| 7666 | (add-text-properties (match-beginning g) (match-end g) mp))) | ||
| 7667 | ;; Preserve existing faces applied to link part (e.g., inline code) | ||
| 7668 | (when link-start | ||
| 7669 | (add-text-properties link-start link-end lp) | ||
| 7670 | (add-face-text-property link-start link-end | ||
| 7671 | 'markdown-link-face 'append)) | ||
| 7672 | (when url-start (add-text-properties url-start url-end up)) | ||
| 7673 | (when title-start (add-text-properties url-end title-end tp)) | ||
| 7674 | (when (and markdown-hide-urls url-start) | ||
| 7675 | (compose-region url-start (or title-end url-end) url-char)) | ||
| 7676 | t))) | ||
| 7677 | |||
| 7678 | (defun markdown-fontify-reference-links (last) | ||
| 7679 | "Add text properties to next reference link from point to LAST." | ||
| 7680 | (when (markdown-match-generic-links last t) | ||
| 7681 | (let* ((link-start (match-beginning 3)) | ||
| 7682 | (link-end (match-end 3)) | ||
| 7683 | (ref-start (match-beginning 6)) | ||
| 7684 | (ref-end (match-end 6)) | ||
| 7685 | ;; Markup part | ||
| 7686 | (mp (list 'face 'markdown-markup-face | ||
| 7687 | 'invisible 'markdown-markup | ||
| 7688 | 'rear-nonsticky t | ||
| 7689 | 'font-lock-multiline t)) | ||
| 7690 | ;; Link part | ||
| 7691 | (lp (list 'keymap markdown-mode-mouse-map | ||
| 7692 | 'face 'markdown-link-face | ||
| 7693 | 'mouse-face 'markdown-highlight-face | ||
| 7694 | 'font-lock-multiline t | ||
| 7695 | 'help-echo (lambda (_ __ pos) | ||
| 7696 | (save-match-data | ||
| 7697 | (save-excursion | ||
| 7698 | (goto-char pos) | ||
| 7699 | (or (markdown-link-url) | ||
| 7700 | "Undefined reference")))))) | ||
| 7701 | ;; URL composition character | ||
| 7702 | (url-char (markdown--first-displayable markdown-url-compose-char)) | ||
| 7703 | ;; Reference part | ||
| 7704 | (rp (list 'face 'markdown-reference-face | ||
| 7705 | 'invisible 'markdown-markup | ||
| 7706 | 'font-lock-multiline t))) | ||
| 7707 | (dolist (g '(1 2 4 5 8)) | ||
| 7708 | (when (match-end g) | ||
| 7709 | (add-text-properties (match-beginning g) (match-end g) mp))) | ||
| 7710 | (when link-start (add-text-properties link-start link-end lp)) | ||
| 7711 | (when ref-start (add-text-properties ref-start ref-end rp) | ||
| 7712 | (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) | ||
| 7713 | (compose-region ref-start ref-end url-char))) | ||
| 7714 | t))) | ||
| 7715 | |||
| 7716 | (defun markdown-fontify-angle-uris (last) | ||
| 7717 | "Add text properties to angle URIs from point to LAST." | ||
| 7718 | (when (markdown-match-angle-uris last) | ||
| 7719 | (let* ((url-start (match-beginning 2)) | ||
| 7720 | (url-end (match-end 2)) | ||
| 7721 | ;; Markup part | ||
| 7722 | (mp (list 'face 'markdown-markup-face | ||
| 7723 | 'invisible 'markdown-markup | ||
| 7724 | 'rear-nonsticky t | ||
| 7725 | 'font-lock-multiline t)) | ||
| 7726 | ;; URI part | ||
| 7727 | (up (list 'keymap markdown-mode-mouse-map | ||
| 7728 | 'face 'markdown-plain-url-face | ||
| 7729 | 'mouse-face 'markdown-highlight-face | ||
| 7730 | 'font-lock-multiline t))) | ||
| 7731 | (dolist (g '(1 3)) | ||
| 7732 | (add-text-properties (match-beginning g) (match-end g) mp)) | ||
| 7733 | (add-text-properties url-start url-end up) | ||
| 7734 | t))) | ||
| 7735 | |||
| 7736 | (defun markdown-fontify-plain-uris (last) | ||
| 7737 | "Add text properties to plain URLs from point to LAST." | ||
| 7738 | (when (markdown-match-plain-uris last) | ||
| 7739 | (let* ((start (match-beginning 0)) | ||
| 7740 | (end (match-end 0)) | ||
| 7741 | (props (list 'keymap markdown-mode-mouse-map | ||
| 7742 | 'face 'markdown-plain-url-face | ||
| 7743 | 'mouse-face 'markdown-highlight-face | ||
| 7744 | 'rear-nonsticky t | ||
| 7745 | 'font-lock-multiline t))) | ||
| 7746 | (add-text-properties start end props) | ||
| 7747 | t))) | ||
| 7748 | |||
| 7749 | (defun markdown-toggle-url-hiding (&optional arg) | ||
| 7750 | "Toggle the display or hiding of URLs. | ||
| 7751 | With a prefix argument ARG, enable URL hiding if ARG is positive, | ||
| 7752 | and disable it otherwise." | ||
| 7753 | (interactive (list (or current-prefix-arg 'toggle))) | ||
| 7754 | (setq markdown-hide-urls | ||
| 7755 | (if (eq arg 'toggle) | ||
| 7756 | (not markdown-hide-urls) | ||
| 7757 | (> (prefix-numeric-value arg) 0))) | ||
| 7758 | (if markdown-hide-urls | ||
| 7759 | (message "markdown-mode URL hiding enabled") | ||
| 7760 | (message "markdown-mode URL hiding disabled")) | ||
| 7761 | (markdown-reload-extensions)) | ||
| 7762 | |||
| 7763 | |||
| 7764 | ;;; Wiki Links ================================================================ | ||
| 7765 | |||
| 7766 | (defun markdown-wiki-link-p () | ||
| 7767 | "Return non-nil if wiki links are enabled and `point' is at a true wiki link. | ||
| 7768 | A true wiki link name matches `markdown-regex-wiki-link' but does | ||
| 7769 | not match the current file name after conversion. This modifies | ||
| 7770 | the data returned by `match-data'. Note that the potential wiki | ||
| 7771 | link name must be available via `match-string'." | ||
| 7772 | (when markdown-enable-wiki-links | ||
| 7773 | (let ((case-fold-search nil)) | ||
| 7774 | (and (thing-at-point-looking-at markdown-regex-wiki-link) | ||
| 7775 | (not (markdown-code-block-at-point-p)) | ||
| 7776 | (or (not buffer-file-name) | ||
| 7777 | (not (string-equal (buffer-file-name) | ||
| 7778 | (markdown-convert-wiki-link-to-filename | ||
| 7779 | (markdown-wiki-link-link))))))))) | ||
| 7780 | |||
| 7781 | (defun markdown-wiki-link-link () | ||
| 7782 | "Return the link part of the wiki link using current match data. | ||
| 7783 | The location of the link component depends on the value of | ||
| 7784 | `markdown-wiki-link-alias-first'." | ||
| 7785 | (if markdown-wiki-link-alias-first | ||
| 7786 | (or (match-string-no-properties 5) (match-string-no-properties 3)) | ||
| 7787 | (match-string-no-properties 3))) | ||
| 7788 | |||
| 7789 | (defun markdown-wiki-link-alias () | ||
| 7790 | "Return the alias or text part of the wiki link using current match data. | ||
| 7791 | The location of the alias component depends on the value of | ||
| 7792 | `markdown-wiki-link-alias-first'." | ||
| 7793 | (if markdown-wiki-link-alias-first | ||
| 7794 | (match-string-no-properties 3) | ||
| 7795 | (or (match-string-no-properties 5) (match-string-no-properties 3)))) | ||
| 7796 | |||
| 7797 | (defun markdown-convert-wiki-link-to-filename (name) | ||
| 7798 | "Generate a filename from the wiki link NAME. | ||
| 7799 | Spaces in NAME are replaced with `markdown-link-space-sub-char'. | ||
| 7800 | When in `gfm-mode', follow GitHub's conventions where [[Test Test]] | ||
| 7801 | and [[test test]] both map to Test-test.ext. Look in the current | ||
| 7802 | directory first, then in subdirectories if | ||
| 7803 | `markdown-wiki-link-search-subdirectories' is non-nil, and then | ||
| 7804 | in parent directories if | ||
| 7805 | `markdown-wiki-link-search-parent-directories' is non-nil." | ||
| 7806 | (let* ((basename (replace-regexp-in-string | ||
| 7807 | "[[:space:]\n]" markdown-link-space-sub-char name)) | ||
| 7808 | (basename (if (derived-mode-p 'gfm-mode) | ||
| 7809 | (concat (upcase (substring basename 0 1)) | ||
| 7810 | (downcase (substring basename 1 nil))) | ||
| 7811 | basename)) | ||
| 7812 | directory extension default candidates dir) | ||
| 7813 | (when buffer-file-name | ||
| 7814 | (setq directory (file-name-directory buffer-file-name) | ||
| 7815 | extension (file-name-extension buffer-file-name))) | ||
| 7816 | (setq default (concat basename | ||
| 7817 | (when extension (concat "." extension)))) | ||
| 7818 | (cond | ||
| 7819 | ;; Look in current directory first. | ||
| 7820 | ((or (null buffer-file-name) | ||
| 7821 | (file-exists-p default)) | ||
| 7822 | default) | ||
| 7823 | ;; Possibly search in subdirectories, next. | ||
| 7824 | ((and markdown-wiki-link-search-subdirectories | ||
| 7825 | (setq candidates | ||
| 7826 | (directory-files-recursively | ||
| 7827 | directory (concat "^" default "$")))) | ||
| 7828 | (car candidates)) | ||
| 7829 | ;; Possibly search in parent directories as a last resort. | ||
| 7830 | ((and markdown-wiki-link-search-parent-directories | ||
| 7831 | (setq dir (locate-dominating-file directory default))) | ||
| 7832 | (concat dir default)) | ||
| 7833 | ;; If nothing is found, return default in current directory. | ||
| 7834 | (t default)))) | ||
| 7835 | |||
| 7836 | (defun markdown-follow-wiki-link (name &optional other) | ||
| 7837 | "Follow the wiki link NAME. | ||
| 7838 | Convert the name to a file name and call `find-file'. Ensure that | ||
| 7839 | the new buffer remains in `markdown-mode'. Open the link in another | ||
| 7840 | window when OTHER is non-nil." | ||
| 7841 | (let ((filename (markdown-convert-wiki-link-to-filename name)) | ||
| 7842 | (wp (when buffer-file-name | ||
| 7843 | (file-name-directory buffer-file-name)))) | ||
| 7844 | (if (not wp) | ||
| 7845 | (user-error "Must be visiting a file") | ||
| 7846 | (when other (other-window 1)) | ||
| 7847 | (let ((default-directory wp)) | ||
| 7848 | (find-file filename))) | ||
| 7849 | (unless (derived-mode-p 'markdown-mode) | ||
| 7850 | (markdown-mode)))) | ||
| 7851 | |||
| 7852 | (defun markdown-follow-wiki-link-at-point (&optional arg) | ||
| 7853 | "Find Wiki Link at point. | ||
| 7854 | With prefix argument ARG, open the file in other window. | ||
| 7855 | See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." | ||
| 7856 | (interactive "P") | ||
| 7857 | (if (markdown-wiki-link-p) | ||
| 7858 | (markdown-follow-wiki-link (markdown-wiki-link-link) arg) | ||
| 7859 | (user-error "Point is not at a Wiki Link"))) | ||
| 7860 | |||
| 7861 | (defun markdown-highlight-wiki-link (from to face) | ||
| 7862 | "Highlight the wiki link in the region between FROM and TO using FACE." | ||
| 7863 | (put-text-property from to 'font-lock-face face)) | ||
| 7864 | |||
| 7865 | (defun markdown-unfontify-region-wiki-links (from to) | ||
| 7866 | "Remove wiki link faces from the region specified by FROM and TO." | ||
| 7867 | (interactive "*r") | ||
| 7868 | (let ((modified (buffer-modified-p))) | ||
| 7869 | (remove-text-properties from to '(font-lock-face markdown-link-face)) | ||
| 7870 | (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) | ||
| 7871 | ;; remove-text-properties marks the buffer modified in emacs 24.3, | ||
| 7872 | ;; undo that if it wasn't originally marked modified | ||
| 7873 | (set-buffer-modified-p modified))) | ||
| 7874 | |||
| 7875 | (defun markdown-fontify-region-wiki-links (from to) | ||
| 7876 | "Search region given by FROM and TO for wiki links and fontify them. | ||
| 7877 | If a wiki link is found check to see if the backing file exists | ||
| 7878 | and highlight accordingly." | ||
| 7879 | (goto-char from) | ||
| 7880 | (save-match-data | ||
| 7881 | (while (re-search-forward markdown-regex-wiki-link to t) | ||
| 7882 | (when (not (markdown-code-block-at-point-p)) | ||
| 7883 | (let ((highlight-beginning (match-beginning 1)) | ||
| 7884 | (highlight-end (match-end 1)) | ||
| 7885 | (file-name | ||
| 7886 | (markdown-convert-wiki-link-to-filename | ||
| 7887 | (markdown-wiki-link-link)))) | ||
| 7888 | (if (condition-case nil (file-exists-p file-name) (error nil)) | ||
| 7889 | (markdown-highlight-wiki-link | ||
| 7890 | highlight-beginning highlight-end 'markdown-link-face) | ||
| 7891 | (markdown-highlight-wiki-link | ||
| 7892 | highlight-beginning highlight-end 'markdown-missing-link-face))))))) | ||
| 7893 | |||
| 7894 | (defun markdown-extend-changed-region (from to) | ||
| 7895 | "Extend region given by FROM and TO so that we can fontify all links. | ||
| 7896 | The region is extended to the first newline before and the first | ||
| 7897 | newline after." | ||
| 7898 | ;; start looking for the first new line before 'from | ||
| 7899 | (goto-char from) | ||
| 7900 | (re-search-backward "\n" nil t) | ||
| 7901 | (let ((new-from (point-min)) | ||
| 7902 | (new-to (point-max))) | ||
| 7903 | (if (not (= (point) from)) | ||
| 7904 | (setq new-from (point))) | ||
| 7905 | ;; do the same thing for the first new line after 'to | ||
| 7906 | (goto-char to) | ||
| 7907 | (re-search-forward "\n" nil t) | ||
| 7908 | (if (not (= (point) to)) | ||
| 7909 | (setq new-to (point))) | ||
| 7910 | (cl-values new-from new-to))) | ||
| 7911 | |||
| 7912 | (defun markdown-check-change-for-wiki-link (from to) | ||
| 7913 | "Check region between FROM and TO for wiki links and re-fontify as needed." | ||
| 7914 | (interactive "*r") | ||
| 7915 | (let* ((modified (buffer-modified-p)) | ||
| 7916 | (buffer-undo-list t) | ||
| 7917 | (inhibit-read-only t) | ||
| 7918 | (inhibit-point-motion-hooks t) | ||
| 7919 | deactivate-mark | ||
| 7920 | buffer-file-truename) | ||
| 7921 | (unwind-protect | ||
| 7922 | (save-excursion | ||
| 7923 | (save-match-data | ||
| 7924 | (save-restriction | ||
| 7925 | ;; Extend the region to fontify so that it starts | ||
| 7926 | ;; and ends at safe places. | ||
| 7927 | (cl-multiple-value-bind (new-from new-to) | ||
| 7928 | (markdown-extend-changed-region from to) | ||
| 7929 | (goto-char new-from) | ||
| 7930 | ;; Only refontify when the range contains text with a | ||
| 7931 | ;; wiki link face or if the wiki link regexp matches. | ||
| 7932 | (when (or (markdown-range-property-any | ||
| 7933 | new-from new-to 'font-lock-face | ||
| 7934 | '(markdown-link-face markdown-missing-link-face)) | ||
| 7935 | (re-search-forward | ||
| 7936 | markdown-regex-wiki-link new-to t)) | ||
| 7937 | ;; Unfontify existing fontification (start from scratch) | ||
| 7938 | (markdown-unfontify-region-wiki-links new-from new-to) | ||
| 7939 | ;; Now do the fontification. | ||
| 7940 | (markdown-fontify-region-wiki-links new-from new-to)))))) | ||
| 7941 | (and (not modified) | ||
| 7942 | (buffer-modified-p) | ||
| 7943 | (set-buffer-modified-p nil))))) | ||
| 7944 | |||
| 7945 | (defun markdown-check-change-for-wiki-link-after-change (from to _) | ||
| 7946 | "Check region between FROM and TO for wiki links and re-fontify as needed. | ||
| 7947 | Designed to be used with the `after-change-functions' hook." | ||
| 7948 | (markdown-check-change-for-wiki-link from to)) | ||
| 7949 | |||
| 7950 | (defun markdown-fontify-buffer-wiki-links () | ||
| 7951 | "Refontify all wiki links in the buffer." | ||
| 7952 | (interactive) | ||
| 7953 | (markdown-check-change-for-wiki-link (point-min) (point-max))) | ||
| 7954 | |||
| 7955 | (defun markdown-toggle-wiki-links (&optional arg) | ||
| 7956 | "Toggle support for wiki links. | ||
| 7957 | With a prefix argument ARG, enable wiki link support if ARG is positive, | ||
| 7958 | and disable it otherwise." | ||
| 7959 | (interactive (list (or current-prefix-arg 'toggle))) | ||
| 7960 | (setq markdown-enable-wiki-links | ||
| 7961 | (if (eq arg 'toggle) | ||
| 7962 | (not markdown-enable-wiki-links) | ||
| 7963 | (> (prefix-numeric-value arg) 0))) | ||
| 7964 | (if markdown-enable-wiki-links | ||
| 7965 | (message "markdown-mode wiki link support enabled") | ||
| 7966 | (message "markdown-mode wiki link support disabled")) | ||
| 7967 | (markdown-reload-extensions)) | ||
| 7968 | |||
| 7969 | (defun markdown-setup-wiki-link-hooks () | ||
| 7970 | "Add or remove hooks for fontifying wiki links. | ||
| 7971 | These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." | ||
| 7972 | ;; Anytime text changes make sure it gets fontified correctly | ||
| 7973 | (if (and markdown-enable-wiki-links | ||
| 7974 | markdown-wiki-link-fontify-missing) | ||
| 7975 | (add-hook 'after-change-functions | ||
| 7976 | 'markdown-check-change-for-wiki-link-after-change t t) | ||
| 7977 | (remove-hook 'after-change-functions | ||
| 7978 | 'markdown-check-change-for-wiki-link-after-change t)) | ||
| 7979 | ;; If we left the buffer there is a really good chance we were | ||
| 7980 | ;; creating one of the wiki link documents. Make sure we get | ||
| 7981 | ;; refontified when we come back. | ||
| 7982 | (if (and markdown-enable-wiki-links | ||
| 7983 | markdown-wiki-link-fontify-missing) | ||
| 7984 | (progn | ||
| 7985 | (add-hook 'window-configuration-change-hook | ||
| 7986 | 'markdown-fontify-buffer-wiki-links t t) | ||
| 7987 | (markdown-fontify-buffer-wiki-links)) | ||
| 7988 | (remove-hook 'window-configuration-change-hook | ||
| 7989 | 'markdown-fontify-buffer-wiki-links t) | ||
| 7990 | (markdown-unfontify-region-wiki-links (point-min) (point-max)))) | ||
| 7991 | |||
| 7992 | |||
| 7993 | ;;; Following & Doing ========================================================= | ||
| 7994 | |||
| 7995 | (defun markdown-follow-thing-at-point (arg) | ||
| 7996 | "Follow thing at point if possible, such as a reference link or wiki link. | ||
| 7997 | Opens inline and reference links in a browser. Opens wiki links | ||
| 7998 | to other files in the current window, or the another window if | ||
| 7999 | ARG is non-nil. | ||
| 8000 | See `markdown-follow-link-at-point' and | ||
| 8001 | `markdown-follow-wiki-link-at-point'." | ||
| 8002 | (interactive "P") | ||
| 8003 | (cond ((markdown-link-p) | ||
| 8004 | (markdown--browse-url (markdown-link-url))) | ||
| 8005 | ((markdown-wiki-link-p) | ||
| 8006 | (markdown-follow-wiki-link-at-point arg)) | ||
| 8007 | (t | ||
| 8008 | (let* ((values (markdown-link-at-pos (point))) | ||
| 8009 | (url (nth 3 values))) | ||
| 8010 | (unless url | ||
| 8011 | (user-error "Nothing to follow at point")) | ||
| 8012 | (markdown--browse-url url))))) | ||
| 8013 | |||
| 8014 | (defun markdown-do () | ||
| 8015 | "Do something sensible based on context at point. | ||
| 8016 | Jumps between reference links and definitions; between footnote | ||
| 8017 | markers and footnote text." | ||
| 8018 | (interactive) | ||
| 8019 | (cond | ||
| 8020 | ;; Footnote definition | ||
| 8021 | ((markdown-footnote-text-positions) | ||
| 8022 | (markdown-footnote-return)) | ||
| 8023 | ;; Footnote marker | ||
| 8024 | ((markdown-footnote-marker-positions) | ||
| 8025 | (markdown-footnote-goto-text)) | ||
| 8026 | ;; Reference link | ||
| 8027 | ((thing-at-point-looking-at markdown-regex-link-reference) | ||
| 8028 | (markdown-reference-goto-definition)) | ||
| 8029 | ;; Reference definition | ||
| 8030 | ((thing-at-point-looking-at markdown-regex-reference-definition) | ||
| 8031 | (markdown-reference-goto-link (match-string-no-properties 2))) | ||
| 8032 | ;; GFM task list item | ||
| 8033 | ((markdown-gfm-task-list-item-at-point) | ||
| 8034 | (markdown-toggle-gfm-checkbox)) | ||
| 8035 | ;; Align table | ||
| 8036 | ((markdown-table-at-point-p) | ||
| 8037 | (call-interactively #'markdown-table-align)) | ||
| 8038 | ;; Otherwise | ||
| 8039 | (t | ||
| 8040 | (markdown-insert-gfm-checkbox)))) | ||
| 8041 | |||
| 8042 | |||
| 8043 | ;;; Miscellaneous ============================================================= | ||
| 8044 | |||
| 8045 | (defun markdown-compress-whitespace-string (str) | ||
| 8046 | "Compress whitespace in STR and return result. | ||
| 8047 | Leading and trailing whitespace is removed. Sequences of multiple | ||
| 8048 | spaces, tabs, and newlines are replaced with single spaces." | ||
| 8049 | (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" | ||
| 8050 | (replace-regexp-in-string "[ \t\n]+" " " str))) | ||
| 8051 | |||
| 8052 | (defun markdown--substitute-command-keys (string) | ||
| 8053 | "Like `substitute-command-keys' but, but prefers control characters. | ||
| 8054 | First pass STRING to `substitute-command-keys' and then | ||
| 8055 | substitute `C-i` for `TAB` and `C-m` for `RET`." | ||
| 8056 | (replace-regexp-in-string | ||
| 8057 | "\\<TAB\\>" "C-i" | ||
| 8058 | (replace-regexp-in-string | ||
| 8059 | "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) | ||
| 8060 | |||
| 8061 | (defun markdown-line-number-at-pos (&optional pos) | ||
| 8062 | "Return (narrowed) buffer line number at position POS. | ||
| 8063 | If POS is nil, use current buffer location. | ||
| 8064 | This is an exact copy of `line-number-at-pos' for use in emacs21." | ||
| 8065 | (let ((opoint (or pos (point))) start) | ||
| 8066 | (save-excursion | ||
| 8067 | (goto-char (point-min)) | ||
| 8068 | (setq start (point)) | ||
| 8069 | (goto-char opoint) | ||
| 8070 | (forward-line 0) | ||
| 8071 | (1+ (count-lines start (point)))))) | ||
| 8072 | |||
| 8073 | (defun markdown-inside-link-p () | ||
| 8074 | "Return t if point is within a link." | ||
| 8075 | (save-match-data | ||
| 8076 | (thing-at-point-looking-at (markdown-make-regex-link-generic)))) | ||
| 8077 | |||
| 8078 | (defun markdown-line-is-reference-definition-p () | ||
| 8079 | "Return whether the current line is a (non-footnote) reference definition." | ||
| 8080 | (save-excursion | ||
| 8081 | (move-beginning-of-line 1) | ||
| 8082 | (and (looking-at-p markdown-regex-reference-definition) | ||
| 8083 | (not (looking-at-p "[ \t]*\\[^"))))) | ||
| 8084 | |||
| 8085 | (defun markdown-adaptive-fill-function () | ||
| 8086 | "Return prefix for filling paragraph or nil if not determined." | ||
| 8087 | (cond | ||
| 8088 | ;; List item inside blockquote | ||
| 8089 | ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") | ||
| 8090 | (replace-regexp-in-string | ||
| 8091 | "[0-9\\.*+-]" " " (match-string-no-properties 0))) | ||
| 8092 | ;; Blockquote | ||
| 8093 | ((looking-at markdown-regex-blockquote) | ||
| 8094 | (buffer-substring-no-properties (match-beginning 0) (match-end 2))) | ||
| 8095 | ;; List items | ||
| 8096 | ((looking-at markdown-regex-list) | ||
| 8097 | (match-string-no-properties 0)) | ||
| 8098 | ;; Footnote definition | ||
| 8099 | ((looking-at-p markdown-regex-footnote-definition) | ||
| 8100 | " ") ; four spaces | ||
| 8101 | ;; No match | ||
| 8102 | (t nil))) | ||
| 8103 | |||
| 8104 | (defun markdown-fill-paragraph (&optional justify) | ||
| 8105 | "Fill paragraph at or after point. | ||
| 8106 | This function is like \\[fill-paragraph], but it skips Markdown | ||
| 8107 | code blocks. If the point is in a code block, or just before one, | ||
| 8108 | do not fill. Otherwise, call `fill-paragraph' as usual. If | ||
| 8109 | JUSTIFY is non-nil, justify text as well. Since this function | ||
| 8110 | handles filling itself, it always returns t so that | ||
| 8111 | `fill-paragraph' doesn't run." | ||
| 8112 | (interactive "P") | ||
| 8113 | (unless (or (markdown-code-block-at-point-p) | ||
| 8114 | (save-excursion | ||
| 8115 | (back-to-indentation) | ||
| 8116 | (skip-syntax-forward "-") | ||
| 8117 | (markdown-code-block-at-point-p))) | ||
| 8118 | (let ((fill-prefix (save-excursion | ||
| 8119 | (goto-char (line-beginning-position)) | ||
| 8120 | (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") | ||
| 8121 | (match-string-no-properties 1))))) | ||
| 8122 | (fill-paragraph justify))) | ||
| 8123 | t) | ||
| 8124 | |||
| 8125 | (defun markdown-fill-forward-paragraph (&optional arg) | ||
| 8126 | "Function used by `fill-paragraph' to move over ARG paragraphs. | ||
| 8127 | This is a `fill-forward-paragraph-function' for `markdown-mode'. | ||
| 8128 | It is called with a single argument specifying the number of | ||
| 8129 | paragraphs to move. Just like `forward-paragraph', it should | ||
| 8130 | return the number of paragraphs left to move." | ||
| 8131 | (or arg (setq arg 1)) | ||
| 8132 | (if (> arg 0) | ||
| 8133 | ;; With positive ARG, move across ARG non-code-block paragraphs, | ||
| 8134 | ;; one at a time. When passing a code block, don't decrement ARG. | ||
| 8135 | (while (and (not (eobp)) | ||
| 8136 | (> arg 0) | ||
| 8137 | (= (forward-paragraph 1) 0) | ||
| 8138 | (or (markdown-code-block-at-pos (point-at-bol 0)) | ||
| 8139 | (setq arg (1- arg))))) | ||
| 8140 | ;; Move backward by one paragraph with negative ARG (always -1). | ||
| 8141 | (let ((start (point))) | ||
| 8142 | (setq arg (forward-paragraph arg)) | ||
| 8143 | (while (and (not (eobp)) | ||
| 8144 | (progn (move-to-left-margin) (not (eobp))) | ||
| 8145 | (looking-at-p paragraph-separate)) | ||
| 8146 | (forward-line 1)) | ||
| 8147 | (cond | ||
| 8148 | ;; Move point past whitespace following list marker. | ||
| 8149 | ((looking-at markdown-regex-list) | ||
| 8150 | (goto-char (match-end 0))) | ||
| 8151 | ;; Move point past whitespace following pipe at beginning of line | ||
| 8152 | ;; to handle Pandoc line blocks. | ||
| 8153 | ((looking-at "^|\\s-*") | ||
| 8154 | (goto-char (match-end 0))) | ||
| 8155 | ;; Return point if the paragraph passed was a code block. | ||
| 8156 | ((markdown-code-block-at-pos (point-at-bol 2)) | ||
| 8157 | (goto-char start))))) | ||
| 8158 | arg) | ||
| 8159 | |||
| 8160 | (defun markdown--inhibit-electric-quote () | ||
| 8161 | "Function added to `electric-quote-inhibit-functions'. | ||
| 8162 | Return non-nil if the quote has been inserted inside a code block | ||
| 8163 | or span." | ||
| 8164 | (let ((pos (1- (point)))) | ||
| 8165 | (or (markdown-inline-code-at-pos pos) | ||
| 8166 | (markdown-code-block-at-pos pos)))) | ||
| 8167 | |||
| 8168 | |||
| 8169 | ;;; Extension Framework ======================================================= | ||
| 8170 | |||
| 8171 | (defun markdown-reload-extensions () | ||
| 8172 | "Check settings, update font-lock keywords and hooks, and re-fontify buffer." | ||
| 8173 | (interactive) | ||
| 8174 | (when (derived-mode-p 'markdown-mode) | ||
| 8175 | ;; Refontify buffer | ||
| 8176 | (font-lock-flush) | ||
| 8177 | ;; Add or remove hooks related to extensions | ||
| 8178 | (markdown-setup-wiki-link-hooks))) | ||
| 8179 | |||
| 8180 | (defun markdown-handle-local-variables () | ||
| 8181 | "Run in `hack-local-variables-hook' to update font lock rules. | ||
| 8182 | Checks to see if there is actually a ‘markdown-mode’ file local variable | ||
| 8183 | before regenerating font-lock rules for extensions." | ||
| 8184 | (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) | ||
| 8185 | (assoc 'markdown-enable-math file-local-variables-alist)) | ||
| 8186 | (when (assoc 'markdown-enable-math file-local-variables-alist) | ||
| 8187 | (markdown-toggle-math markdown-enable-math)) | ||
| 8188 | (markdown-reload-extensions))) | ||
| 8189 | |||
| 8190 | |||
| 8191 | ;;; Math Support ============================================================== | ||
| 8192 | |||
| 8193 | (defconst markdown-mode-font-lock-keywords-math | ||
| 8194 | (list | ||
| 8195 | ;; Equation reference (eq:foo) | ||
| 8196 | '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) | ||
| 8197 | (2 markdown-reference-face) | ||
| 8198 | (3 markdown-markup-face))) | ||
| 8199 | ;; Equation reference \eqref{foo} | ||
| 8200 | '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) | ||
| 8201 | (2 markdown-reference-face) | ||
| 8202 | (3 markdown-markup-face)))) | ||
| 8203 | "Font lock keywords to add and remove when toggling math support.") | ||
| 8204 | |||
| 8205 | (defun markdown-toggle-math (&optional arg) | ||
| 8206 | "Toggle support for inline and display LaTeX math expressions. | ||
| 8207 | With a prefix argument ARG, enable math mode if ARG is positive, | ||
| 8208 | and disable it otherwise. If called from Lisp, enable the mode | ||
| 8209 | if ARG is omitted or nil." | ||
| 8210 | (interactive (list (or current-prefix-arg 'toggle))) | ||
| 8211 | (setq markdown-enable-math | ||
| 8212 | (if (eq arg 'toggle) | ||
| 8213 | (not markdown-enable-math) | ||
| 8214 | (> (prefix-numeric-value arg) 0))) | ||
| 8215 | (if markdown-enable-math | ||
| 8216 | (progn | ||
| 8217 | (font-lock-add-keywords | ||
| 8218 | 'markdown-mode markdown-mode-font-lock-keywords-math) | ||
| 8219 | (message "markdown-mode math support enabled")) | ||
| 8220 | (font-lock-remove-keywords | ||
| 8221 | 'markdown-mode markdown-mode-font-lock-keywords-math) | ||
| 8222 | (message "markdown-mode math support disabled")) | ||
| 8223 | (markdown-reload-extensions)) | ||
| 8224 | |||
| 8225 | |||
| 8226 | ;;; GFM Checkboxes ============================================================ | ||
| 8227 | |||
| 8228 | (define-button-type 'markdown-gfm-checkbox-button | ||
| 8229 | 'follow-link t | ||
| 8230 | 'face 'markdown-gfm-checkbox-face | ||
| 8231 | 'mouse-face 'markdown-highlight-face | ||
| 8232 | 'action #'markdown-toggle-gfm-checkbox-button) | ||
| 8233 | |||
| 8234 | (defun markdown-gfm-task-list-item-at-point (&optional bounds) | ||
| 8235 | "Return non-nil if there is a GFM task list item at the point. | ||
| 8236 | Optionally, the list item BOUNDS may be given if available, as | ||
| 8237 | returned by `markdown-cur-list-item-bounds'. When a task list item | ||
| 8238 | is found, the return value is the same value returned by | ||
| 8239 | `markdown-cur-list-item-bounds'." | ||
| 8240 | (unless bounds | ||
| 8241 | (setq bounds (markdown-cur-list-item-bounds))) | ||
| 8242 | (> (length (nth 5 bounds)) 0)) | ||
| 8243 | |||
| 8244 | (defun markdown-insert-gfm-checkbox () | ||
| 8245 | "Add GFM checkbox at point. | ||
| 8246 | Returns t if added. | ||
| 8247 | Returns nil if non-applicable." | ||
| 8248 | (interactive) | ||
| 8249 | (let ((bounds (markdown-cur-list-item-bounds))) | ||
| 8250 | (if bounds | ||
| 8251 | (unless (cl-sixth bounds) | ||
| 8252 | (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) | ||
| 8253 | (markup "[ ] ")) | ||
| 8254 | (if (< pos (point)) | ||
| 8255 | (save-excursion | ||
| 8256 | (goto-char pos) | ||
| 8257 | (insert markup)) | ||
| 8258 | (goto-char pos) | ||
| 8259 | (insert markup)) | ||
| 8260 | (syntax-propertize (+ (cl-second bounds) 4)) | ||
| 8261 | t)) | ||
| 8262 | (unless (save-excursion | ||
| 8263 | (back-to-indentation) | ||
| 8264 | (or (markdown-list-item-at-point-p) | ||
| 8265 | (markdown-heading-at-point) | ||
| 8266 | (markdown-in-comment-p) | ||
| 8267 | (markdown-code-block-at-point-p))) | ||
| 8268 | (let ((pos (save-excursion | ||
| 8269 | (back-to-indentation) | ||
| 8270 | (point))) | ||
| 8271 | (markup (concat (or (save-excursion | ||
| 8272 | (beginning-of-line 0) | ||
| 8273 | (cl-fifth (markdown-cur-list-item-bounds))) | ||
| 8274 | markdown-unordered-list-item-prefix) | ||
| 8275 | "[ ] "))) | ||
| 8276 | (if (< pos (point)) | ||
| 8277 | (save-excursion | ||
| 8278 | (goto-char pos) | ||
| 8279 | (insert markup)) | ||
| 8280 | (goto-char pos) | ||
| 8281 | (insert markup)) | ||
| 8282 | (syntax-propertize (point-at-eol)) | ||
| 8283 | t))))) | ||
| 8284 | |||
| 8285 | (defun markdown-toggle-gfm-checkbox () | ||
| 8286 | "Toggle GFM checkbox at point. | ||
| 8287 | Returns the resulting status as a string, either \"[x]\" or \"[ ]\". | ||
| 8288 | Returns nil if there is no task list item at the point." | ||
| 8289 | (interactive) | ||
| 8290 | (save-match-data | ||
| 8291 | (save-excursion | ||
| 8292 | (let ((bounds (markdown-cur-list-item-bounds))) | ||
| 8293 | (when bounds | ||
| 8294 | ;; Move to beginning of task list item | ||
| 8295 | (goto-char (cl-first bounds)) | ||
| 8296 | ;; Advance to column of first non-whitespace after marker | ||
| 8297 | (forward-char (cl-fourth bounds)) | ||
| 8298 | (cond ((looking-at "\\[ \\]") | ||
| 8299 | (replace-match | ||
| 8300 | (if markdown-gfm-uppercase-checkbox "[X]" "[x]") | ||
| 8301 | nil t) | ||
| 8302 | (match-string-no-properties 0)) | ||
| 8303 | ((looking-at "\\[[xX]\\]") | ||
| 8304 | (replace-match "[ ]" nil t) | ||
| 8305 | (match-string-no-properties 0)))))))) | ||
| 8306 | |||
| 8307 | (defun markdown-toggle-gfm-checkbox-button (button) | ||
| 8308 | "Toggle GFM checkbox BUTTON on click." | ||
| 8309 | (save-match-data | ||
| 8310 | (save-excursion | ||
| 8311 | (goto-char (button-start button)) | ||
| 8312 | (markdown-toggle-gfm-checkbox)))) | ||
| 8313 | |||
| 8314 | (defun markdown-make-gfm-checkboxes-buttons (start end) | ||
| 8315 | "Make GFM checkboxes buttons in region between START and END." | ||
| 8316 | (save-excursion | ||
| 8317 | (goto-char start) | ||
| 8318 | (let ((case-fold-search t)) | ||
| 8319 | (save-excursion | ||
| 8320 | (while (re-search-forward markdown-regex-gfm-checkbox end t) | ||
| 8321 | (make-button (match-beginning 1) (match-end 1) | ||
| 8322 | :type 'markdown-gfm-checkbox-button)))))) | ||
| 8323 | |||
| 8324 | ;; Called when any modification is made to buffer text. | ||
| 8325 | (defun markdown-gfm-checkbox-after-change-function (beg end _) | ||
| 8326 | "Add to `after-change-functions' to setup GFM checkboxes as buttons. | ||
| 8327 | BEG and END are the limits of scanned region." | ||
| 8328 | (save-excursion | ||
| 8329 | (save-match-data | ||
| 8330 | ;; Rescan between start of line from `beg' and start of line after `end'. | ||
| 8331 | (markdown-make-gfm-checkboxes-buttons | ||
| 8332 | (progn (goto-char beg) (beginning-of-line) (point)) | ||
| 8333 | (progn (goto-char end) (forward-line 1) (point)))))) | ||
| 8334 | |||
| 8335 | (defun markdown-remove-gfm-checkbox-overlays () | ||
| 8336 | "Remove all GFM checkbox overlays in buffer." | ||
| 8337 | (save-excursion | ||
| 8338 | (save-restriction | ||
| 8339 | (widen) | ||
| 8340 | (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) | ||
| 8341 | |||
| 8342 | |||
| 8343 | ;;; Display inline image ====================================================== | ||
| 8344 | |||
| 8345 | (defvar-local markdown-inline-image-overlays nil) | ||
| 8346 | |||
| 8347 | (defun markdown-remove-inline-images () | ||
| 8348 | "Remove inline image overlays from image links in the buffer. | ||
| 8349 | This can be toggled with `markdown-toggle-inline-images' | ||
| 8350 | or \\[markdown-toggle-inline-images]." | ||
| 8351 | (interactive) | ||
| 8352 | (mapc #'delete-overlay markdown-inline-image-overlays) | ||
| 8353 | (setq markdown-inline-image-overlays nil)) | ||
| 8354 | |||
| 8355 | (defcustom markdown-display-remote-images nil | ||
| 8356 | "If non-nil, download and display remote images. | ||
| 8357 | See also `markdown-inline-image-overlays'. | ||
| 8358 | |||
| 8359 | Only image URLs specified with a protocol listed in | ||
| 8360 | `markdown-remote-image-protocols' are displayed." | ||
| 8361 | :group 'markdown | ||
| 8362 | :type 'boolean) | ||
| 8363 | |||
| 8364 | (defcustom markdown-remote-image-protocols '("https") | ||
| 8365 | "List of protocols to use to download remote images. | ||
| 8366 | See also `markdown-display-remote-images'." | ||
| 8367 | :group 'markdown | ||
| 8368 | :type '(repeat string)) | ||
| 8369 | |||
| 8370 | (defvar markdown--remote-image-cache | ||
| 8371 | (make-hash-table :test 'equal) | ||
| 8372 | "A map from URLs to image paths.") | ||
| 8373 | |||
| 8374 | (defun markdown--get-remote-image (url) | ||
| 8375 | "Retrieve the image path for a given URL." | ||
| 8376 | (or (gethash url markdown--remote-image-cache) | ||
| 8377 | (let ((dl-path (make-temp-file "markdown-mode--image"))) | ||
| 8378 | (require 'url) | ||
| 8379 | (url-copy-file url dl-path t) | ||
| 8380 | (puthash url dl-path markdown--remote-image-cache)))) | ||
| 8381 | |||
| 8382 | (defun markdown-display-inline-images () | ||
| 8383 | "Add inline image overlays to image links in the buffer. | ||
| 8384 | This can be toggled with `markdown-toggle-inline-images' | ||
| 8385 | or \\[markdown-toggle-inline-images]." | ||
| 8386 | (interactive) | ||
| 8387 | (unless (display-images-p) | ||
| 8388 | (error "Cannot show images")) | ||
| 8389 | (save-excursion | ||
| 8390 | (save-restriction | ||
| 8391 | (widen) | ||
| 8392 | (goto-char (point-min)) | ||
| 8393 | (while (re-search-forward markdown-regex-link-inline nil t) | ||
| 8394 | (let ((start (match-beginning 0)) | ||
| 8395 | (imagep (match-beginning 1)) | ||
| 8396 | (end (match-end 0)) | ||
| 8397 | (file (match-string-no-properties 6))) | ||
| 8398 | (when (and imagep | ||
| 8399 | (not (zerop (length file)))) | ||
| 8400 | (unless (file-exists-p file) | ||
| 8401 | (let* ((download-file (funcall markdown-translate-filename-function file)) | ||
| 8402 | (valid-url (ignore-errors | ||
| 8403 | (member (downcase (url-type (url-generic-parse-url download-file))) | ||
| 8404 | markdown-remote-image-protocols)))) | ||
| 8405 | (if (and markdown-display-remote-images valid-url) | ||
| 8406 | (setq file (markdown--get-remote-image download-file)) | ||
| 8407 | (when (not valid-url) | ||
| 8408 | ;; strip query parameter | ||
| 8409 | (setq file (replace-regexp-in-string "?.+\\'" "" file)))))) | ||
| 8410 | (when (file-exists-p file) | ||
| 8411 | (let* ((abspath (if (file-name-absolute-p file) | ||
| 8412 | file | ||
| 8413 | (concat default-directory file))) | ||
| 8414 | (image | ||
| 8415 | (if (and markdown-max-image-size | ||
| 8416 | (image-type-available-p 'imagemagick)) | ||
| 8417 | (create-image | ||
| 8418 | abspath 'imagemagick nil | ||
| 8419 | :max-width (car markdown-max-image-size) | ||
| 8420 | :max-height (cdr markdown-max-image-size)) | ||
| 8421 | (create-image abspath)))) | ||
| 8422 | (when image | ||
| 8423 | (let ((ov (make-overlay start end))) | ||
| 8424 | (overlay-put ov 'display image) | ||
| 8425 | (overlay-put ov 'face 'default) | ||
| 8426 | (push ov markdown-inline-image-overlays))))))))))) | ||
| 8427 | |||
| 8428 | (defun markdown-toggle-inline-images () | ||
| 8429 | "Toggle inline image overlays in the buffer." | ||
| 8430 | (interactive) | ||
| 8431 | (if markdown-inline-image-overlays | ||
| 8432 | (markdown-remove-inline-images) | ||
| 8433 | (markdown-display-inline-images))) | ||
| 8434 | |||
| 8435 | |||
| 8436 | ;;; GFM Code Block Fontification ============================================== | ||
| 8437 | |||
| 8438 | (defcustom markdown-fontify-code-blocks-natively nil | ||
| 8439 | "When non-nil, fontify code in code blocks using the native major mode. | ||
| 8440 | This only works for fenced code blocks where the language is | ||
| 8441 | specified where we can automatically determine the appropriate | ||
| 8442 | mode to use. The language to mode mapping may be customized by | ||
| 8443 | setting the variable `markdown-code-lang-modes'." | ||
| 8444 | :group 'markdown | ||
| 8445 | :type 'boolean | ||
| 8446 | :safe 'booleanp | ||
| 8447 | :package-version '(markdown-mode . "2.3")) | ||
| 8448 | |||
| 8449 | (defcustom markdown-fontify-code-block-default-mode nil | ||
| 8450 | "Default mode to use to fontify code blocks. | ||
| 8451 | This mode is used when automatic detection fails, such as for GFM | ||
| 8452 | code blocks with no language specified." | ||
| 8453 | :group 'markdown | ||
| 8454 | :type '(choice function (const :tag "None" nil)) | ||
| 8455 | :package-version '(markdown-mode . "2.4")) | ||
| 8456 | |||
| 8457 | (defun markdown-toggle-fontify-code-blocks-natively (&optional arg) | ||
| 8458 | "Toggle the native fontification of code blocks. | ||
| 8459 | With a prefix argument ARG, enable if ARG is positive, | ||
| 8460 | and disable otherwise." | ||
| 8461 | (interactive (list (or current-prefix-arg 'toggle))) | ||
| 8462 | (setq markdown-fontify-code-blocks-natively | ||
| 8463 | (if (eq arg 'toggle) | ||
| 8464 | (not markdown-fontify-code-blocks-natively) | ||
| 8465 | (> (prefix-numeric-value arg) 0))) | ||
| 8466 | (if markdown-fontify-code-blocks-natively | ||
| 8467 | (message "markdown-mode native code block fontification enabled") | ||
| 8468 | (message "markdown-mode native code block fontification disabled")) | ||
| 8469 | (markdown-reload-extensions)) | ||
| 8470 | |||
| 8471 | ;; This is based on `org-src-lang-modes' from org-src.el | ||
| 8472 | (defcustom markdown-code-lang-modes | ||
| 8473 | '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) | ||
| 8474 | ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) | ||
| 8475 | ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) | ||
| 8476 | ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) | ||
| 8477 | ("bash" . sh-mode)) | ||
| 8478 | "Alist mapping languages to their major mode. | ||
| 8479 | The key is the language name, the value is the major mode. For | ||
| 8480 | many languages this is simple, but for language where this is not | ||
| 8481 | the case, this variable provides a way to simplify things on the | ||
| 8482 | user side. For example, there is no ocaml-mode in Emacs, but the | ||
| 8483 | mode to use is `tuareg-mode'." | ||
| 8484 | :group 'markdown | ||
| 8485 | :type '(repeat | ||
| 8486 | (cons | ||
| 8487 | (string "Language name") | ||
| 8488 | (symbol "Major mode"))) | ||
| 8489 | :package-version '(markdown-mode . "2.3")) | ||
| 8490 | |||
| 8491 | (defun markdown-get-lang-mode (lang) | ||
| 8492 | "Return major mode that should be used for LANG. | ||
| 8493 | LANG is a string, and the returned major mode is a symbol." | ||
| 8494 | (cl-find-if | ||
| 8495 | 'fboundp | ||
| 8496 | (list (cdr (assoc lang markdown-code-lang-modes)) | ||
| 8497 | (cdr (assoc (downcase lang) markdown-code-lang-modes)) | ||
| 8498 | (intern (concat lang "-mode")) | ||
| 8499 | (intern (concat (downcase lang) "-mode"))))) | ||
| 8500 | |||
| 8501 | (defun markdown-fontify-code-blocks-generic (matcher last) | ||
| 8502 | "Add text properties to next code block from point to LAST. | ||
| 8503 | Use matching function MATCHER." | ||
| 8504 | (when (funcall matcher last) | ||
| 8505 | (save-excursion | ||
| 8506 | (save-match-data | ||
| 8507 | (let* ((start (match-beginning 0)) | ||
| 8508 | (end (match-end 0)) | ||
| 8509 | ;; Find positions outside opening and closing backquotes. | ||
| 8510 | (bol-prev (progn (goto-char start) | ||
| 8511 | (if (bolp) (point-at-bol 0) (point-at-bol)))) | ||
| 8512 | (eol-next (progn (goto-char end) | ||
| 8513 | (if (bolp) (point-at-bol 2) (point-at-bol 3)))) | ||
| 8514 | lang) | ||
| 8515 | (if (and markdown-fontify-code-blocks-natively | ||
| 8516 | (or (setq lang (markdown-code-block-lang)) | ||
| 8517 | markdown-fontify-code-block-default-mode)) | ||
| 8518 | (markdown-fontify-code-block-natively lang start end) | ||
| 8519 | (add-text-properties start end '(face markdown-pre-face))) | ||
| 8520 | ;; Set background for block as well as opening and closing lines. | ||
| 8521 | (font-lock-append-text-property | ||
| 8522 | bol-prev eol-next 'face 'markdown-code-face) | ||
| 8523 | ;; Set invisible property for lines before and after, including newline. | ||
| 8524 | (add-text-properties bol-prev start '(invisible markdown-markup)) | ||
| 8525 | (add-text-properties end eol-next '(invisible markdown-markup))))) | ||
| 8526 | t)) | ||
| 8527 | |||
| 8528 | (defun markdown-fontify-gfm-code-blocks (last) | ||
| 8529 | "Add text properties to next GFM code block from point to LAST." | ||
| 8530 | (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) | ||
| 8531 | |||
| 8532 | (defun markdown-fontify-fenced-code-blocks (last) | ||
| 8533 | "Add text properties to next tilde fenced code block from point to LAST." | ||
| 8534 | (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) | ||
| 8535 | |||
| 8536 | ;; Based on `org-src-font-lock-fontify-block' from org-src.el. | ||
| 8537 | (defun markdown-fontify-code-block-natively (lang start end) | ||
| 8538 | "Fontify given GFM or fenced code block. | ||
| 8539 | This function is called by Emacs for automatic fontification when | ||
| 8540 | `markdown-fontify-code-blocks-natively' is non-nil. LANG is the | ||
| 8541 | language used in the block. START and END specify the block | ||
| 8542 | position." | ||
| 8543 | (let ((lang-mode (if lang (markdown-get-lang-mode lang) | ||
| 8544 | markdown-fontify-code-block-default-mode))) | ||
| 8545 | (when (fboundp lang-mode) | ||
| 8546 | (let ((string (buffer-substring-no-properties start end)) | ||
| 8547 | (modified (buffer-modified-p)) | ||
| 8548 | (markdown-buffer (current-buffer)) pos next) | ||
| 8549 | (remove-text-properties start end '(face nil)) | ||
| 8550 | (with-current-buffer | ||
| 8551 | (get-buffer-create | ||
| 8552 | (concat " markdown-code-fontification:" (symbol-name lang-mode))) | ||
| 8553 | ;; Make sure that modification hooks are not inhibited in | ||
| 8554 | ;; the org-src-fontification buffer in case we're called | ||
| 8555 | ;; from `jit-lock-function' (Bug#25132). | ||
| 8556 | (let ((inhibit-modification-hooks nil)) | ||
| 8557 | (delete-region (point-min) (point-max)) | ||
| 8558 | (insert string " ")) ;; so there's a final property change | ||
| 8559 | (unless (eq major-mode lang-mode) (funcall lang-mode)) | ||
| 8560 | (font-lock-ensure) | ||
| 8561 | (setq pos (point-min)) | ||
| 8562 | (while (setq next (next-single-property-change pos 'face)) | ||
| 8563 | (let ((val (get-text-property pos 'face))) | ||
| 8564 | (when val | ||
| 8565 | (put-text-property | ||
| 8566 | (+ start (1- pos)) (1- (+ start next)) 'face | ||
| 8567 | val markdown-buffer))) | ||
| 8568 | (setq pos next))) | ||
| 8569 | (add-text-properties | ||
| 8570 | start end | ||
| 8571 | '(font-lock-fontified t fontified t font-lock-multiline t)) | ||
| 8572 | (set-buffer-modified-p modified))))) | ||
| 8573 | |||
| 8574 | (require 'edit-indirect nil t) | ||
| 8575 | (defvar edit-indirect-guess-mode-function) | ||
| 8576 | (defvar edit-indirect-after-commit-functions) | ||
| 8577 | |||
| 8578 | (defun markdown--edit-indirect-after-commit-function (_beg end) | ||
| 8579 | "Ensure trailing newlines at the END of code blocks." | ||
| 8580 | (goto-char end) | ||
| 8581 | (unless (eq (char-before) ?\n) | ||
| 8582 | (insert "\n"))) | ||
| 8583 | |||
| 8584 | (defun markdown-edit-code-block () | ||
| 8585 | "Edit Markdown code block in an indirect buffer." | ||
| 8586 | (interactive) | ||
| 8587 | (save-excursion | ||
| 8588 | (if (fboundp 'edit-indirect-region) | ||
| 8589 | (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) | ||
| 8590 | (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2))) | ||
| 8591 | (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1)))) | ||
| 8592 | (if (and begin end) | ||
| 8593 | (let* ((lang (markdown-code-block-lang)) | ||
| 8594 | (mode (or (and lang (markdown-get-lang-mode lang)) | ||
| 8595 | markdown-edit-code-block-default-mode)) | ||
| 8596 | (edit-indirect-guess-mode-function | ||
| 8597 | (lambda (_parent-buffer _beg _end) | ||
| 8598 | (funcall mode)))) | ||
| 8599 | (edit-indirect-region begin end 'display-buffer)) | ||
| 8600 | (user-error "Not inside a GFM or tilde fenced code block"))) | ||
| 8601 | (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") | ||
| 8602 | (progn (package-refresh-contents) | ||
| 8603 | (package-install 'edit-indirect) | ||
| 8604 | (markdown-edit-code-block)))))) | ||
| 8605 | |||
| 8606 | |||
| 8607 | ;;; Table Editing ============================================================= | ||
| 8608 | |||
| 8609 | ;; These functions were originally adapted from `org-table.el'. | ||
| 8610 | |||
| 8611 | ;; General helper functions | ||
| 8612 | |||
| 8613 | (defmacro markdown--with-gensyms (symbols &rest body) | ||
| 8614 | (declare (debug (sexp body)) (indent 1)) | ||
| 8615 | `(let ,(mapcar (lambda (s) | ||
| 8616 | `(,s (make-symbol (concat "--" (symbol-name ',s))))) | ||
| 8617 | symbols) | ||
| 8618 | ,@body)) | ||
| 8619 | |||
| 8620 | (defun markdown--split-string (string &optional separators) | ||
| 8621 | "Splits STRING into substrings at SEPARATORS. | ||
| 8622 | SEPARATORS is a regular expression. If nil it defaults to | ||
| 8623 | `split-string-default-separators'. This version returns no empty | ||
| 8624 | strings if there are matches at the beginning and end of string." | ||
| 8625 | (let ((start 0) notfirst list) | ||
| 8626 | (while (and (string-match | ||
| 8627 | (or separators split-string-default-separators) | ||
| 8628 | string | ||
| 8629 | (if (and notfirst | ||
| 8630 | (= start (match-beginning 0)) | ||
| 8631 | (< start (length string))) | ||
| 8632 | (1+ start) start)) | ||
| 8633 | (< (match-beginning 0) (length string))) | ||
| 8634 | (setq notfirst t) | ||
| 8635 | (or (eq (match-beginning 0) 0) | ||
| 8636 | (and (eq (match-beginning 0) (match-end 0)) | ||
| 8637 | (eq (match-beginning 0) start)) | ||
| 8638 | (push (substring string start (match-beginning 0)) list)) | ||
| 8639 | (setq start (match-end 0))) | ||
| 8640 | (or (eq start (length string)) | ||
| 8641 | (push (substring string start) list)) | ||
| 8642 | (nreverse list))) | ||
| 8643 | |||
| 8644 | (defun markdown--string-width (s) | ||
| 8645 | "Return width of string S. | ||
| 8646 | This version ignores characters with invisibility property | ||
| 8647 | `markdown-markup'." | ||
| 8648 | (let (b) | ||
| 8649 | (when (or (eq t buffer-invisibility-spec) | ||
| 8650 | (member 'markdown-markup buffer-invisibility-spec)) | ||
| 8651 | (while (setq b (text-property-any | ||
| 8652 | 0 (length s) | ||
| 8653 | 'invisible 'markdown-markup s)) | ||
| 8654 | (setq s (concat | ||
| 8655 | (substring s 0 b) | ||
| 8656 | (substring s (or (next-single-property-change | ||
| 8657 | b 'invisible s) | ||
| 8658 | (length s)))))))) | ||
| 8659 | (string-width s)) | ||
| 8660 | |||
| 8661 | (defun markdown--remove-invisible-markup (s) | ||
| 8662 | "Remove Markdown markup from string S. | ||
| 8663 | This version removes characters with invisibility property | ||
| 8664 | `markdown-markup'." | ||
| 8665 | (let (b) | ||
| 8666 | (while (setq b (text-property-any | ||
| 8667 | 0 (length s) | ||
| 8668 | 'invisible 'markdown-markup s)) | ||
| 8669 | (setq s (concat | ||
| 8670 | (substring s 0 b) | ||
| 8671 | (substring s (or (next-single-property-change | ||
| 8672 | b 'invisible s) | ||
| 8673 | (length s))))))) | ||
| 8674 | s) | ||
| 8675 | |||
| 8676 | ;; Functions for maintaining tables | ||
| 8677 | |||
| 8678 | (defvar markdown-table-at-point-p-function nil | ||
| 8679 | "Function to decide if point is inside a table. | ||
| 8680 | |||
| 8681 | The indirection serves to differentiate between standard markdown | ||
| 8682 | tables and gfm tables which are less strict about the markup.") | ||
| 8683 | |||
| 8684 | (defconst markdown-table-line-regexp "^[ \t]*|" | ||
| 8685 | "Regexp matching any line inside a table.") | ||
| 8686 | |||
| 8687 | (defconst markdown-table-hline-regexp "^[ \t]*|[-:]" | ||
| 8688 | "Regexp matching hline inside a table.") | ||
| 8689 | |||
| 8690 | (defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" | ||
| 8691 | "Regexp matching dline inside a table.") | ||
| 8692 | |||
| 8693 | (defun markdown-table-at-point-p () | ||
| 8694 | "Return non-nil when point is inside a table." | ||
| 8695 | (if (functionp markdown-table-at-point-p-function) | ||
| 8696 | (funcall markdown-table-at-point-p-function) | ||
| 8697 | (markdown--table-at-point-p))) | ||
| 8698 | |||
| 8699 | (defun markdown--table-at-point-p () | ||
| 8700 | "Return non-nil when point is inside a table." | ||
| 8701 | (save-excursion | ||
| 8702 | (beginning-of-line) | ||
| 8703 | (and (looking-at-p markdown-table-line-regexp) | ||
| 8704 | (not (markdown-code-block-at-point-p))))) | ||
| 8705 | |||
| 8706 | (defconst gfm-table-line-regexp "^.?*|" | ||
| 8707 | "Regexp matching any line inside a table.") | ||
| 8708 | |||
| 8709 | (defconst gfm-table-hline-regexp "^-+\\(|-\\)+" | ||
| 8710 | "Regexp matching hline inside a table.") | ||
| 8711 | |||
| 8712 | ;; GFM simplified tables syntax is as follows: | ||
| 8713 | ;; - A header line for the column names, this is any text | ||
| 8714 | ;; separated by `|'. | ||
| 8715 | ;; - Followed by a string -|-|- ..., the number of dashes is optional | ||
| 8716 | ;; but must be higher than 1. The number of separators should match | ||
| 8717 | ;; the number of columns. | ||
| 8718 | ;; - Followed by the rows of data, which has the same format as the | ||
| 8719 | ;; header line. | ||
| 8720 | ;; Example: | ||
| 8721 | ;; | ||
| 8722 | ;; foo | bar | ||
| 8723 | ;; ------|--------- | ||
| 8724 | ;; bar | baz | ||
| 8725 | ;; bar | baz | ||
| 8726 | (defun gfm--table-at-point-p () | ||
| 8727 | "Return non-nil when point is inside a gfm-compatible table." | ||
| 8728 | (or (markdown--table-at-point-p) | ||
| 8729 | (save-excursion | ||
| 8730 | (beginning-of-line) | ||
| 8731 | (when (looking-at-p gfm-table-line-regexp) | ||
| 8732 | ;; we might be at the first line of the table, check if the | ||
| 8733 | ;; line below is the hline | ||
| 8734 | (or (save-excursion | ||
| 8735 | (forward-line 1) | ||
| 8736 | (looking-at-p gfm-table-hline-regexp)) | ||
| 8737 | ;; go up to find the header | ||
| 8738 | (catch 'done | ||
| 8739 | (while (looking-at-p gfm-table-line-regexp) | ||
| 8740 | (cond | ||
| 8741 | ((looking-at-p gfm-table-hline-regexp) | ||
| 8742 | (throw 'done t)) | ||
| 8743 | ((bobp) | ||
| 8744 | (throw 'done nil))) | ||
| 8745 | (forward-line -1)) | ||
| 8746 | nil)))))) | ||
| 8747 | |||
| 8748 | (defun markdown-table-hline-at-point-p () | ||
| 8749 | "Return non-nil when point is on a hline in a table. | ||
| 8750 | This function assumes point is on a table." | ||
| 8751 | (save-excursion | ||
| 8752 | (beginning-of-line) | ||
| 8753 | (looking-at-p markdown-table-hline-regexp))) | ||
| 8754 | |||
| 8755 | (defun markdown-table-begin () | ||
| 8756 | "Find the beginning of the table and return its position. | ||
| 8757 | This function assumes point is on a table." | ||
| 8758 | (save-excursion | ||
| 8759 | (while (and (not (bobp)) | ||
| 8760 | (markdown-table-at-point-p)) | ||
| 8761 | (forward-line -1)) | ||
| 8762 | (unless (or (eobp) | ||
| 8763 | (markdown-table-at-point-p)) | ||
| 8764 | (forward-line 1)) | ||
| 8765 | (point))) | ||
| 8766 | |||
| 8767 | (defun markdown-table-end () | ||
| 8768 | "Find the end of the table and return its position. | ||
| 8769 | This function assumes point is on a table." | ||
| 8770 | (save-excursion | ||
| 8771 | (while (and (not (eobp)) | ||
| 8772 | (markdown-table-at-point-p)) | ||
| 8773 | (forward-line 1)) | ||
| 8774 | (point))) | ||
| 8775 | |||
| 8776 | (defun markdown-table-get-dline () | ||
| 8777 | "Return index of the table data line at point. | ||
| 8778 | This function assumes point is on a table." | ||
| 8779 | (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) | ||
| 8780 | (save-excursion | ||
| 8781 | (goto-char (markdown-table-begin)) | ||
| 8782 | (while (and (re-search-forward | ||
| 8783 | markdown-table-dline-regexp end t) | ||
| 8784 | (setq cnt (1+ cnt)) | ||
| 8785 | (< (point-at-eol) pos)))) | ||
| 8786 | cnt)) | ||
| 8787 | |||
| 8788 | (defun markdown--thing-at-wiki-link (pos) | ||
| 8789 | (when markdown-enable-wiki-links | ||
| 8790 | (save-excursion | ||
| 8791 | (save-match-data | ||
| 8792 | (goto-char pos) | ||
| 8793 | (thing-at-point-looking-at markdown-regex-wiki-link))))) | ||
| 8794 | |||
| 8795 | (defun markdown-table-get-column () | ||
| 8796 | "Return table column at point. | ||
| 8797 | This function assumes point is on a table." | ||
| 8798 | (let ((pos (point)) (cnt 0)) | ||
| 8799 | (save-excursion | ||
| 8800 | (beginning-of-line) | ||
| 8801 | (while (search-forward "|" pos t) | ||
| 8802 | (unless (markdown--thing-at-wiki-link (match-beginning 0)) | ||
| 8803 | (setq cnt (1+ cnt))))) | ||
| 8804 | cnt)) | ||
| 8805 | |||
| 8806 | (defun markdown-table-get-cell (&optional n) | ||
| 8807 | "Return the content of the cell in column N of current row. | ||
| 8808 | N defaults to column at point. This function assumes point is on | ||
| 8809 | a table." | ||
| 8810 | (and n (markdown-table-goto-column n)) | ||
| 8811 | (skip-chars-backward "^|\n") (backward-char 1) | ||
| 8812 | (if (looking-at "|[^|\r\n]*") | ||
| 8813 | (let* ((pos (match-beginning 0)) | ||
| 8814 | (val (buffer-substring (1+ pos) (match-end 0)))) | ||
| 8815 | (goto-char (min (point-at-eol) (+ 2 pos))) | ||
| 8816 | ;; Trim whitespaces | ||
| 8817 | (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) | ||
| 8818 | val (replace-regexp-in-string "[ \t]+\\'" "" val))) | ||
| 8819 | (forward-char 1) "")) | ||
| 8820 | |||
| 8821 | (defun markdown-table-goto-dline (n) | ||
| 8822 | "Go to the Nth data line in the table at point. | ||
| 8823 | Return t when the line exists, nil otherwise. This function | ||
| 8824 | assumes point is on a table." | ||
| 8825 | (goto-char (markdown-table-begin)) | ||
| 8826 | (let ((end (markdown-table-end)) (cnt 0)) | ||
| 8827 | (while (and (re-search-forward | ||
| 8828 | markdown-table-dline-regexp end t) | ||
| 8829 | (< (setq cnt (1+ cnt)) n))) | ||
| 8830 | (= cnt n))) | ||
| 8831 | |||
| 8832 | (defun markdown-table-goto-column (n &optional on-delim) | ||
| 8833 | "Go to the Nth column in the table line at point. | ||
| 8834 | With optional argument ON-DELIM, stop with point before the left | ||
| 8835 | delimiter of the cell. If there are less than N cells, just go | ||
| 8836 | beyond the last delimiter. This function assumes point is on a | ||
| 8837 | table." | ||
| 8838 | (beginning-of-line 1) | ||
| 8839 | (when (> n 0) | ||
| 8840 | (while (and (> n 0) (search-forward "|" (point-at-eol) t)) | ||
| 8841 | (unless (markdown--thing-at-wiki-link (match-beginning 0)) | ||
| 8842 | (cl-decf n))) | ||
| 8843 | (if on-delim | ||
| 8844 | (backward-char 1) | ||
| 8845 | (when (looking-at " ") (forward-char 1))))) | ||
| 8846 | |||
| 8847 | (defmacro markdown-table-save-cell (&rest body) | ||
| 8848 | "Save cell at point, execute BODY and restore cell. | ||
| 8849 | This function assumes point is on a table." | ||
| 8850 | (declare (debug (body))) | ||
| 8851 | (markdown--with-gensyms (line column) | ||
| 8852 | `(let ((,line (copy-marker (line-beginning-position))) | ||
| 8853 | (,column (markdown-table-get-column))) | ||
| 8854 | (unwind-protect | ||
| 8855 | (progn ,@body) | ||
| 8856 | (goto-char ,line) | ||
| 8857 | (markdown-table-goto-column ,column) | ||
| 8858 | (set-marker ,line nil))))) | ||
| 8859 | |||
| 8860 | (defun markdown-table-blank-line (s) | ||
| 8861 | "Convert a table line S into a line with blank cells." | ||
| 8862 | (if (string-match "^[ \t]*|-" s) | ||
| 8863 | (setq s (mapconcat | ||
| 8864 | (lambda (x) (if (member x '(?| ?+)) "|" " ")) | ||
| 8865 | s "")) | ||
| 8866 | (with-temp-buffer | ||
| 8867 | (insert s) | ||
| 8868 | (goto-char (point-min)) | ||
| 8869 | (when (re-search-forward "|" nil t) | ||
| 8870 | (let ((cur (point)) | ||
| 8871 | ret) | ||
| 8872 | (while (re-search-forward "|" nil t) | ||
| 8873 | (when (and (not (eql (char-before (match-beginning 0)) ?\\)) | ||
| 8874 | (not (markdown--thing-at-wiki-link (match-beginning 0)))) | ||
| 8875 | (push (make-string (- (match-beginning 0) cur) ? ) ret) | ||
| 8876 | (setq cur (match-end 0)))) | ||
| 8877 | (format "|%s|" (string-join (nreverse ret) "|"))))))) | ||
| 8878 | |||
| 8879 | (defun markdown-table-colfmt (fmtspec) | ||
| 8880 | "Process column alignment specifier FMTSPEC for tables." | ||
| 8881 | (when (stringp fmtspec) | ||
| 8882 | (mapcar (lambda (x) | ||
| 8883 | (cond ((string-match-p "^:.*:$" x) 'c) | ||
| 8884 | ((string-match-p "^:" x) 'l) | ||
| 8885 | ((string-match-p ":$" x) 'r) | ||
| 8886 | (t 'd))) | ||
| 8887 | (markdown--split-string fmtspec "\\s-*|\\s-*")))) | ||
| 8888 | |||
| 8889 | (defun markdown--first-column-p (bar-pos) | ||
| 8890 | (save-excursion | ||
| 8891 | (save-match-data | ||
| 8892 | (goto-char bar-pos) | ||
| 8893 | (looking-back "^\\s-*" (line-beginning-position))))) | ||
| 8894 | |||
| 8895 | (defun markdown--table-line-to-columns (line) | ||
| 8896 | (with-temp-buffer | ||
| 8897 | (insert line) | ||
| 8898 | (goto-char (point-min)) | ||
| 8899 | (let ((cur (point)) | ||
| 8900 | ret) | ||
| 8901 | (while (re-search-forward "\\s-*\\(|\\)\\s-*" nil t) | ||
| 8902 | (if (markdown--first-column-p (match-beginning 1)) | ||
| 8903 | (setq cur (match-end 0)) | ||
| 8904 | (cond ((eql (char-before (match-beginning 1)) ?\\) | ||
| 8905 | ;; keep spaces | ||
| 8906 | (goto-char (match-end 1))) | ||
| 8907 | ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing | ||
| 8908 | (t | ||
| 8909 | (push (buffer-substring-no-properties cur (match-beginning 0)) ret) | ||
| 8910 | (setq cur (match-end 0)))))) | ||
| 8911 | (when (< cur (length line)) | ||
| 8912 | (push (buffer-substring-no-properties cur (point-max)) ret)) | ||
| 8913 | (nreverse ret)))) | ||
| 8914 | |||
| 8915 | (defun markdown-table-align () | ||
| 8916 | "Align table at point. | ||
| 8917 | This function assumes point is on a table." | ||
| 8918 | (interactive) | ||
| 8919 | (let ((begin (markdown-table-begin)) | ||
| 8920 | (end (copy-marker (markdown-table-end)))) | ||
| 8921 | (markdown-table-save-cell | ||
| 8922 | (goto-char begin) | ||
| 8923 | (let* (fmtspec | ||
| 8924 | ;; Store table indent | ||
| 8925 | (indent (progn (looking-at "[ \t]*") (match-string 0))) | ||
| 8926 | ;; Split table in lines and save column format specifier | ||
| 8927 | (lines (mapcar (lambda (l) | ||
| 8928 | (if (string-match-p "\\`[ \t]*|[-:]" l) | ||
| 8929 | (progn (setq fmtspec (or fmtspec l)) nil) l)) | ||
| 8930 | (markdown--split-string (buffer-substring begin end) "\n"))) | ||
| 8931 | ;; Split lines in cells | ||
| 8932 | (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) | ||
| 8933 | (remq nil lines))) | ||
| 8934 | ;; Calculate maximum number of cells in a line | ||
| 8935 | (maxcells (if cells | ||
| 8936 | (apply #'max (mapcar #'length cells)) | ||
| 8937 | (user-error "Empty table"))) | ||
| 8938 | ;; Empty cells to fill short lines | ||
| 8939 | (emptycells (make-list maxcells "")) | ||
| 8940 | maxwidths) | ||
| 8941 | ;; Calculate maximum width for each column | ||
| 8942 | (dotimes (i maxcells) | ||
| 8943 | (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) | ||
| 8944 | (push (apply #'max 1 (mapcar #'markdown--string-width column)) | ||
| 8945 | maxwidths))) | ||
| 8946 | (setq maxwidths (nreverse maxwidths)) | ||
| 8947 | ;; Process column format specifier | ||
| 8948 | (setq fmtspec (markdown-table-colfmt fmtspec)) | ||
| 8949 | ;; Compute formats needed for output of table lines | ||
| 8950 | (let ((hfmt (concat indent "|")) | ||
| 8951 | (rfmt (concat indent "|")) | ||
| 8952 | hfmt1 rfmt1 fmt) | ||
| 8953 | (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) | ||
| 8954 | (setq fmt (pop fmtspec)) | ||
| 8955 | (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) | ||
| 8956 | ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) | ||
| 8957 | ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) | ||
| 8958 | (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) | ||
| 8959 | (setq rfmt (concat rfmt (format rfmt1 width))) | ||
| 8960 | (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) | ||
| 8961 | ;; Replace modified lines only | ||
| 8962 | (dolist (line lines) | ||
| 8963 | (let ((line (if line | ||
| 8964 | (apply #'format rfmt (append (pop cells) emptycells)) | ||
| 8965 | hfmt)) | ||
| 8966 | (previous (buffer-substring (point) (line-end-position)))) | ||
| 8967 | (if (equal previous line) | ||
| 8968 | (forward-line) | ||
| 8969 | (insert line "\n") | ||
| 8970 | (delete-region (point) (line-beginning-position 2)))))) | ||
| 8971 | (set-marker end nil))))) | ||
| 8972 | |||
| 8973 | (defun markdown-table-insert-row (&optional arg) | ||
| 8974 | "Insert a new row above the row at point into the table. | ||
| 8975 | With optional argument ARG, insert below the current row." | ||
| 8976 | (interactive "P") | ||
| 8977 | (unless (markdown-table-at-point-p) | ||
| 8978 | (user-error "Not at a table")) | ||
| 8979 | (let* ((line (buffer-substring | ||
| 8980 | (line-beginning-position) (line-end-position))) | ||
| 8981 | (new (markdown-table-blank-line line))) | ||
| 8982 | (beginning-of-line (if arg 2 1)) | ||
| 8983 | (unless (bolp) (insert "\n")) | ||
| 8984 | (insert-before-markers new "\n") | ||
| 8985 | (beginning-of-line 0) | ||
| 8986 | (re-search-forward "| ?" (line-end-position) t))) | ||
| 8987 | |||
| 8988 | (defun markdown-table-delete-row () | ||
| 8989 | "Delete row or horizontal line at point from the table." | ||
| 8990 | (interactive) | ||
| 8991 | (unless (markdown-table-at-point-p) | ||
| 8992 | (user-error "Not at a table")) | ||
| 8993 | (let ((col (current-column))) | ||
| 8994 | (kill-region (point-at-bol) | ||
| 8995 | (min (1+ (point-at-eol)) (point-max))) | ||
| 8996 | (unless (markdown-table-at-point-p) (beginning-of-line 0)) | ||
| 8997 | (move-to-column col))) | ||
| 8998 | |||
| 8999 | (defun markdown-table-move-row (&optional up) | ||
| 9000 | "Move table line at point down. | ||
| 9001 | With optional argument UP, move it up." | ||
| 9002 | (interactive "P") | ||
| 9003 | (unless (markdown-table-at-point-p) | ||
| 9004 | (user-error "Not at a table")) | ||
| 9005 | (let* ((col (current-column)) (pos (point)) | ||
| 9006 | (tonew (if up 0 2)) txt) | ||
| 9007 | (beginning-of-line tonew) | ||
| 9008 | (unless (markdown-table-at-point-p) | ||
| 9009 | (goto-char pos) (user-error "Cannot move row further")) | ||
| 9010 | (goto-char pos) (beginning-of-line 1) (setq pos (point)) | ||
| 9011 | (setq txt (buffer-substring (point) (1+ (point-at-eol)))) | ||
| 9012 | (delete-region (point) (1+ (point-at-eol))) | ||
| 9013 | (beginning-of-line tonew) | ||
| 9014 | (insert txt) (beginning-of-line 0) | ||
| 9015 | (move-to-column col))) | ||
| 9016 | |||
| 9017 | (defun markdown-table-move-row-up () | ||
| 9018 | "Move table row at point up." | ||
| 9019 | (interactive) | ||
| 9020 | (markdown-table-move-row 'up)) | ||
| 9021 | |||
| 9022 | (defun markdown-table-move-row-down () | ||
| 9023 | "Move table row at point down." | ||
| 9024 | (interactive) | ||
| 9025 | (markdown-table-move-row nil)) | ||
| 9026 | |||
| 9027 | (defun markdown-table-insert-column () | ||
| 9028 | "Insert a new table column." | ||
| 9029 | (interactive) | ||
| 9030 | (unless (markdown-table-at-point-p) | ||
| 9031 | (user-error "Not at a table")) | ||
| 9032 | (let* ((col (max 1 (markdown-table-get-column))) | ||
| 9033 | (begin (markdown-table-begin)) | ||
| 9034 | (end (copy-marker (markdown-table-end)))) | ||
| 9035 | (markdown-table-save-cell | ||
| 9036 | (goto-char begin) | ||
| 9037 | (while (< (point) end) | ||
| 9038 | (markdown-table-goto-column col t) | ||
| 9039 | (if (markdown-table-hline-at-point-p) | ||
| 9040 | (insert "|---") | ||
| 9041 | (insert "| ")) | ||
| 9042 | (forward-line))) | ||
| 9043 | (set-marker end nil) | ||
| 9044 | (markdown-table-align))) | ||
| 9045 | |||
| 9046 | (defun markdown-table-delete-column () | ||
| 9047 | "Delete column at point from table." | ||
| 9048 | (interactive) | ||
| 9049 | (unless (markdown-table-at-point-p) | ||
| 9050 | (user-error "Not at a table")) | ||
| 9051 | (let ((col (markdown-table-get-column)) | ||
| 9052 | (begin (markdown-table-begin)) | ||
| 9053 | (end (copy-marker (markdown-table-end)))) | ||
| 9054 | (markdown-table-save-cell | ||
| 9055 | (goto-char begin) | ||
| 9056 | (while (< (point) end) | ||
| 9057 | (markdown-table-goto-column col t) | ||
| 9058 | (and (looking-at "|[^|\n]+|") | ||
| 9059 | (replace-match "|")) | ||
| 9060 | (forward-line))) | ||
| 9061 | (set-marker end nil) | ||
| 9062 | (markdown-table-goto-column (max 1 (1- col))) | ||
| 9063 | (markdown-table-align))) | ||
| 9064 | |||
| 9065 | (defun markdown-table-move-column (&optional left) | ||
| 9066 | "Move table column at point to the right. | ||
| 9067 | With optional argument LEFT, move it to the left." | ||
| 9068 | (interactive "P") | ||
| 9069 | (unless (markdown-table-at-point-p) | ||
| 9070 | (user-error "Not at a table")) | ||
| 9071 | (let* ((col (markdown-table-get-column)) | ||
| 9072 | (col1 (if left (1- col) col)) | ||
| 9073 | (colpos (if left (1- col) (1+ col))) | ||
| 9074 | (begin (markdown-table-begin)) | ||
| 9075 | (end (copy-marker (markdown-table-end)))) | ||
| 9076 | (when (and left (= col 1)) | ||
| 9077 | (user-error "Cannot move column further left")) | ||
| 9078 | (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) | ||
| 9079 | (user-error "Cannot move column further right")) | ||
| 9080 | (markdown-table-save-cell | ||
| 9081 | (goto-char begin) | ||
| 9082 | (while (< (point) end) | ||
| 9083 | (markdown-table-goto-column col1 t) | ||
| 9084 | (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") | ||
| 9085 | (replace-match "|\\2|\\1|")) | ||
| 9086 | (forward-line))) | ||
| 9087 | (set-marker end nil) | ||
| 9088 | (markdown-table-goto-column colpos) | ||
| 9089 | (markdown-table-align))) | ||
| 9090 | |||
| 9091 | (defun markdown-table-move-column-left () | ||
| 9092 | "Move table column at point to the left." | ||
| 9093 | (interactive) | ||
| 9094 | (markdown-table-move-column 'left)) | ||
| 9095 | |||
| 9096 | (defun markdown-table-move-column-right () | ||
| 9097 | "Move table column at point to the right." | ||
| 9098 | (interactive) | ||
| 9099 | (markdown-table-move-column nil)) | ||
| 9100 | |||
| 9101 | (defun markdown-table-next-row () | ||
| 9102 | "Go to the next row (same column) in the table. | ||
| 9103 | Create new table lines if required." | ||
| 9104 | (interactive) | ||
| 9105 | (unless (markdown-table-at-point-p) | ||
| 9106 | (user-error "Not at a table")) | ||
| 9107 | (if (or (looking-at "[ \t]*$") | ||
| 9108 | (save-excursion (skip-chars-backward " \t") (bolp))) | ||
| 9109 | (newline) | ||
| 9110 | (markdown-table-align) | ||
| 9111 | (let ((col (markdown-table-get-column))) | ||
| 9112 | (beginning-of-line 2) | ||
| 9113 | (if (or (not (markdown-table-at-point-p)) | ||
| 9114 | (markdown-table-hline-at-point-p)) | ||
| 9115 | (progn | ||
| 9116 | (beginning-of-line 0) | ||
| 9117 | (markdown-table-insert-row 'below))) | ||
| 9118 | (markdown-table-goto-column col) | ||
| 9119 | (skip-chars-backward "^|\n\r") | ||
| 9120 | (when (looking-at " ") (forward-char 1))))) | ||
| 9121 | |||
| 9122 | (defun markdown-table-forward-cell () | ||
| 9123 | "Go to the next cell in the table. | ||
| 9124 | Create new table lines if required." | ||
| 9125 | (interactive) | ||
| 9126 | (unless (markdown-table-at-point-p) | ||
| 9127 | (user-error "Not at a table")) | ||
| 9128 | (markdown-table-align) | ||
| 9129 | (let ((end (markdown-table-end))) | ||
| 9130 | (when (markdown-table-hline-at-point-p) (end-of-line 1)) | ||
| 9131 | (condition-case nil | ||
| 9132 | (progn | ||
| 9133 | (re-search-forward "\\(?:^\\|[^\\]\\)|" end) | ||
| 9134 | (when (looking-at "[ \t]*$") | ||
| 9135 | (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) | ||
| 9136 | (when (and (looking-at "[-:]") | ||
| 9137 | (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) | ||
| 9138 | (goto-char (match-beginning 1))) | ||
| 9139 | (if (looking-at "[-:]") | ||
| 9140 | (progn | ||
| 9141 | (beginning-of-line 0) | ||
| 9142 | (markdown-table-insert-row 'below)) | ||
| 9143 | (when (looking-at " ") (forward-char 1)))) | ||
| 9144 | (error (markdown-table-insert-row 'below))))) | ||
| 9145 | |||
| 9146 | (defun markdown-table-backward-cell () | ||
| 9147 | "Go to the previous cell in the table." | ||
| 9148 | (interactive) | ||
| 9149 | (unless (markdown-table-at-point-p) | ||
| 9150 | (user-error "Not at a table")) | ||
| 9151 | (markdown-table-align) | ||
| 9152 | (when (markdown-table-hline-at-point-p) (end-of-line 1)) | ||
| 9153 | (condition-case nil | ||
| 9154 | (progn | ||
| 9155 | (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) | ||
| 9156 | (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) | ||
| 9157 | (error (user-error "Cannot move to previous table cell"))) | ||
| 9158 | (while (looking-at "|\\([-:]\\|[ \t]*$\\)") | ||
| 9159 | (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) | ||
| 9160 | (when (looking-at "| ?") (goto-char (match-end 0)))) | ||
| 9161 | |||
| 9162 | (defun markdown-table-transpose () | ||
| 9163 | "Transpose table at point. | ||
| 9164 | Horizontal separator lines will be eliminated." | ||
| 9165 | (interactive) | ||
| 9166 | (unless (markdown-table-at-point-p) | ||
| 9167 | (user-error "Not at a table")) | ||
| 9168 | (let* ((table (buffer-substring-no-properties | ||
| 9169 | (markdown-table-begin) (markdown-table-end))) | ||
| 9170 | ;; Convert table to Lisp structure | ||
| 9171 | (table (delq nil | ||
| 9172 | (mapcar | ||
| 9173 | (lambda (x) | ||
| 9174 | (unless (string-match-p | ||
| 9175 | markdown-table-hline-regexp x) | ||
| 9176 | (markdown--table-line-to-columns x))) | ||
| 9177 | (markdown--split-string table "[ \t]*\n[ \t]*")))) | ||
| 9178 | (dline_old (markdown-table-get-dline)) | ||
| 9179 | (col_old (markdown-table-get-column)) | ||
| 9180 | (contents (mapcar (lambda (_) | ||
| 9181 | (let ((tp table)) | ||
| 9182 | (mapcar | ||
| 9183 | (lambda (_) | ||
| 9184 | (prog1 | ||
| 9185 | (pop (car tp)) | ||
| 9186 | (setq tp (cdr tp)))) | ||
| 9187 | table))) | ||
| 9188 | (car table)))) | ||
| 9189 | (goto-char (markdown-table-begin)) | ||
| 9190 | (save-excursion | ||
| 9191 | (re-search-forward "|") (backward-char) | ||
| 9192 | (delete-region (point) (markdown-table-end)) | ||
| 9193 | (insert (mapconcat | ||
| 9194 | (lambda(x) | ||
| 9195 | (concat "| " (mapconcat 'identity x " | " ) " |\n")) | ||
| 9196 | contents ""))) | ||
| 9197 | (markdown-table-goto-dline col_old) | ||
| 9198 | (markdown-table-goto-column dline_old)) | ||
| 9199 | (markdown-table-align)) | ||
| 9200 | |||
| 9201 | (defun markdown-table-sort-lines (&optional sorting-type) | ||
| 9202 | "Sort table lines according to the column at point. | ||
| 9203 | |||
| 9204 | The position of point indicates the column to be used for | ||
| 9205 | sorting, and the range of lines is the range between the nearest | ||
| 9206 | horizontal separator lines, or the entire table of no such lines | ||
| 9207 | exist. If point is before the first column, user will be prompted | ||
| 9208 | for the sorting column. If there is an active region, the mark | ||
| 9209 | specifies the first line and the sorting column, while point | ||
| 9210 | should be in the last line to be included into the sorting. | ||
| 9211 | |||
| 9212 | The command then prompts for the sorting type which can be | ||
| 9213 | alphabetically or numerically. Sorting in reverse order is also | ||
| 9214 | possible. | ||
| 9215 | |||
| 9216 | If SORTING-TYPE is specified when this function is called from a | ||
| 9217 | Lisp program, no prompting will take place. SORTING-TYPE must be | ||
| 9218 | a character, any of (?a ?A ?n ?N) where the capital letters | ||
| 9219 | indicate that sorting should be done in reverse order." | ||
| 9220 | (interactive) | ||
| 9221 | (unless (markdown-table-at-point-p) | ||
| 9222 | (user-error "Not at a table")) | ||
| 9223 | ;; Set sorting type and column used for sorting | ||
| 9224 | (let ((column (let ((c (markdown-table-get-column))) | ||
| 9225 | (cond ((> c 0) c) | ||
| 9226 | ((called-interactively-p 'any) | ||
| 9227 | (read-number "Use column N for sorting: ")) | ||
| 9228 | (t 1)))) | ||
| 9229 | (sorting-type | ||
| 9230 | (or sorting-type | ||
| 9231 | (read-char-exclusive | ||
| 9232 | "Sort type: [a]lpha [n]umeric (A/N means reversed): ")))) | ||
| 9233 | (save-restriction | ||
| 9234 | ;; Narrow buffer to appropriate sorting area | ||
| 9235 | (if (region-active-p) | ||
| 9236 | (narrow-to-region | ||
| 9237 | (save-excursion | ||
| 9238 | (progn | ||
| 9239 | (goto-char (region-beginning)) (line-beginning-position))) | ||
| 9240 | (save-excursion | ||
| 9241 | (progn | ||
| 9242 | (goto-char (region-end)) (line-end-position)))) | ||
| 9243 | (let ((start (markdown-table-begin)) | ||
| 9244 | (end (markdown-table-end))) | ||
| 9245 | (narrow-to-region | ||
| 9246 | (save-excursion | ||
| 9247 | (if (re-search-backward | ||
| 9248 | markdown-table-hline-regexp start t) | ||
| 9249 | (line-beginning-position 2) | ||
| 9250 | start)) | ||
| 9251 | (if (save-excursion (re-search-forward | ||
| 9252 | markdown-table-hline-regexp end t)) | ||
| 9253 | (match-beginning 0) | ||
| 9254 | end)))) | ||
| 9255 | ;; Determine arguments for `sort-subr' | ||
| 9256 | (let* ((extract-key-from-cell | ||
| 9257 | (cl-case sorting-type | ||
| 9258 | ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) | ||
| 9259 | ((?n ?N) #'string-to-number) | ||
| 9260 | (t (user-error "Invalid sorting type: %c" sorting-type)))) | ||
| 9261 | (predicate | ||
| 9262 | (cl-case sorting-type | ||
| 9263 | ((?n ?N) #'<) | ||
| 9264 | ((?a ?A) #'string<)))) | ||
| 9265 | ;; Sort selected area | ||
| 9266 | (goto-char (point-min)) | ||
| 9267 | (sort-subr (memq sorting-type '(?A ?N)) | ||
| 9268 | (lambda () | ||
| 9269 | (forward-line) | ||
| 9270 | (while (and (not (eobp)) | ||
| 9271 | (not (looking-at | ||
| 9272 | markdown-table-dline-regexp))) | ||
| 9273 | (forward-line))) | ||
| 9274 | #'end-of-line | ||
| 9275 | (lambda () | ||
| 9276 | (funcall extract-key-from-cell | ||
| 9277 | (markdown-table-get-cell column))) | ||
| 9278 | nil | ||
| 9279 | predicate) | ||
| 9280 | (goto-char (point-min)))))) | ||
| 9281 | |||
| 9282 | (defun markdown-table-convert-region (begin end &optional separator) | ||
| 9283 | "Convert region from BEGIN to END to table with SEPARATOR. | ||
| 9284 | |||
| 9285 | If every line contains at least one TAB character, the function | ||
| 9286 | assumes that the material is tab separated (TSV). If every line | ||
| 9287 | contains a comma, comma-separated values (CSV) are assumed. If | ||
| 9288 | not, lines are split at whitespace into cells. | ||
| 9289 | |||
| 9290 | You can use a prefix argument to force a specific separator: | ||
| 9291 | \\[universal-argument] once forces CSV, \\[universal-argument] | ||
| 9292 | twice forces TAB, and \\[universal-argument] three times will | ||
| 9293 | prompt for a regular expression to match the separator, and a | ||
| 9294 | numeric argument N indicates that at least N consecutive | ||
| 9295 | spaces, or alternatively a TAB should be used as the separator." | ||
| 9296 | |||
| 9297 | (interactive "r\nP") | ||
| 9298 | (let* ((begin (min begin end)) (end (max begin end)) re) | ||
| 9299 | (goto-char begin) (beginning-of-line 1) | ||
| 9300 | (setq begin (point-marker)) | ||
| 9301 | (goto-char end) | ||
| 9302 | (if (bolp) (backward-char 1) (end-of-line 1)) | ||
| 9303 | (setq end (point-marker)) | ||
| 9304 | (when (equal separator '(64)) | ||
| 9305 | (setq separator (read-regexp "Regexp for cell separator: "))) | ||
| 9306 | (unless separator | ||
| 9307 | ;; Get the right cell separator | ||
| 9308 | (goto-char begin) | ||
| 9309 | (setq separator | ||
| 9310 | (cond | ||
| 9311 | ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) | ||
| 9312 | ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) | ||
| 9313 | (t 1)))) | ||
| 9314 | (goto-char begin) | ||
| 9315 | (if (equal separator '(4)) | ||
| 9316 | ;; Parse CSV | ||
| 9317 | (while (< (point) end) | ||
| 9318 | (cond | ||
| 9319 | ((looking-at "^") (insert "| ")) | ||
| 9320 | ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) | ||
| 9321 | ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") | ||
| 9322 | (replace-match "\\1") (if (looking-at "\"") (insert "\""))) | ||
| 9323 | ((looking-at "[^,\n]+") (goto-char (match-end 0))) | ||
| 9324 | ((looking-at "[ \t]*,") (replace-match " | ")) | ||
| 9325 | (t (beginning-of-line 2)))) | ||
| 9326 | (setq re | ||
| 9327 | (cond | ||
| 9328 | ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") | ||
| 9329 | ((equal separator '(16)) "^\\|\t") | ||
| 9330 | ((integerp separator) | ||
| 9331 | (if (< separator 1) | ||
| 9332 | (user-error "Cell separator must contain one or more spaces") | ||
| 9333 | (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) | ||
| 9334 | ((stringp separator) (format "^ *\\|%s" separator)) | ||
| 9335 | (t (error "Invalid cell separator")))) | ||
| 9336 | (while (re-search-forward re end t) (replace-match "| " t t))) | ||
| 9337 | (goto-char begin) | ||
| 9338 | (markdown-table-align))) | ||
| 9339 | |||
| 9340 | (defun markdown-insert-table (&optional rows columns align) | ||
| 9341 | "Insert an empty pipe table. | ||
| 9342 | Optional arguments ROWS, COLUMNS, and ALIGN specify number of | ||
| 9343 | rows and columns and the column alignment." | ||
| 9344 | (interactive) | ||
| 9345 | (let* ((rows (or rows (string-to-number (read-string "Row size: ")))) | ||
| 9346 | (columns (or columns (string-to-number (read-string "Column size: ")))) | ||
| 9347 | (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) | ||
| 9348 | (align (cond ((equal align "l") ":--") | ||
| 9349 | ((equal align "r") "--:") | ||
| 9350 | ((equal align "c") ":-:") | ||
| 9351 | (t "---"))) | ||
| 9352 | (pos (point)) | ||
| 9353 | (indent (make-string (current-column) ?\ )) | ||
| 9354 | (line (concat | ||
| 9355 | (apply 'concat indent "|" | ||
| 9356 | (make-list columns " |")) "\n")) | ||
| 9357 | (hline (apply 'concat indent "|" | ||
| 9358 | (make-list columns (concat align "|"))))) | ||
| 9359 | (if (string-match | ||
| 9360 | "^[ \t]*$" (buffer-substring-no-properties | ||
| 9361 | (point-at-bol) (point))) | ||
| 9362 | (beginning-of-line 1) | ||
| 9363 | (newline)) | ||
| 9364 | (dotimes (_ rows) (insert line)) | ||
| 9365 | (goto-char pos) | ||
| 9366 | (if (> rows 1) | ||
| 9367 | (progn | ||
| 9368 | (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) | ||
| 9369 | (markdown-table-forward-cell))) | ||
| 9370 | |||
| 9371 | |||
| 9372 | ;;; ElDoc Support ============================================================= | ||
| 9373 | |||
| 9374 | (defun markdown-eldoc-function () | ||
| 9375 | "Return a helpful string when appropriate based on context. | ||
| 9376 | * Report URL when point is at a hidden URL. | ||
| 9377 | * Report language name when point is a code block with hidden markup." | ||
| 9378 | (cond | ||
| 9379 | ;; Hidden URL or reference for inline link | ||
| 9380 | ((and (or (thing-at-point-looking-at markdown-regex-link-inline) | ||
| 9381 | (thing-at-point-looking-at markdown-regex-link-reference)) | ||
| 9382 | (or markdown-hide-urls markdown-hide-markup)) | ||
| 9383 | (let* ((imagep (string-equal (match-string 1) "!")) | ||
| 9384 | (edit-keys (markdown--substitute-command-keys | ||
| 9385 | (if imagep | ||
| 9386 | "\\[markdown-insert-image]" | ||
| 9387 | "\\[markdown-insert-link]"))) | ||
| 9388 | (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) | ||
| 9389 | (referencep (string-equal (match-string 5) "[")) | ||
| 9390 | (object (if referencep "reference" "URL"))) | ||
| 9391 | (format "Hidden %s (%s to edit): %s" object edit-str | ||
| 9392 | (if referencep | ||
| 9393 | (concat | ||
| 9394 | (propertize "[" 'face 'markdown-markup-face) | ||
| 9395 | (propertize (match-string-no-properties 6) | ||
| 9396 | 'face 'markdown-reference-face) | ||
| 9397 | (propertize "]" 'face 'markdown-markup-face)) | ||
| 9398 | (propertize (match-string-no-properties 6) | ||
| 9399 | 'face 'markdown-url-face))))) | ||
| 9400 | ;; Hidden language name for fenced code blocks | ||
| 9401 | ((and (markdown-code-block-at-point-p) | ||
| 9402 | (not (get-text-property (point) 'markdown-pre)) | ||
| 9403 | markdown-hide-markup) | ||
| 9404 | (let ((lang (save-excursion (markdown-code-block-lang)))) | ||
| 9405 | (unless lang (setq lang "[unspecified]")) | ||
| 9406 | (format "Hidden code block language: %s (%s to toggle markup)" | ||
| 9407 | (propertize lang 'face 'markdown-language-keyword-face) | ||
| 9408 | (markdown--substitute-command-keys | ||
| 9409 | "\\[markdown-toggle-markup-hiding]")))))) | ||
| 9410 | |||
| 9411 | |||
| 9412 | ;;; Mode Definition ========================================================== | ||
| 9413 | |||
| 9414 | (defun markdown-show-version () | ||
| 9415 | "Show the version number in the minibuffer." | ||
| 9416 | (interactive) | ||
| 9417 | (message "markdown-mode, version %s" markdown-mode-version)) | ||
| 9418 | |||
| 9419 | (defun markdown-mode-info () | ||
| 9420 | "Open the `markdown-mode' homepage." | ||
| 9421 | (interactive) | ||
| 9422 | (browse-url "https://jblevins.org/projects/markdown-mode/")) | ||
| 9423 | |||
| 9424 | ;;;###autoload | ||
| 9425 | (define-derived-mode markdown-mode text-mode "Markdown" | ||
| 9426 | "Major mode for editing Markdown files." | ||
| 9427 | ;; Natural Markdown tab width | ||
| 9428 | (setq tab-width 4) | ||
| 9429 | ;; Comments | ||
| 9430 | (setq-local comment-start "<!-- ") | ||
| 9431 | (setq-local comment-end " -->") | ||
| 9432 | (setq-local comment-start-skip "<!--[ \t]*") | ||
| 9433 | (setq-local comment-column 0) | ||
| 9434 | (setq-local comment-auto-fill-only-comments nil) | ||
| 9435 | (setq-local comment-use-syntax t) | ||
| 9436 | ;; Sentence | ||
| 9437 | (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") | ||
| 9438 | ;; Syntax | ||
| 9439 | (add-hook 'syntax-propertize-extend-region-functions | ||
| 9440 | #'markdown-syntax-propertize-extend-region) | ||
| 9441 | (add-hook 'jit-lock-after-change-extend-region-functions | ||
| 9442 | #'markdown-font-lock-extend-region-function t t) | ||
| 9443 | (setq-local syntax-propertize-function #'markdown-syntax-propertize) | ||
| 9444 | (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. | ||
| 9445 | ;; Font lock. | ||
| 9446 | (setq font-lock-defaults | ||
| 9447 | '(markdown-mode-font-lock-keywords | ||
| 9448 | nil nil nil nil | ||
| 9449 | (font-lock-multiline . t) | ||
| 9450 | (font-lock-syntactic-face-function . markdown-syntactic-face) | ||
| 9451 | (font-lock-extra-managed-props | ||
| 9452 | . (composition display invisible rear-nonsticky | ||
| 9453 | keymap help-echo mouse-face)))) | ||
| 9454 | (if markdown-hide-markup | ||
| 9455 | (add-to-invisibility-spec 'markdown-markup) | ||
| 9456 | (remove-from-invisibility-spec 'markdown-markup)) | ||
| 9457 | ;; Wiki links | ||
| 9458 | (markdown-setup-wiki-link-hooks) | ||
| 9459 | ;; Math mode | ||
| 9460 | (when markdown-enable-math (markdown-toggle-math t)) | ||
| 9461 | ;; Add a buffer-local hook to reload after file-local variables are read | ||
| 9462 | (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) | ||
| 9463 | ;; For imenu support | ||
| 9464 | (setq imenu-create-index-function | ||
| 9465 | (if markdown-nested-imenu-heading-index | ||
| 9466 | #'markdown-imenu-create-nested-index | ||
| 9467 | #'markdown-imenu-create-flat-index)) | ||
| 9468 | |||
| 9469 | ;; Defun movement | ||
| 9470 | (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) | ||
| 9471 | (setq-local end-of-defun-function #'markdown-end-of-defun) | ||
| 9472 | ;; Paragraph filling | ||
| 9473 | (setq-local fill-paragraph-function #'markdown-fill-paragraph) | ||
| 9474 | (setq-local paragraph-start | ||
| 9475 | ;; Should match start of lines that start or separate paragraphs | ||
| 9476 | (mapconcat #'identity | ||
| 9477 | '( | ||
| 9478 | "\f" ; starts with a literal line-feed | ||
| 9479 | "[ \t\f]*$" ; space-only line | ||
| 9480 | "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote | ||
| 9481 | "[ \t]*[*+-][ \t]+" ; unordered list item | ||
| 9482 | "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item | ||
| 9483 | "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def | ||
| 9484 | "[ \t]*:[ \t]+" ; definition | ||
| 9485 | "^|" ; table or Pandoc line block | ||
| 9486 | ) | ||
| 9487 | "\\|")) | ||
| 9488 | (setq-local paragraph-separate | ||
| 9489 | ;; Should match lines that separate paragraphs without being | ||
| 9490 | ;; part of any paragraph: | ||
| 9491 | (mapconcat #'identity | ||
| 9492 | '("[ \t\f]*$" ; space-only line | ||
| 9493 | "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote | ||
| 9494 | ;; The following is not ideal, but the Fill customization | ||
| 9495 | ;; options really only handle paragraph-starting prefixes, | ||
| 9496 | ;; not paragraph-ending suffixes: | ||
| 9497 | ".* $" ; line ending in two spaces | ||
| 9498 | "^#+" | ||
| 9499 | "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def | ||
| 9500 | "\\|")) | ||
| 9501 | (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") | ||
| 9502 | (setq-local adaptive-fill-regexp "\\s-*") | ||
| 9503 | (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) | ||
| 9504 | (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) | ||
| 9505 | ;; Outline mode | ||
| 9506 | (setq-local outline-regexp markdown-regex-header) | ||
| 9507 | (setq-local outline-level #'markdown-outline-level) | ||
| 9508 | ;; Cause use of ellipses for invisible text. | ||
| 9509 | (add-to-invisibility-spec '(outline . t)) | ||
| 9510 | ;; ElDoc support | ||
| 9511 | (add-function :before-until (local 'eldoc-documentation-function) | ||
| 9512 | #'markdown-eldoc-function) | ||
| 9513 | ;; Inhibiting line-breaking: | ||
| 9514 | ;; Separating out each condition into a separate function so that users can | ||
| 9515 | ;; override if desired (with remove-hook) | ||
| 9516 | (add-hook 'fill-nobreak-predicate | ||
| 9517 | #'markdown-line-is-reference-definition-p nil t) | ||
| 9518 | (add-hook 'fill-nobreak-predicate | ||
| 9519 | #'markdown-pipe-at-bol-p nil t) | ||
| 9520 | |||
| 9521 | ;; Indentation | ||
| 9522 | (setq-local indent-line-function markdown-indent-function) | ||
| 9523 | (setq-local indent-region-function #'markdown--indent-region) | ||
| 9524 | |||
| 9525 | ;; Flyspell | ||
| 9526 | (setq-local flyspell-generic-check-word-predicate | ||
| 9527 | #'markdown-flyspell-check-word-p) | ||
| 9528 | |||
| 9529 | ;; Electric quoting | ||
| 9530 | (add-hook 'electric-quote-inhibit-functions | ||
| 9531 | #'markdown--inhibit-electric-quote nil :local) | ||
| 9532 | |||
| 9533 | ;; Make checkboxes buttons | ||
| 9534 | (when markdown-make-gfm-checkboxes-buttons | ||
| 9535 | (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) | ||
| 9536 | (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) | ||
| 9537 | (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) | ||
| 9538 | |||
| 9539 | ;; edit-indirect | ||
| 9540 | (add-hook 'edit-indirect-after-commit-functions | ||
| 9541 | #'markdown--edit-indirect-after-commit-function | ||
| 9542 | nil 'local) | ||
| 9543 | |||
| 9544 | ;; Marginalized headings | ||
| 9545 | (when markdown-marginalize-headers | ||
| 9546 | (add-hook 'window-configuration-change-hook | ||
| 9547 | #'markdown-marginalize-update-current nil t)) | ||
| 9548 | |||
| 9549 | ;; add live preview export hook | ||
| 9550 | (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) | ||
| 9551 | (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t)) | ||
| 9552 | |||
| 9553 | ;;;###autoload | ||
| 9554 | (add-to-list 'auto-mode-alist | ||
| 9555 | '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) | ||
| 9556 | |||
| 9557 | |||
| 9558 | ;;; GitHub Flavored Markdown Mode ============================================ | ||
| 9559 | |||
| 9560 | (defun gfm--electric-pair-fence-code-block () | ||
| 9561 | (when (and electric-pair-mode | ||
| 9562 | (not markdown-gfm-use-electric-backquote) | ||
| 9563 | (eql last-command-event ?`) | ||
| 9564 | (let ((count 0)) | ||
| 9565 | (while (eql (char-before (- (point) count)) ?`) | ||
| 9566 | (cl-incf count)) | ||
| 9567 | (= count 3)) | ||
| 9568 | (eql (char-after) ?`)) | ||
| 9569 | (save-excursion (insert (make-string 2 ?`))))) | ||
| 9570 | |||
| 9571 | (defvar gfm-mode-hook nil | ||
| 9572 | "Hook run when entering GFM mode.") | ||
| 9573 | |||
| 9574 | ;;;###autoload | ||
| 9575 | (define-derived-mode gfm-mode markdown-mode "GFM" | ||
| 9576 | "Major mode for editing GitHub Flavored Markdown files." | ||
| 9577 | (setq markdown-link-space-sub-char "-") | ||
| 9578 | (setq markdown-wiki-link-search-subdirectories t) | ||
| 9579 | (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p) | ||
| 9580 | (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) | ||
| 9581 | (markdown-gfm-parse-buffer-for-languages)) | ||
| 9582 | |||
| 9583 | |||
| 9584 | ;;; Viewing modes ============================================================= | ||
| 9585 | |||
| 9586 | (defcustom markdown-hide-markup-in-view-modes t | ||
| 9587 | "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." | ||
| 9588 | :group 'markdown | ||
| 9589 | :type 'boolean | ||
| 9590 | :safe 'booleanp) | ||
| 9591 | |||
| 9592 | (defvar markdown-view-mode-map | ||
| 9593 | (let ((map (make-sparse-keymap))) | ||
| 9594 | (define-key map (kbd "p") #'markdown-outline-previous) | ||
| 9595 | (define-key map (kbd "n") #'markdown-outline-next) | ||
| 9596 | (define-key map (kbd "f") #'markdown-outline-next-same-level) | ||
| 9597 | (define-key map (kbd "b") #'markdown-outline-previous-same-level) | ||
| 9598 | (define-key map (kbd "u") #'markdown-outline-up) | ||
| 9599 | (define-key map (kbd "DEL") #'scroll-down-command) | ||
| 9600 | (define-key map (kbd "SPC") #'scroll-up-command) | ||
| 9601 | (define-key map (kbd ">") #'end-of-buffer) | ||
| 9602 | (define-key map (kbd "<") #'beginning-of-buffer) | ||
| 9603 | (define-key map (kbd "q") #'kill-this-buffer) | ||
| 9604 | (define-key map (kbd "?") #'describe-mode) | ||
| 9605 | map) | ||
| 9606 | "Keymap for `markdown-view-mode'.") | ||
| 9607 | |||
| 9608 | (defun markdown--filter-visible (beg end &optional delete) | ||
| 9609 | (let ((result "") | ||
| 9610 | (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) | ||
| 9611 | (while (< beg end) | ||
| 9612 | (when (markdown--face-p beg invisible-faces) | ||
| 9613 | (cl-incf beg) | ||
| 9614 | (while (and (markdown--face-p beg invisible-faces) (< beg end)) | ||
| 9615 | (cl-incf beg))) | ||
| 9616 | (let ((next (next-single-char-property-change beg 'invisible))) | ||
| 9617 | (unless (get-char-property beg 'invisible) | ||
| 9618 | (setq result (concat result (buffer-substring beg (min end next))))) | ||
| 9619 | (setq beg next))) | ||
| 9620 | (prog1 result | ||
| 9621 | (when delete | ||
| 9622 | (let ((inhibit-read-only t)) | ||
| 9623 | (delete-region beg end)))))) | ||
| 9624 | |||
| 9625 | ;;;###autoload | ||
| 9626 | (define-derived-mode markdown-view-mode markdown-mode "Markdown-View" | ||
| 9627 | "Major mode for viewing Markdown content." | ||
| 9628 | (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) | ||
| 9629 | (add-to-invisibility-spec 'markdown-markup) | ||
| 9630 | (setq-local filter-buffer-substring-function #'markdown--filter-visible) | ||
| 9631 | (read-only-mode 1)) | ||
| 9632 | |||
| 9633 | (defvar gfm-view-mode-map | ||
| 9634 | markdown-view-mode-map | ||
| 9635 | "Keymap for `gfm-view-mode'.") | ||
| 9636 | |||
| 9637 | ;;;###autoload | ||
| 9638 | (define-derived-mode gfm-view-mode gfm-mode "GFM-View" | ||
| 9639 | "Major mode for viewing GitHub Flavored Markdown content." | ||
| 9640 | (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) | ||
| 9641 | (setq-local markdown-fontify-code-blocks-natively t) | ||
| 9642 | (setq-local filter-buffer-substring-function #'markdown--filter-visible) | ||
| 9643 | (add-to-invisibility-spec 'markdown-markup) | ||
| 9644 | (read-only-mode 1)) | ||
| 9645 | |||
| 9646 | |||
| 9647 | ;;; Live Preview Mode ======================================================== | ||
| 9648 | ;;;###autoload | ||
| 9649 | (define-minor-mode markdown-live-preview-mode | ||
| 9650 | "Toggle native previewing on save for a specific markdown file." | ||
| 9651 | :lighter " MD-Preview" | ||
| 9652 | (if markdown-live-preview-mode | ||
| 9653 | (if (markdown-live-preview-get-filename) | ||
| 9654 | (markdown-display-buffer-other-window (markdown-live-preview-export)) | ||
| 9655 | (markdown-live-preview-mode -1) | ||
| 9656 | (user-error "Buffer %s does not visit a file" (current-buffer))) | ||
| 9657 | (markdown-live-preview-remove))) | ||
| 9658 | |||
| 9659 | |||
| 9660 | (provide 'markdown-mode) | ||
| 9661 | |||
| 9662 | ;; Local Variables: | ||
| 9663 | ;; indent-tabs-mode: nil | ||
| 9664 | ;; coding: utf-8 | ||
| 9665 | ;; End: | ||
| 9666 | ;;; markdown-mode.el ends here | ||
