diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/markdown-mode-20180904.1601/markdown-mode.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/markdown-mode-20180904.1601/markdown-mode.el | 9616 |
1 files changed, 0 insertions, 9616 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/markdown-mode-20180904.1601/markdown-mode.el b/configs/shared/emacs/.emacs.d/elpa/markdown-mode-20180904.1601/markdown-mode.el deleted file mode 100644 index 819d202daa2f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/markdown-mode-20180904.1601/markdown-mode.el +++ /dev/null @@ -1,9616 +0,0 @@ -;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- - -;; Copyright (C) 2007-2017 Jason R. Blevins and markdown-mode -;; contributors (see the commit log for details). - -;; Author: Jason R. Blevins <jblevins@xbeta.org> -;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> -;; Created: May 24, 2007 -;; Version: 2.4-dev -;; Package-Version: 20180904.1601 -;; Package-Requires: ((emacs "24.4") (cl-lib "0.5")) -;; Keywords: Markdown, GitHub Flavored Markdown, itex -;; URL: https://jblevins.org/projects/markdown-mode/ - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; See the README.md file for details. - - -;;; Code: - -(require 'easymenu) -(require 'outline) -(require 'thingatpt) -(require 'cl-lib) -(require 'url-parse) -(require 'button) -(require 'color) -(require 'rx) - -(defvar jit-lock-start) -(defvar jit-lock-end) -(defvar flyspell-generic-check-word-predicate) - -(declare-function eww-open-file "eww") -(declare-function url-path-and-query "url-parse") - - -;;; Constants ================================================================= - -(defconst markdown-mode-version "2.4-dev" - "Markdown mode version number.") - -(defconst markdown-output-buffer-name "*markdown-output*" - "Name of temporary buffer for markdown command output.") - - -;;; Global Variables ========================================================== - -(defvar markdown-reference-label-history nil - "History of used reference labels.") - -(defvar markdown-live-preview-mode nil - "Sentinel variable for command `markdown-live-preview-mode'.") - -(defvar markdown-gfm-language-history nil - "History list of languages used in the current buffer in GFM code blocks.") - - -;;; Customizable Variables ==================================================== - -(defvar markdown-mode-hook nil - "Hook run when entering Markdown mode.") - -(defvar markdown-before-export-hook nil - "Hook run before running Markdown to export XHTML output. -The hook may modify the buffer, which will be restored to it's -original state after exporting is complete.") - -(defvar markdown-after-export-hook nil - "Hook run after XHTML output has been saved. -Any changes to the output buffer made by this hook will be saved.") - -(defgroup markdown nil - "Major mode for editing text files in Markdown format." - :prefix "markdown-" - :group 'text - :link '(url-link "https://jblevins.org/projects/markdown-mode/")) - -(defcustom markdown-command "markdown" - "Command to run markdown." - :group 'markdown - :type '(choice (string :tag "Shell command") function)) - -(defcustom markdown-command-needs-filename nil - "Set to non-nil if `markdown-command' does not accept input from stdin. -Instead, it will be passed a filename as the final command line -option. As a result, you will only be able to run Markdown from -buffers which are visiting a file." - :group 'markdown - :type 'boolean) - -(defcustom markdown-open-command nil - "Command used for opening Markdown files directly. -For example, a standalone Markdown previewer. This command will -be called with a single argument: the filename of the current -buffer. It can also be a function, which will be called without -arguments." - :group 'markdown - :type '(choice file function (const :tag "None" nil))) - -(defcustom markdown-hr-strings - '("-------------------------------------------------------------------------------" - "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" - "---------------------------------------" - "* * * * * * * * * * * * * * * * * * * *" - "---------" - "* * * * *") - "Strings to use when inserting horizontal rules. -The first string in the list will be the default when inserting a -horizontal rule. Strings should be listed in decreasing order of -prominence (as in headings from level one to six) for use with -promotion and demotion functions." - :group 'markdown - :type '(repeat string)) - -(defcustom markdown-bold-underscore nil - "Use two underscores when inserting bold text instead of two asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-italic-underscore nil - "Use underscores when inserting italic text instead of asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-marginalize-headers nil - "When non-nil, put opening atx header markup in a left margin. - -This setting goes well with `markdown-asymmetric-header'. But -sadly it conflicts with `linum-mode' since they both use the -same margin." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-marginalize-headers-margin-width 6 - "Character width of margin used for marginalized headers. -The default value is based on there being six heading levels -defined by Markdown and HTML. Increasing this produces extra -whitespace on the left. Decreasing it may be preferred when -fewer than six nested heading levels are used." - :group 'markdown - :type 'natnump - :safe 'natnump - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-asymmetric-header nil - "Determines if atx header style will be asymmetric. -Set to a non-nil value to use asymmetric header styling, placing -header markup only at the beginning of the line. By default, -balanced markup will be inserted at the beginning and end of the -line around the header title." - :group 'markdown - :type 'boolean) - -(defcustom markdown-indent-function 'markdown-indent-line - "Function to use to indent." - :group 'markdown - :type 'function) - -(defcustom markdown-indent-on-enter t - "Determines indentation behavior when pressing \\[newline]. -Possible settings are nil, t, and 'indent-and-new-item. - -When non-nil, pressing \\[newline] will call `newline-and-indent' -to indent the following line according to the context using -`markdown-indent-function'. In this case, note that -\\[electric-newline-and-maybe-indent] can still be used to insert -a newline without indentation. - -When set to 'indent-and-new-item and the point is in a list item -when \\[newline] is pressed, the list will be continued on the next -line, where a new item will be inserted. - -When set to nil, simply call `newline' as usual. In this case, -you can still indent lines using \\[markdown-cycle] and continue -lists with \\[markdown-insert-list-item]. - -Note that this assumes the variable `electric-indent-mode' is -non-nil (enabled). When it is *disabled*, the behavior of -\\[newline] and `\\[electric-newline-and-maybe-indent]' are -reversed." - :group 'markdown - :type '(choice (const :tag "Don't automatically indent" nil) - (const :tag "Automatically indent" t) - (const :tag "Automatically indent and insert new list items" indent-and-new-item))) - -(defcustom markdown-enable-wiki-links nil - "Syntax highlighting for wiki links. -Set this to a non-nil value to turn on wiki link support by default. -Support can be toggled later using the `markdown-toggle-wiki-links' -function or \\[markdown-toggle-wiki-links]." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-alias-first t - "When non-nil, treat aliased wiki links like [[alias text|PageName]]. -Otherwise, they will be treated as [[PageName|alias text]]." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-wiki-link-search-subdirectories nil - "When non-nil, search for wiki link targets in subdirectories. -This is the default search behavior for GitHub and is -automatically set to t in `gfm-mode'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-search-parent-directories nil - "When non-nil, search for wiki link targets in parent directories. -This is the default search behavior of Ikiwiki." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-fontify-missing nil - "When non-nil, change wiki link face according to existence of target files. -This is expensive because it requires checking for the file each time the buffer -changes or the user switches windows. It is disabled by default because it may -cause lag when typing on slower machines." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-uri-types - '("acap" "cid" "data" "dav" "fax" "file" "ftp" - "gopher" "http" "https" "imap" "ldap" "mailto" - "mid" "message" "modem" "news" "nfs" "nntp" - "pop" "prospero" "rtsp" "service" "sip" "tel" - "telnet" "tip" "urn" "vemmi" "wais") - "Link types for syntax highlighting of URIs." - :group 'markdown - :type '(repeat (string :tag "URI scheme"))) - -(defcustom markdown-url-compose-char - '(?∞ ?… ?⋯ ?# ?★ ?⚓) - "Placeholder character for hidden URLs. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :type '(choice - (character :tag "Single URL replacement character") - (repeat :tag "List of possible URL replacement characters" - character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-blockquote-display-char - '("▌" "┃" ">") - "String to display when hiding blockquote markup. -This may be a single string or a list of string. In case of a -list, the first one that satisfies `char-displayable-p' will be -used." - :type 'string - :type '(choice - (string :tag "Single blockquote display string") - (repeat :tag "List of possible blockquote display strings" string)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-hr-display-char - '(?─ ?━ ?-) - "Character for hiding horizontal rule markup. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :group 'markdown - :type '(choice - (character :tag "Single HR display character") - (repeat :tag "List of possible HR display characters" character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-definition-display-char - '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) - "Character for replacing definition list markup. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :type '(choice - (character :tag "Single definition list character") - (repeat :tag "List of possible definition list characters" character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-enable-math nil - "Syntax highlighting for inline LaTeX and itex expressions. -Set this to a non-nil value to turn on math support by default. -Math support can be enabled, disabled, or toggled later using -`markdown-toggle-math' or \\[markdown-toggle-math]." - :group 'markdown - :type 'boolean - :safe 'booleanp) -(make-variable-buffer-local 'markdown-enable-math) - -(defcustom markdown-enable-html t - "Enable font-lock support for HTML tags and attributes." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-css-paths nil - "URL of CSS file to link to in the output XHTML." - :group 'markdown - :type '(repeat (string :tag "CSS File Path"))) - -(defcustom markdown-content-type "text/html" - "Content type string for the http-equiv header in XHTML output. -When set to an empty string, this attribute is omitted. Defaults to -`text/html'." - :group 'markdown - :type 'string) - -(defcustom markdown-coding-system nil - "Character set string for the http-equiv header in XHTML output. -Defaults to `buffer-file-coding-system' (and falling back to -`utf-8' when not available). Common settings are `iso-8859-1' -and `iso-latin-1'. Use `list-coding-systems' for more choices." - :group 'markdown - :type 'coding-system) - -(defcustom markdown-export-kill-buffer t - "Kill output buffer after HTML export. -When non-nil, kill the HTML output buffer after -exporting with `markdown-export'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-header-content "" - "Additional content to include in the XHTML <head> block." - :group 'markdown - :type 'string) - -(defcustom markdown-xhtml-body-preamble "" - "Content to include in the XHTML <body> block, before the output." - :group 'markdown - :type 'string - :safe 'stringp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-body-epilogue "" - "Content to include in the XHTML <body> block, after the output." - :group 'markdown - :type 'string - :safe 'stringp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-standalone-regexp - "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" - "Regexp indicating whether `markdown-command' output is standalone XHTML." - :group 'markdown - :type 'regexp) - -(defcustom markdown-link-space-sub-char "_" - "Character to use instead of spaces when mapping wiki links to filenames." - :group 'markdown - :type 'string) - -(defcustom markdown-reference-location 'header - "Position where new reference definitions are inserted in the document." - :group 'markdown - :type '(choice (const :tag "At the end of the document" end) - (const :tag "Immediately after the current block" immediately) - (const :tag "At the end of the subtree" subtree) - (const :tag "Before next header" header))) - -(defcustom markdown-footnote-location 'end - "Position where new footnotes are inserted in the document." - :group 'markdown - :type '(choice (const :tag "At the end of the document" end) - (const :tag "Immediately after the current block" immediately) - (const :tag "At the end of the subtree" subtree) - (const :tag "Before next header" header))) - -(defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) - "Display specification for footnote markers and inline footnotes. -By default, footnote text is reduced in size and raised. Set to -nil to disable this." - :group 'markdown - :type '(choice (sexp :tag "Display specification") - (const :tag "Don't set display property" nil)) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-sub-superscript-display - '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) - "Display specification for subscript and superscripts. -The car is used for subscript, the cdr is used for superscripts." - :group 'markdown - :type '(cons (choice (sexp :tag "Subscript form") - (const :tag "No lowering" nil)) - (choice (sexp :tag "Superscript form") - (const :tag "No raising" nil))) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-unordered-list-item-prefix " * " - "String inserted before unordered list items." - :group 'markdown - :type 'string) - -(defcustom markdown-nested-imenu-heading-index t - "Use nested or flat imenu heading index. -A nested index may provide more natural browsing from the menu, -but a flat list may allow for faster keyboard navigation via tab -completion." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-add-footnotes-to-imenu t - "Add footnotes to end of imenu heading index." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-make-gfm-checkboxes-buttons t - "When non-nil, make GFM checkboxes into buttons." - :group 'markdown - :type 'boolean) - -(defcustom markdown-use-pandoc-style-yaml-metadata nil - "When non-nil, allow YAML metadata anywhere in the document." - :group 'markdown - :type 'boolean) - -(defcustom markdown-split-window-direction 'any - "Preference for splitting windows for static and live preview. -The default value is 'any, which instructs Emacs to use -`split-window-sensibly' to automatically choose how to split -windows based on the values of `split-width-threshold' and -`split-height-threshold' and the available windows. To force -vertically split (left and right) windows, set this to 'vertical -or 'right. To force horizontally split (top and bottom) windows, -set this to 'horizontal or 'below." - :group 'markdown - :type '(choice (const :tag "Automatic" any) - (const :tag "Right (vertical)" right) - (const :tag "Below (horizontal)" below)) - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-live-preview-window-function - 'markdown-live-preview-window-eww - "Function to display preview of Markdown output within Emacs. -Function must update the buffer containing the preview and return -the buffer." - :group 'markdown - :type 'function) - -(defcustom markdown-live-preview-delete-export 'delete-on-destroy - "Delete exported HTML file when using `markdown-live-preview-export'. -If set to 'delete-on-export, delete on every export. When set to -'delete-on-destroy delete when quitting from command -`markdown-live-preview-mode'. Never delete if set to nil." - :group 'markdown - :type '(choice - (const :tag "Delete on every export" delete-on-export) - (const :tag "Delete when quitting live preview" delete-on-destroy) - (const :tag "Never delete" nil))) - -(defcustom markdown-list-indent-width 4 - "Depth of indentation for markdown lists. -Used in `markdown-demote-list-item' and -`markdown-promote-list-item'." - :group 'markdown - :type 'integer) - -(defcustom markdown-enable-prefix-prompts t - "Display prompts for certain prefix commands. -Set to nil to disable these prompts." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-gfm-additional-languages nil - "Extra languages made available when inserting GFM code blocks. -Language strings must have be trimmed of whitespace and not -contain any curly braces. They may be of arbitrary -capitalization, though." - :group 'markdown - :type '(repeat (string :validate markdown-validate-language-string))) - -(defcustom markdown-gfm-use-electric-backquote t - "Use `markdown-electric-backquote' when backquote is hit three times." - :group 'markdown - :type 'boolean) - -(defcustom markdown-gfm-downcase-languages t - "If non-nil, downcase suggested languages. -This applies to insertions done with -`markdown-electric-backquote'." - :group 'markdown - :type 'boolean) - -(defcustom markdown-edit-code-block-default-mode 'normal-mode - "Default mode to use for editing code blocks. -This mode is used when automatic detection fails, such as for GFM -code blocks with no language specified." - :group 'markdown - :type '(choice function (const :tag "None" nil)) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-gfm-uppercase-checkbox nil - "If non-nil, use [X] for completed checkboxes, [x] otherwise." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-hide-urls nil - "Hide URLs of inline links and reference tags of reference links. -Such URLs will be replaced by a single customizable -character, defined by `markdown-url-compose-char', but are still part -of the buffer. Links can be edited interactively with -\\[markdown-insert-link] or, for example, by deleting the final -parenthesis to remove the invisibility property. You can also -hover your mouse pointer over the link text to see the URL. -Set this to a non-nil value to turn this feature on by default. -You can interactively set the value of this variable by calling -`markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], -or from the menu Markdown > Links & Images menu." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) -(make-variable-buffer-local 'markdown-hide-urls) - -(defcustom markdown-translate-filename-function #'identity - "Function to use to translate filenames when following links. -\\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] -call this function with the filename as only argument whenever -they encounter a filename (instead of a URL) to be visited and -use its return value instead of the filename in the link. For -example, if absolute filenames are actually relative to a server -root directory, you can set -`markdown-translate-filename-function' to a function that -prepends the root directory to the given filename." - :group 'markdown - :type 'function - :risky t - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-max-image-size nil - "Maximum width and height for displayed inline images. -This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). -When nil, use the actual size. Otherwise, use ImageMagick to -resize larger images to be of the given maximum dimensions. This -requires Emacs to be built with ImageMagick support." - :group 'markdown - :package-version '(markdown-mode . "2.4") - :type '(choice - (const :tag "Use actual image width" nil) - (cons (choice (sexp :tag "Maximum width in pixels") - (const :tag "No maximum width" nil)) - (choice (sexp :tag "Maximum height in pixels") - (const :tag "No maximum height" nil))))) - - -;;; Markdown-Specific `rx' Macro - -;; Based on python-rx from python.el. -(eval-and-compile - (defconst markdown-rx-constituents - `((newline . ,(rx "\n")) - (indent . ,(rx (or (repeat 4 " ") "\t"))) - (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end)))) - (numeral . ,(rx (and (one-or-more (any "0-9#")) "."))) - (bullet . ,(rx (any "*+:-"))) - (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".") - (any "*+:-")))) - (checkbox . ,(rx "[" (any " xX") "]"))) - "Markdown-specific sexps for `markdown-rx'") - - (defun markdown-rx-to-string (form &optional no-group) - "Markdown mode specialized `rx-to-string' function. -This variant supports named Markdown expressions in FORM. -NO-GROUP non-nil means don't put shy groups around the result." - (let ((rx-constituents (append markdown-rx-constituents rx-constituents))) - (rx-to-string form no-group))) - - (defmacro markdown-rx (&rest regexps) - "Markdown mode specialized rx macro. -This variant of `rx' supports common Markdown named REGEXPS." - (cond ((null regexps) - (error "No regexp")) - ((cdr regexps) - (markdown-rx-to-string `(and ,@regexps) t)) - (t - (markdown-rx-to-string (car regexps) t))))) - - -;;; Regular Expressions ======================================================= - -(defconst markdown-regex-comment-start - "<!--" - "Regular expression matches HTML comment opening.") - -(defconst markdown-regex-comment-end - "--[ \t]*>" - "Regular expression matches HTML comment closing.") - -(defconst markdown-regex-link-inline - "\\(!\\)?\\(\\[\\)\\([^]^][^]]*\\|\\)\\(\\]\\)\\((\\)\\([^)]*?\\)\\(?:\\s-+\\(\"[^\"]*\"\\)\\)?\\()\\)" - "Regular expression for a [text](file) or an image link . -Group 1 matches the leading exclamation point (optional). -Group 2 matches the opening square bracket. -Group 3 matches the text inside the square brackets. -Group 4 matches the closing square bracket. -Group 5 matches the opening parenthesis. -Group 6 matches the URL. -Group 7 matches the title (optional). -Group 8 matches the closing parenthesis.") - -(defconst markdown-regex-link-reference - "\\(!\\)?\\(\\[\\)\\([^]^][^]]*\\|\\)\\(\\]\\)[ ]?\\(\\[\\)\\([^]]*?\\)\\(\\]\\)" - "Regular expression for a reference link [text][id]. -Group 1 matches the leading exclamation point (optional). -Group 2 matches the opening square bracket for the link text. -Group 3 matches the text inside the square brackets. -Group 4 matches the closing square bracket for the link text. -Group 5 matches the opening square bracket for the reference label. -Group 6 matches the reference label. -Group 7 matches the closing square bracket for the reference label.") - -(defconst markdown-regex-reference-definition - "^ \\{0,3\\}\\(\\[\\)\\([^]\n]+?\\)\\(\\]\\)\\(:\\)\\s *\\(.*?\\)\\s *\\( \"[^\"]*\"$\\|$\\)" - "Regular expression for a reference definition. -Group 1 matches the opening square bracket. -Group 2 matches the reference label. -Group 3 matches the closing square bracket. -Group 4 matches the colon. -Group 5 matches the URL. -Group 6 matches the title attribute (optional).") - -(defconst markdown-regex-footnote - "\\(\\[\\^\\)\\(.+?\\)\\(\\]\\)" - "Regular expression for a footnote marker [^fn]. -Group 1 matches the opening square bracket and carat. -Group 2 matches only the label, without the surrounding markup. -Group 3 matches the closing square bracket.") - -(defconst markdown-regex-header - "^\\(?:\\([^\r\n\t -].*\\)\n\\(?:\\(=+\\)\\|\\(-+\\)\\)\\|\\(#+[ \t]+\\)\\(.*?\\)\\([ \t]*#*\\)\\)$" - "Regexp identifying Markdown headings. -Group 1 matches the text of a setext heading. -Group 2 matches the underline of a level-1 setext heading. -Group 3 matches the underline of a level-2 setext heading. -Group 4 matches the opening hash marks of an atx heading and whitespace. -Group 5 matches the text, without surrounding whitespace, of an atx heading. -Group 6 matches the closing whitespace and hash marks of an atx heading.") - -(defconst markdown-regex-header-setext - "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" - "Regular expression for generic setext-style (underline) headers.") - -(defconst markdown-regex-header-atx - "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" - "Regular expression for generic atx-style (hash mark) headers.") - -(defconst markdown-regex-hr - (rx line-start - (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) - (and (repeat 3 (and "-" (? " "))) (* (any "- "))) - (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) - line-end) - "Regular expression for matching Markdown horizontal rules.") - -(defconst markdown-regex-code - "\\(?:\\`\\|[^\\]\\)\\(\\(`+\\)\\(\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(\\2\\)\\)\\(?:[^`]\\|\\'\\)" - "Regular expression for matching inline code fragments. - -Group 1 matches the entire code fragment including the backquotes. -Group 2 matches the opening backquotes. -Group 3 matches the code fragment itself, without backquotes. -Group 4 matches the closing backquotes. - -The leading, unnumbered group ensures that the leading backquote -character is not escaped. -The last group, also unnumbered, requires that the character -following the code fragment is not a backquote. -Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, -but not two newlines in a row.") - -(defconst markdown-regex-kbd - "\\(<kbd>\\)\\(\\(?:.\\|\n[^\n]\\)*?\\)\\(</kbd>\\)" - "Regular expression for matching <kbd> tags. -Groups 1 and 3 match the opening and closing tags. -Group 2 matches the key sequence.") - -(defconst markdown-regex-gfm-code-block-open - "^[[:blank:]]*\\(```\\)\\([[:blank:]]*{?[[:blank:]]*\\)\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$" - "Regular expression matching opening of GFM code blocks. -Group 1 matches the opening three backquotes and any following whitespace. -Group 2 matches the opening brace (optional) and surrounding whitespace. -Group 3 matches the language identifier (optional). -Group 4 matches the info string (optional). -Group 5 matches the closing brace (optional), whitespace, and newline. -Groups need to agree with `markdown-regex-tilde-fence-begin'.") - -(defconst markdown-regex-gfm-code-block-close - "^[[:blank:]]*\\(```\\)\\(\\s *?\\)$" - "Regular expression matching closing of GFM code blocks. -Group 1 matches the closing three backquotes. -Group 2 matches any whitespace and the final newline.") - -(defconst markdown-regex-pre - "^\\( \\|\t\\).*$" - "Regular expression for matching preformatted text sections.") - -(defconst markdown-regex-list - (markdown-rx line-start - ;; 1. Leading whitespace - (group (* blank)) - ;; 2. List marker: a numeral, bullet, or colon - (group list-marker) - ;; 3. Trailing whitespace - (group (+ blank)) - ;; 4. Optional checkbox for GFM task list items - (opt (group (and checkbox (* blank))))) - "Regular expression for matching list items.") - -(defconst markdown-regex-bold - "\\(^\\|[^\\]\\)\\(\\([*_]\\{2\\}\\)\\([^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(\\3\\)\\)" - "Regular expression for matching bold text. -Group 1 matches the character before the opening asterisk or -underscore, if any, ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - -(defconst markdown-regex-italic - "\\(?:^\\|[^\\]\\)\\(\\([*_]\\)\\([^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(\\2\\)\\)" - "Regular expression for matching italic text. -The leading unnumbered matches the character before the opening -asterisk or underscore, if any, ensuring that it is not a -backslash escape. -Group 1 matches the entire expression, including delimiters. -Groups 2 and 4 matches the opening and closing delimiters. -Group 3 matches the text inside the delimiters.") - -(defconst markdown-regex-strike-through - "\\(^\\|[^\\]\\)\\(\\(~~\\)\\([^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(~~\\)\\)" - "Regular expression for matching strike-through text. -Group 1 matches the character before the opening tilde, if any, -ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - -(defconst markdown-regex-gfm-italic - "\\(?:^\\|\\s-\\)\\(\\([*_]\\)\\([^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(\\2\\)\\)" - "Regular expression for matching italic text in GitHub Flavored Markdown. -Underscores in words are not treated as special. -Group 1 matches the entire expression, including delimiters. -Groups 2 and 4 matches the opening and closing delimiters. -Group 3 matches the text inside the delimiters.") - -(defconst markdown-regex-blockquote - "^[ \t]*\\([A-Z]?>\\)\\([ \t]*\\)\\(.*\\)$" - "Regular expression for matching blockquote lines. -Also accounts for a potential capital letter preceding the angle -bracket, for use with Leanpub blocks (asides, warnings, info -blocks, etc.). -Group 1 matches the leading angle bracket. -Group 2 matches the separating whitespace. -Group 3 matches the text.") - -(defconst markdown-regex-line-break - "[^ \n\t][ \t]*\\( \\)$" - "Regular expression for matching line breaks.") - -(defconst markdown-regex-wiki-link - "\\(?:^\\|[^\\]\\)\\(\\(\\[\\[\\)\\([^]|]+\\)\\(?:\\(|\\)\\([^]]+\\)\\)?\\(\\]\\]\\)\\)" - "Regular expression for matching wiki links. -This matches typical bracketed [[WikiLinks]] as well as 'aliased' -wiki links of the form [[PageName|link text]]. -The meanings of the first and second components depend -on the value of `markdown-wiki-link-alias-first'. - -Group 1 matches the entire link. -Group 2 matches the opening square brackets. -Group 3 matches the first component of the wiki link. -Group 4 matches the pipe separator, when present. -Group 5 matches the second component of the wiki link, when present. -Group 6 matches the closing square brackets.") - -(defconst markdown-regex-uri - (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;() ]+\\)") - "Regular expression for matching inline URIs.") - -(defconst markdown-regex-angle-uri - (concat "\\(<\\)\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>,;()]+\\)\\(>\\)") - "Regular expression for matching inline URIs in angle brackets.") - -(defconst markdown-regex-email - "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" - "Regular expression for matching inline email addresses.") - -(defsubst markdown-make-regex-link-generic () - "Make regular expression for matching any recognized link." - (concat "\\(?:" markdown-regex-link-inline - (when markdown-enable-wiki-links - (concat "\\|" markdown-regex-wiki-link)) - "\\|" markdown-regex-link-reference - "\\|" markdown-regex-angle-uri "\\)")) - -(defconst markdown-regex-gfm-checkbox - " \\(\\[[ xX]\\]\\) " - "Regular expression for matching GFM checkboxes. -Group 1 matches the text to become a button.") - -(defconst markdown-regex-blank-line - "^[[:blank:]]*$" - "Regular expression that matches a blank line.") - -(defconst markdown-regex-block-separator - "\n[\n\t\f ]*\n" - "Regular expression for matching block boundaries.") - -(defconst markdown-regex-block-separator-noindent - (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") - "Regexp for block separators before lines with no indentation.") - -(defconst markdown-regex-math-inline-single - "\\(?:^\\|[^\\]\\)\\(\\$\\)\\(\\(?:[^\\$]\\|\\\\.\\)*\\)\\(\\$\\)" - "Regular expression for itex $..$ math mode expressions. -Groups 1 and 3 match the opening and closing dollar signs. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-inline-double - "\\(?:^\\|[^\\]\\)\\(\\$\\$\\)\\(\\(?:[^\\$]\\|\\\\.\\)*\\)\\(\\$\\$\\)" - "Regular expression for itex $$..$$ math mode expressions. -Groups 1 and 3 match opening and closing dollar signs. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-display - (rx line-start (* blank) - (group (group (repeat 1 2 "\\")) "[") - (group (*? anything)) - (group (backref 2) "]") - line-end) - "Regular expression for \[..\] or \\[..\\] display math. -Groups 1 and 4 match the opening and closing markup. -Group 3 matches the mathematical expression contained within. -Group 2 matches the opening slashes, and is used internally to -match the closing slashes.") - -(defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) - "Return regexp matching a tilde code fence at least NUM-TILDES long. -END-OF-LINE is the regexp construct to indicate end of line; $ if -missing." - (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" - (or end-of-line "$"))) - -(defconst markdown-regex-tilde-fence-begin - (markdown-make-tilde-fence-regex - 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") - "Regular expression for matching tilde-fenced code blocks. -Group 1 matches the opening tildes. -Group 2 matches (optional) opening brace and surrounding whitespace. -Group 3 matches the language identifier (optional). -Group 4 matches the info string (optional). -Group 5 matches the closing brace (optional) and any surrounding whitespace. -Groups need to agree with `markdown-regex-gfm-code-block-open'.") - -(defconst markdown-regex-declarative-metadata - "^\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" - "Regular expression for matching declarative metadata statements. -This matches MultiMarkdown metadata as well as YAML and TOML -assignments such as the following: - - variable: value - -or - - variable = value") - -(defconst markdown-regex-pandoc-metadata - "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" - "Regular expression for matching Pandoc metadata.") - -(defconst markdown-regex-yaml-metadata-border - "\\(-\\{3\\}\\)$" - "Regular expression for matching YAML metadata.") - -(defconst markdown-regex-yaml-pandoc-metadata-end-border - "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" - "Regular expression for matching YAML metadata end borders.") - -(defsubst markdown-get-yaml-metadata-start-border () - "Return YAML metadata start border depending upon whether Pandoc is used." - (concat - (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") - markdown-regex-yaml-metadata-border)) - -(defsubst markdown-get-yaml-metadata-end-border (_) - "Return YAML metadata end border depending upon whether Pandoc is used." - (if markdown-use-pandoc-style-yaml-metadata - markdown-regex-yaml-pandoc-metadata-end-border - markdown-regex-yaml-metadata-border)) - -(defconst markdown-regex-inline-attributes - "[ \t]*\\({:?\\)[ \t]*\\(\\(#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"]*['\"]?\\),?[ \t]*\\)+\\(}\\)[ \t]*$" - "Regular expression for matching inline identifiers or attribute lists. -Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") - -(defconst markdown-regex-leanpub-sections - (concat - "^\\({\\)\\(" - (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) - "\\)\\(}\\)[ \t]*\n") - "Regular expression for Leanpub section markers and related syntax.") - -(defconst markdown-regex-sub-superscript - "\\(?:^\\|[^\\~^]\\)\\(\\([~^]\\)\\([[:alnum:]]+\\)\\(\\2\\)\\)" - "The regular expression matching a sub- or superscript. -The leading un-numbered group matches the character before the -opening tilde or carat, if any, ensuring that it is not a -backslash escape, carat, or tilde. -Group 1 matches the entire expression, including markup. -Group 2 matches the opening markup--a tilde or carat. -Group 3 matches the text inside the delimiters. -Group 4 matches the closing markup--a tilde or carat.") - -(defconst markdown-regex-include - "^\\(<<\\)\\(?:\\(\\[\\)\\(.*\\)\\(\\]\\)\\)?\\(?:\\((\\)\\(.*\\)\\()\\)\\)?\\(?:\\({\\)\\(.*\\)\\(}\\)\\)?$" - "Regular expression matching common forms of include syntax. -Marked 2, Leanpub, and other processors support some of these forms: - -<<[sections/section1.md] -<<(folder/filename) -<<[Code title](folder/filename) -<<{folder/raw_file.html} - -Group 1 matches the opening two angle brackets. -Groups 2-4 match the opening square bracket, the text inside, -and the closing square bracket, respectively. -Groups 5-7 match the opening parenthesis, the text inside, and -the closing parenthesis. -Groups 8-10 match the opening brace, the text inside, and the brace.") - -(defconst markdown-regex-pandoc-inline-footnote - "\\(\\^\\)\\(\\[\\)\\(\\(?:.\\|\n[^\n]\\)*?\\)\\(\\]\\)" - "Regular expression for Pandoc inline footnote^[footnote text]. -Group 1 matches the opening caret. -Group 2 matches the opening square bracket. -Group 3 matches the footnote text, without the surrounding markup. -Group 4 matches the closing square bracket.") - -(defconst markdown-regex-html-attr - "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" - "Regular expression for matching HTML attributes and values. -Group 1 matches the attribute name. -Group 2 matches the following whitespace, equals sign, and value, if any. -Group 3 matches the equals sign, if any. -Group 4 matches single-, double-, or un-quoted attribute values.") - -(defconst markdown-regex-html-tag - (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr - "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") - "Regular expression for matching HTML tags. -Groups 1 and 9 match the beginning and ending angle brackets and slashes. -Group 2 matches the tag name. -Group 3 matches all attributes and whitespace following the tag name.") - -(defconst markdown-regex-html-entity - "\\(&#?[[:alnum:]]+;\\)" - "Regular expression for matching HTML entities.") - - -;;; Syntax ==================================================================== - -(defvar markdown--syntax-properties - (list 'markdown-tilde-fence-begin nil - 'markdown-tilde-fence-end nil - 'markdown-fenced-code nil - 'markdown-yaml-metadata-begin nil - 'markdown-yaml-metadata-end nil - 'markdown-yaml-metadata-section nil - 'markdown-gfm-block-begin nil - 'markdown-gfm-block-end nil - 'markdown-gfm-code nil - 'markdown-list-item nil - 'markdown-pre nil - 'markdown-blockquote nil - 'markdown-hr nil - 'markdown-comment nil - 'markdown-heading nil - 'markdown-heading-1-setext nil - 'markdown-heading-2-setext nil - 'markdown-heading-1-atx nil - 'markdown-heading-2-atx nil - 'markdown-heading-3-atx nil - 'markdown-heading-4-atx nil - 'markdown-heading-5-atx nil - 'markdown-heading-6-atx nil - 'markdown-metadata-key nil - 'markdown-metadata-value nil - 'markdown-metadata-markup nil) - "Property list of all Markdown syntactic properties.") - -(defsubst markdown-in-comment-p (&optional pos) - "Return non-nil if POS is in a comment. -If POS is not given, use point instead." - (get-text-property (or pos (point)) 'markdown-comment)) - -(defun markdown-syntax-propertize-extend-region (start end) - "Extend START to END region to include an entire block of text. -This helps improve syntax analysis for block constructs. -Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. -Function is called repeatedly until it returns nil. For details, see -`syntax-propertize-extend-region-functions'." - (save-match-data - (save-excursion - (let* ((new-start (progn (goto-char start) - (skip-chars-forward "\n") - (if (re-search-backward "\n\n" nil t) - (min start (match-end 0)) - (point-min)))) - (new-end (progn (goto-char end) - (skip-chars-backward "\n") - (if (re-search-forward "\n\n" nil t) - (max end (match-beginning 0)) - (point-max)))) - (code-match (markdown-code-block-at-pos new-start)) - (new-start (or (and code-match (cl-first code-match)) new-start)) - (code-match (and (< end (point-max)) (markdown-code-block-at-pos end))) - (new-end (or (and code-match (cl-second code-match)) new-end))) - (unless (and (eq new-start start) (eq new-end end)) - (cons new-start (min new-end (point-max)))))))) - -(defun markdown-font-lock-extend-region-function (start end _) - "Used in `jit-lock-after-change-extend-region-functions'. -Delegates to `markdown-syntax-propertize-extend-region'. START -and END are the previous region to refontify." - (let ((res (markdown-syntax-propertize-extend-region start end))) - (when res - ;; syntax-propertize-function is not called when character at - ;; (point-max) is deleted, but font-lock-extend-region-functions - ;; are called. Force a syntax property update in that case. - (when (= end (point-max)) - ;; This function is called in a buffer modification hook. - ;; `markdown-syntax-propertize' doesn't save the match data, - ;; so we have to do it here. - (save-match-data - (markdown-syntax-propertize (car res) (cdr res)))) - (setq jit-lock-start (car res) - jit-lock-end (cdr res))))) - -(defun markdown--cur-list-item-bounds () - "Return a list describing the list item at point. -Assumes that match data is set for `markdown-regex-list'. See the -documentation for `markdown-cur-list-item-bounds' for the format of -the returned list." - (save-excursion - (let* ((begin (match-beginning 0)) - (indent (length (match-string-no-properties 1))) - (nonlist-indent (- (match-end 3) (match-beginning 0))) - (marker (buffer-substring-no-properties - (match-beginning 2) (match-end 3))) - (checkbox (match-string-no-properties 4)) - (match (butlast (match-data t))) - (end (markdown-cur-list-item-end nonlist-indent))) - (list begin end indent nonlist-indent marker checkbox match)))) - -(defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) - "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. -Here, MARKER is a string representing the type of list and INDENT -is an integer giving the indentation, in spaces, of the current -block. CUR-BOUNDS is a list of the form returned by -`markdown-cur-list-item-bounds' and BOUNDS is a list of bounds -values for parent list items. When BOUNDS is nil, it means we are -at baseline (not inside of a nested list)." - (let ((prev-indent (or (cl-third (car bounds)) 0))) - (cond - ;; New list item at baseline. - ((and marker (null bounds)) - (list cur-bounds)) - ;; List item with greater indentation (four or more spaces). - ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. - ((and marker (>= indent (+ prev-indent 4))) - (cons cur-bounds bounds)) - ;; List item with greater or equal indentation (less than four spaces). - ;; Keep list level the same by replacing the car of BOUNDS. - ((and marker (>= indent prev-indent)) - (cons cur-bounds (cdr bounds))) - ;; Lesser indentation level. - ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser - ;; indentation could move back more than one list level). Note - ;; that this block need not be the beginning of list item. - ((< indent prev-indent) - (while (and (> (length bounds) 1) - (setq prev-indent (cl-third (cadr bounds))) - (< indent (+ prev-indent 4))) - (setq bounds (cdr bounds))) - (cons cur-bounds bounds)) - ;; Otherwise, do nothing. - (t bounds)))) - -(defun markdown-syntax-propertize-list-items (start end) - "Propertize list items from START to END. -Stores nested list item information in the `markdown-list-item' -text property to make later syntax analysis easier. The value of -this property is a list with elements of the form (begin . end) -giving the bounds of the current and parent list items." - (save-excursion - (goto-char start) - (let (bounds level pre-regexp) - ;; Find a baseline point with zero list indentation - (markdown-search-backward-baseline) - ;; Search for all list items between baseline and END - (while (and (< (point) end) - (re-search-forward markdown-regex-list end 'limit)) - ;; Level of list nesting - (setq level (length bounds)) - ;; Pre blocks need to be indented one level past the list level - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) - (beginning-of-line) - (cond - ;; Reset at headings, horizontal rules, and top-level blank lines. - ;; Propertize baseline when in range. - ((markdown-new-baseline) - (setq bounds nil)) - ;; Make sure this is not a line from a pre block - ((looking-at-p pre-regexp)) - ;; If not, then update levels and propertize list item when in range. - (t - (let* ((indent (current-indentation)) - (cur-bounds (markdown--cur-list-item-bounds)) - (first (cl-first cur-bounds)) - (last (cl-second cur-bounds)) - (marker (cl-fifth cur-bounds))) - (setq bounds (markdown--append-list-item-bounds - marker indent cur-bounds bounds)) - (when (and (<= start (point)) (<= (point) end)) - (put-text-property first last 'markdown-list-item bounds))))) - (end-of-line))))) - -(defun markdown-syntax-propertize-pre-blocks (start end) - "Match preformatted text blocks from START to END." - (save-excursion - (goto-char start) - (let ((levels (markdown-calculate-list-levels)) - indent pre-regexp close-regexp open close) - (while (and (< (point) end) (not close)) - ;; Search for a region with sufficient indentation - (if (null levels) - (setq indent 1) - (setq indent (1+ (length levels)))) - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) - (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) - - (cond - ;; If not at the beginning of a line, move forward - ((not (bolp)) (forward-line)) - ;; Move past blank lines - ((markdown-cur-line-blank-p) (forward-line)) - ;; At headers and horizontal rules, reset levels - ((markdown-new-baseline) (forward-line) (setq levels nil)) - ;; If the current line has sufficient indentation, mark out pre block - ;; The opening should be preceded by a blank line. - ((and (markdown-prev-line-blank) (looking-at pre-regexp)) - (setq open (match-beginning 0)) - (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) - (not (eobp))) - (forward-line)) - (skip-syntax-backward "-") - (setq close (point))) - ;; If current line has a list marker, update levels, move to end of block - ((looking-at markdown-regex-list) - (setq levels (markdown-update-list-levels - (match-string 2) (current-indentation) levels)) - (markdown-end-of-text-block)) - ;; If this is the end of the indentation level, adjust levels accordingly. - ;; Only match end of indentation level if levels is not the empty list. - ((and (car levels) (looking-at-p close-regexp)) - (setq levels (markdown-update-list-levels - nil (current-indentation) levels)) - (markdown-end-of-text-block)) - (t (markdown-end-of-text-block)))) - - (when (and open close) - ;; Set text property data - (put-text-property open close 'markdown-pre (list open close)) - ;; Recursively search again - (markdown-syntax-propertize-pre-blocks (point) end))))) - -(defconst markdown-fenced-block-pairs - `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) - (markdown-make-tilde-fence-regex markdown-tilde-fence-end) - markdown-fenced-code) - ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) - (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) - markdown-yaml-metadata-section) - ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) - (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) - markdown-gfm-code)) - "Mapping of regular expressions to \"fenced-block\" constructs. -These constructs are distinguished by having a distinctive start -and end pattern, both of which take up an entire line of text, -but no special pattern to identify text within the fenced -blocks (unlike blockquotes and indented-code sections). - -Each element within this list takes the form: - - ((START-REGEX-OR-FUN START-PROPERTY) - (END-REGEX-OR-FUN END-PROPERTY) - MIDDLE-PROPERTY) - -Each *-REGEX-OR-FUN element can be a regular expression as a string, or a -function which evaluates to same. Functions for START-REGEX-OR-FUN accept no -arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument -which is the length of the first group of the START-REGEX-OR-FUN match, which -can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to -evaluate these into \"real\" regexps. - -The *-PROPERTY elements are the text properties applied to each part of the -block construct when it is matched using -`markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied -to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and -MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the -`match-data' when the regexp was matched to the text. In the case of -MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with -begin and end set to the edges of the \"middle\" text. This makes fontification -easier.") - -(defun markdown-text-property-at-point (prop) - (get-text-property (point) prop)) - -(defsubst markdown-maybe-funcall-regexp (object &optional arg) - (cond ((functionp object) - (if arg (funcall object arg) (funcall object))) - ((stringp object) object) - (t (error "Object cannot be turned into regex")))) - -(defsubst markdown-get-start-fence-regexp () - "Return regexp to find all \"start\" sections of fenced block constructs. -Which construct is actually contained in the match must be found separately." - (mapconcat - #'identity - (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) - markdown-fenced-block-pairs) - "\\|")) - -(defun markdown-get-fenced-block-begin-properties () - (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) - -(defun markdown-get-fenced-block-end-properties () - (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) - -(defun markdown-get-fenced-block-middle-properties () - (cl-mapcar #'cl-third markdown-fenced-block-pairs)) - -(defun markdown-find-previous-prop (prop &optional lim) - "Find previous place where property PROP is non-nil, up to LIM. -Return a cons of (pos . property). pos is point if point contains -non-nil PROP." - (let ((res - (if (get-text-property (point) prop) (point) - (previous-single-property-change - (point) prop nil (or lim (point-min)))))) - (when (and (not (get-text-property res prop)) - (> res (point-min)) - (get-text-property (1- res) prop)) - (cl-decf res)) - (when (and res (get-text-property res prop)) (cons res prop)))) - -(defun markdown-find-next-prop (prop &optional lim) - "Find next place where property PROP is non-nil, up to LIM. -Return a cons of (POS . PROPERTY) where POS is point if point -contains non-nil PROP." - (let ((res - (if (get-text-property (point) prop) (point) - (next-single-property-change - (point) prop nil (or lim (point-max)))))) - (when (and res (get-text-property res prop)) (cons res prop)))) - -(defun markdown-min-of-seq (map-fn seq) - "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." - (cl-loop for el in seq - with min = 1.0e+INF ; infinity - with min-el = nil - do (let ((res (funcall map-fn el))) - (when (< res min) - (setq min res) - (setq min-el el))) - finally return min-el)) - -(defun markdown-max-of-seq (map-fn seq) - "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." - (cl-loop for el in seq - with max = -1.0e+INF ; negative infinity - with max-el = nil - do (let ((res (funcall map-fn el))) - (when (and res (> res max)) - (setq max res) - (setq max-el el))) - finally return max-el)) - -(defun markdown-find-previous-block () - "Find previous block. -Detect whether `markdown-syntax-propertize-fenced-block-constructs' was -unable to propertize the entire block, but was able to propertize the beginning -of the block. If so, return a cons of (pos . property) where the beginning of -the block was propertized." - (let ((start-pt (point)) - (closest-open - (markdown-max-of-seq - #'car - (cl-remove-if - #'null - (cl-mapcar - #'markdown-find-previous-prop - (markdown-get-fenced-block-begin-properties)))))) - (when closest-open - (let* ((length-of-open-match - (let ((match-d - (get-text-property (car closest-open) (cdr closest-open)))) - (- (cl-fourth match-d) (cl-third match-d)))) - (end-regexp - (markdown-maybe-funcall-regexp - (cl-caadr - (cl-find-if - (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) - markdown-fenced-block-pairs)) - length-of-open-match)) - (end-prop-loc - (save-excursion - (save-match-data - (goto-char (car closest-open)) - (and (re-search-forward end-regexp start-pt t) - (match-beginning 0)))))) - (and (not end-prop-loc) closest-open))))) - -(defun markdown-get-fenced-block-from-start (prop) - "Return limits of an enclosing fenced block from its start, using PROP. -Return value is a list usable as `match-data'." - (catch 'no-rest-of-block - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-cadar entry) prop)) - markdown-fenced-block-pairs)) - (begin-of-begin (cl-first (markdown-text-property-at-point prop))) - (middle-prop (cl-third correct-entry)) - (end-prop (cl-cadadr correct-entry)) - (end-of-end - (save-excursion - (goto-char (match-end 0)) ; end of begin - (unless (eobp) (forward-char)) - (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) - (if (not mid-prop-v) ; no middle - (progn - ;; try to find end by advancing one - (let ((end-prop-v - (markdown-text-property-at-point end-prop))) - (if end-prop-v (cl-second end-prop-v) - (throw 'no-rest-of-block nil)))) - (set-match-data mid-prop-v) - (goto-char (match-end 0)) ; end of middle - (beginning-of-line) ; into end - (cl-second (markdown-text-property-at-point end-prop))))))) - (list begin-of-begin end-of-end)))) - -(defun markdown-get-fenced-block-from-middle (prop) - "Return limits of an enclosing fenced block from its middle, using PROP. -Return value is a list usable as `match-data'." - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-third entry) prop)) - markdown-fenced-block-pairs)) - (begin-prop (cl-cadar correct-entry)) - (begin-of-begin - (save-excursion - (goto-char (match-beginning 0)) - (unless (bobp) (forward-line -1)) - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop)))) - (end-prop (cl-cadadr correct-entry)) - (end-of-end - (save-excursion - (goto-char (match-end 0)) - (beginning-of-line) - (cl-second (markdown-text-property-at-point end-prop))))) - (list begin-of-begin end-of-end))) - -(defun markdown-get-fenced-block-from-end (prop) - "Return limits of an enclosing fenced block from its end, using PROP. -Return value is a list usable as `match-data'." - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-cadadr entry) prop)) - markdown-fenced-block-pairs)) - (end-of-end (cl-second (markdown-text-property-at-point prop))) - (middle-prop (cl-third correct-entry)) - (begin-prop (cl-cadar correct-entry)) - (begin-of-begin - (save-excursion - (goto-char (match-beginning 0)) ; beginning of end - (unless (bobp) (backward-char)) ; into middle - (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) - (if (not mid-prop-v) - (progn - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop))) - (set-match-data mid-prop-v) - (goto-char (match-beginning 0)) ; beginning of middle - (unless (bobp) (forward-line -1)) ; into beginning - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop))))))) - (list begin-of-begin end-of-end))) - -(defun markdown-get-enclosing-fenced-block-construct (&optional pos) - "Get \"fake\" match data for block enclosing POS. -Returns fake match data which encloses the start, middle, and end -of the block construct enclosing POS, if it exists. Used in -`markdown-code-block-at-pos'." - (save-excursion - (when pos (goto-char pos)) - (beginning-of-line) - (car - (cl-remove-if - #'null - (cl-mapcar - (lambda (fun-and-prop) - (cl-destructuring-bind (fun prop) fun-and-prop - (when prop - (save-match-data - (set-match-data (markdown-text-property-at-point prop)) - (funcall fun prop))))) - `((markdown-get-fenced-block-from-start - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-begin-properties))) - (markdown-get-fenced-block-from-middle - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-middle-properties))) - (markdown-get-fenced-block-from-end - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-end-properties))))))))) - -(defun markdown-propertize-end-match (reg end fence-spec middle-begin) - "Get match for REG up to END, if exists, and propertize appropriately. -FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and -MIDDLE-BEGIN is the start of the \"middle\" section of the block." - (when (re-search-forward reg end t) - (let ((close-begin (match-beginning 0)) ; Start of closing line. - (close-end (match-end 0)) ; End of closing line. - (close-data (match-data t))) ; Match data for closing line. - ;; Propertize middle section of fenced block. - (put-text-property middle-begin close-begin - (cl-third fence-spec) - (list middle-begin close-begin)) - ;; If the block is a YAML block, propertize the declarations inside - (markdown-syntax-propertize-yaml-metadata middle-begin close-begin) - ;; Propertize closing line of fenced block. - (put-text-property close-begin close-end - (cl-cadadr fence-spec) close-data)))) - -(defun markdown-syntax-propertize-fenced-block-constructs (start end) - "Propertize according to `markdown-fenced-block-pairs' from START to END. -If unable to propertize an entire block (if the start of a block is within START -and END, but the end of the block is not), propertize the start section of a -block, then in a subsequent call propertize both middle and end by finding the -start which was previously propertized." - (let ((start-reg (markdown-get-start-fence-regexp))) - (save-excursion - (goto-char start) - ;; start from previous unclosed block, if exists - (let ((prev-begin-block (markdown-find-previous-block))) - (when prev-begin-block - (let* ((correct-entry - (cl-find-if (lambda (entry) - (eq (cdr prev-begin-block) (cl-cadar entry))) - markdown-fenced-block-pairs)) - (enclosed-text-start (1+ (car prev-begin-block))) - (start-length - (save-excursion - (goto-char (car prev-begin-block)) - (string-match - (markdown-maybe-funcall-regexp - (caar correct-entry)) - (buffer-substring - (point-at-bol) (point-at-eol))) - (- (match-end 1) (match-beginning 1)))) - (end-reg (markdown-maybe-funcall-regexp - (cl-caadr correct-entry) start-length))) - (markdown-propertize-end-match - end-reg end correct-entry enclosed-text-start)))) - ;; find all new blocks within region - (while (re-search-forward start-reg end t) - ;; we assume the opening constructs take up (only) an entire line, - ;; so we re-check the current line - (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol))) - ;; find entry in `markdown-fenced-block-pairs' corresponding - ;; to regex which was matched - (correct-entry - (cl-find-if - (lambda (fenced-pair) - (string-match-p - (markdown-maybe-funcall-regexp (caar fenced-pair)) - cur-line)) - markdown-fenced-block-pairs)) - (enclosed-text-start - (save-excursion (1+ (point-at-eol)))) - (end-reg - (markdown-maybe-funcall-regexp - (cl-caadr correct-entry) - (if (and (match-beginning 1) (match-end 1)) - (- (match-end 1) (match-beginning 1)) - 0)))) - ;; get correct match data - (save-excursion - (beginning-of-line) - (re-search-forward - (markdown-maybe-funcall-regexp (caar correct-entry)) - (point-at-eol))) - ;; mark starting, even if ending is outside of region - (put-text-property (match-beginning 0) (match-end 0) - (cl-cadar correct-entry) (match-data t)) - (markdown-propertize-end-match - end-reg end correct-entry enclosed-text-start)))))) - -(defun markdown-syntax-propertize-blockquotes (start end) - "Match blockquotes from START to END." - (save-excursion - (goto-char start) - (while (and (re-search-forward markdown-regex-blockquote end t) - (not (markdown-code-block-at-pos (match-beginning 0)))) - (put-text-property (match-beginning 0) (match-end 0) - 'markdown-blockquote - (match-data t))))) - -(defun markdown-syntax-propertize-hrs (start end) - "Match horizontal rules from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward markdown-regex-hr end t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (goto-char beg) - (unless (or (markdown-on-heading-p) - (markdown-code-block-at-point-p)) - (put-text-property beg end 'markdown-hr (match-data t))) - (goto-char end))))) - -(defun markdown-syntax-propertize-yaml-metadata (start end) - "Propertize elements inside YAML metadata blocks from START to END. -Assumes region from START and END is already known to be the interior -region of a YAML metadata block as propertized by -`markdown-syntax-propertize-fenced-block-constructs'." - (save-excursion - (goto-char start) - (cl-loop - while (re-search-forward markdown-regex-declarative-metadata end t) - do (progn - (put-text-property (match-beginning 1) (match-end 1) - 'markdown-metadata-key (match-data t)) - (put-text-property (match-beginning 2) (match-end 2) - 'markdown-metadata-markup (match-data t)) - (put-text-property (match-beginning 3) (match-end 3) - 'markdown-metadata-value (match-data t)))))) - -(defun markdown-syntax-propertize-headings (start end) - "Match headings of type SYMBOL with REGEX from START to END." - (goto-char start) - (while (re-search-forward markdown-regex-header end t) - (unless (markdown-code-block-at-pos (match-beginning 0)) - (put-text-property - (match-beginning 0) (match-end 0) 'markdown-heading - (match-data t)) - (put-text-property - (match-beginning 0) (match-end 0) - (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) - ((match-string-no-properties 3) 'markdown-heading-2-setext) - (t (let ((atx-level (length (markdown-trim-whitespace - (match-string-no-properties 4))))) - (intern (format "markdown-heading-%d-atx" atx-level))))) - (match-data t))))) - -(defun markdown-syntax-propertize-comments (start end) - "Match HTML comments from the START to END." - (let* ((in-comment (nth 4 (syntax-ppss))) - (comment-begin (nth 8 (syntax-ppss)))) - (goto-char start) - (cond - ;; Comment start - ((and (not in-comment) - (re-search-forward markdown-regex-comment-start end t) - (not (markdown-inline-code-at-point-p)) - (not (markdown-code-block-at-point-p))) - (let ((open-beg (match-beginning 0))) - (put-text-property open-beg (1+ open-beg) - 'syntax-table (string-to-syntax "<")) - (markdown-syntax-propertize-comments - (min (1+ (match-end 0)) end (point-max)) end))) - ;; Comment end - ((and in-comment comment-begin - (re-search-forward markdown-regex-comment-end end t)) - (let ((comment-end (match-end 0))) - (put-text-property (1- comment-end) comment-end - 'syntax-table (string-to-syntax ">")) - ;; Remove any other text properties inside the comment - (remove-text-properties comment-begin comment-end - markdown--syntax-properties) - (put-text-property comment-begin comment-end - 'markdown-comment (list comment-begin comment-end)) - (markdown-syntax-propertize-comments - (min (1+ comment-end) end (point-max)) end))) - ;; Nothing found - (t nil)))) - -(defun markdown-syntax-propertize (start end) - "Function used as `syntax-propertize-function'. -START and END delimit region to propertize." - (with-silent-modifications - (save-excursion - (remove-text-properties start end markdown--syntax-properties) - (markdown-syntax-propertize-fenced-block-constructs start end) - (markdown-syntax-propertize-list-items start end) - (markdown-syntax-propertize-pre-blocks start end) - (markdown-syntax-propertize-blockquotes start end) - (markdown-syntax-propertize-headings start end) - (markdown-syntax-propertize-hrs start end) - (markdown-syntax-propertize-comments start end)))) - - -;;; Markup Hiding - -(defconst markdown-markup-properties - '(face markdown-markup-face invisible markdown-markup) - "List of properties and values to apply to markup.") - -(defconst markdown-language-keyword-properties - '(face markdown-language-keyword-face invisible markdown-markup) - "List of properties and values to apply to code block language names.") - -(defconst markdown-language-info-properties - '(face markdown-language-info-face invisible markdown-markup) - "List of properties and values to apply to code block language info strings.") - -(defconst markdown-include-title-properties - '(face markdown-link-title-face invisible markdown-markup) - "List of properties and values to apply to included code titles.") - -(defcustom markdown-hide-markup nil - "Determines whether markup in the buffer will be hidden. -When set to nil, all markup is displayed in the buffer as it -appears in the file. An exception is when `markdown-hide-urls' -is non-nil. -Set this to a non-nil value to turn this feature on by default. -You can interactively toggle the value of this variable with -`markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], -or from the Markdown > Show & Hide menu. - -Markup hiding works by adding text properties to positions in the -buffer---either the `invisible' property or the `display' property -in cases where alternative glyphs are used (e.g., list bullets). -This does not, however, affect printing or other output. -Functions such as `htmlfontify-buffer' and `ps-print-buffer' will -not honor these text properties. For printing, it would be better -to first convert to HTML or PDF (e.g,. using Pandoc)." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) -(make-variable-buffer-local 'markdown-hide-markup) - -(defun markdown-toggle-markup-hiding (&optional arg) - "Toggle the display or hiding of markup. -With a prefix argument ARG, enable markup hiding if ARG is positive, -and disable it otherwise. -See `markdown-hide-markup' for additional details." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-hide-markup - (if (eq arg 'toggle) - (not markdown-hide-markup) - (> (prefix-numeric-value arg) 0))) - (if markdown-hide-markup - (progn (add-to-invisibility-spec 'markdown-markup) - (message "markdown-mode markup hiding enabled")) - (progn (remove-from-invisibility-spec 'markdown-markup) - (message "markdown-mode markup hiding disabled"))) - (markdown-reload-extensions)) - - -;;; Font Lock ================================================================= - -(require 'font-lock) - -(defvar markdown-italic-face 'markdown-italic-face - "Face name to use for italic text.") - -(defvar markdown-bold-face 'markdown-bold-face - "Face name to use for bold text.") - -(defvar markdown-strike-through-face 'markdown-strike-through-face - "Face name to use for strike-through text.") - -(defvar markdown-header-delimiter-face 'markdown-header-delimiter-face - "Face name to use as a base for header delimiters.") - -(defvar markdown-header-rule-face 'markdown-header-rule-face - "Face name to use as a base for header rules.") - -(defvar markdown-header-face 'markdown-header-face - "Face name to use as a base for headers.") - -(defvar markdown-header-face-1 'markdown-header-face-1 - "Face name to use for level-1 headers.") - -(defvar markdown-header-face-2 'markdown-header-face-2 - "Face name to use for level-2 headers.") - -(defvar markdown-header-face-3 'markdown-header-face-3 - "Face name to use for level-3 headers.") - -(defvar markdown-header-face-4 'markdown-header-face-4 - "Face name to use for level-4 headers.") - -(defvar markdown-header-face-5 'markdown-header-face-5 - "Face name to use for level-5 headers.") - -(defvar markdown-header-face-6 'markdown-header-face-6 - "Face name to use for level-6 headers.") - -(defvar markdown-inline-code-face 'markdown-inline-code-face - "Face name to use for inline code.") - -(defvar markdown-list-face 'markdown-list-face - "Face name to use for list markers.") - -(defvar markdown-blockquote-face 'markdown-blockquote-face - "Face name to use for blockquote.") - -(defvar markdown-pre-face 'markdown-pre-face - "Face name to use for preformatted text.") - -(defvar markdown-language-keyword-face 'markdown-language-keyword-face - "Face name to use for programming language identifiers.") - -(defvar markdown-language-info-face 'markdown-language-info-face - "Face name to use for programming info strings.") - -(defvar markdown-link-face 'markdown-link-face - "Face name to use for links.") - -(defvar markdown-missing-link-face 'markdown-missing-link-face - "Face name to use for links where the linked file does not exist.") - -(defvar markdown-reference-face 'markdown-reference-face - "Face name to use for reference.") - -(defvar markdown-footnote-marker-face 'markdown-footnote-marker-face - "Face name to use for footnote markers.") - -(defvar markdown-url-face 'markdown-url-face - "Face name to use for URLs.") - -(defvar markdown-link-title-face 'markdown-link-title-face - "Face name to use for reference link titles.") - -(defvar markdown-line-break-face 'markdown-line-break-face - "Face name to use for hard line breaks.") - -(defvar markdown-comment-face 'markdown-comment-face - "Face name to use for HTML comments.") - -(defvar markdown-math-face 'markdown-math-face - "Face name to use for LaTeX expressions.") - -(defvar markdown-metadata-key-face 'markdown-metadata-key-face - "Face name to use for metadata keys.") - -(defvar markdown-metadata-value-face 'markdown-metadata-value-face - "Face name to use for metadata values.") - -(defvar markdown-gfm-checkbox-face 'markdown-gfm-checkbox-face - "Face name to use for GFM checkboxes.") - -(defvar markdown-highlight-face 'markdown-highlight-face - "Face name to use for mouse highlighting.") - -(defvar markdown-markup-face 'markdown-markup-face - "Face name to use for markup elements.") - -(make-obsolete-variable 'markdown-italic-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-bold-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-strike-through-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-delimiter-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-rule-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face-1 "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face-2 "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face-3 "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face-4 "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face-5 "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-header-face-6 "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-inline-code-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-list-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-blockquote-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-pre-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-language-keyword-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-language-info-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-link-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-missing-link-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-reference-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-footnote-marker-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-url-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-link-title-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-line-break-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-comment-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-math-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-metadata-key-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-metadata-value-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-gfm-checkbox-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-highlight-face "Use face name directly" "v2.4") -(make-obsolete-variable 'markdown-markup-face "Use face name directly" "v2.4") - -(defgroup markdown-faces nil - "Faces used in Markdown Mode" - :group 'markdown - :group 'faces) - -(defface markdown-italic-face - '((t (:inherit italic))) - "Face for italic text." - :group 'markdown-faces) - -(defface markdown-bold-face - '((t (:inherit bold))) - "Face for bold text." - :group 'markdown-faces) - -(defface markdown-strike-through-face - '((t (:strike-through t))) - "Face for strike-through text." - :group 'markdown-faces) - -(defface markdown-markup-face - '((t (:inherit shadow :slant normal :weight normal))) - "Face for markup elements." - :group 'markdown-faces) - -(defface markdown-header-rule-face - '((t (:inherit markdown-markup-face))) - "Base face for headers rules." - :group 'markdown-faces) - -(defface markdown-header-delimiter-face - '((t (:inherit markdown-markup-face))) - "Base face for headers hash delimiter." - :group 'markdown-faces) - -(defface markdown-list-face - '((t (:inherit markdown-markup-face))) - "Face for list item markers." - :group 'markdown-faces) - -(defface markdown-blockquote-face - '((t (:inherit font-lock-doc-face))) - "Face for blockquote sections." - :group 'markdown-faces) - -(defface markdown-code-face - '((t (:inherit fixed-pitch))) - "Face for inline code, pre blocks, and fenced code blocks. -This may be used, for example, to add a contrasting background to -inline code fragments and code blocks." - :group 'markdown-faces) - -(defface markdown-inline-code-face - '((t (:inherit (markdown-code-face font-lock-constant-face)))) - "Face for inline code." - :group 'markdown-faces) - -(defface markdown-pre-face - '((t (:inherit (markdown-code-face font-lock-constant-face)))) - "Face for preformatted text." - :group 'markdown-faces) - -(defface markdown-table-face - '((t (:inherit (markdown-code-face)))) - "Face for tables." - :group 'markdown-faces) - -(defface markdown-language-keyword-face - '((t (:inherit font-lock-type-face))) - "Face for programming language identifiers." - :group 'markdown-faces) - -(defface markdown-language-info-face - '((t (:inherit font-lock-string-face))) - "Face for programming language info strings." - :group 'markdown-faces) - -(defface markdown-link-face - '((t (:inherit link))) - "Face for links." - :group 'markdown-faces) - -(defface markdown-missing-link-face - '((t (:inherit font-lock-warning-face))) - "Face for missing links." - :group 'markdown-faces) - -(defface markdown-reference-face - '((t (:inherit markdown-markup-face))) - "Face for link references." - :group 'markdown-faces) - -(define-obsolete-face-alias 'markdown-footnote-face - 'markdown-footnote-marker-face "v2.3") - -(defface markdown-footnote-marker-face - '((t (:inherit markdown-markup-face))) - "Face for footnote markers." - :group 'markdown-faces) - -(defface markdown-footnote-text-face - '((t (:inherit font-lock-comment-face))) - "Face for footnote text." - :group 'markdown-faces) - -(defface markdown-url-face - '((t (:inherit font-lock-string-face))) - "Face for URLs that are part of markup. -For example, this applies to URLs in inline links: -[link text](http://example.com/)." - :group 'markdown-faces) - -(defface markdown-plain-url-face - '((t (:inherit markdown-link-face))) - "Face for URLs that are also links. -For example, this applies to plain angle bracket URLs: -<http://example.com/>." - :group 'markdown-faces) - -(defface markdown-link-title-face - '((t (:inherit font-lock-comment-face))) - "Face for reference link titles." - :group 'markdown-faces) - -(defface markdown-line-break-face - '((t (:inherit font-lock-constant-face :underline t))) - "Face for hard line breaks." - :group 'markdown-faces) - -(defface markdown-comment-face - '((t (:inherit font-lock-comment-face))) - "Face for HTML comments." - :group 'markdown-faces) - -(defface markdown-math-face - '((t (:inherit font-lock-string-face))) - "Face for LaTeX expressions." - :group 'markdown-faces) - -(defface markdown-metadata-key-face - '((t (:inherit font-lock-variable-name-face))) - "Face for metadata keys." - :group 'markdown-faces) - -(defface markdown-metadata-value-face - '((t (:inherit font-lock-string-face))) - "Face for metadata values." - :group 'markdown-faces) - -(defface markdown-gfm-checkbox-face - '((t (:inherit font-lock-builtin-face))) - "Face for GFM checkboxes." - :group 'markdown-faces) - -(defface markdown-highlight-face - '((t (:inherit highlight))) - "Face for mouse highlighting." - :group 'markdown-faces) - -(defface markdown-hr-face - '((t (:inherit markdown-markup-face))) - "Face for horizontal rules." - :group 'markdown-faces) - -(defface markdown-html-tag-name-face - '((t (:inherit font-lock-type-face))) - "Face for HTML tag names." - :group 'markdown-faces) - -(defface markdown-html-tag-delimiter-face - '((t (:inherit markdown-markup-face))) - "Face for HTML tag delimiters." - :group 'markdown-faces) - -(defface markdown-html-attr-name-face - '((t (:inherit font-lock-variable-name-face))) - "Face for HTML attribute names." - :group 'markdown-faces) - -(defface markdown-html-attr-value-face - '((t (:inherit font-lock-string-face))) - "Face for HTML attribute values." - :group 'markdown-faces) - -(defface markdown-html-entity-face - '((t (:inherit font-lock-variable-name-face))) - "Face for HTML entities." - :group 'markdown-faces) - -(defcustom markdown-header-scaling nil - "Whether to use variable-height faces for headers. -When non-nil, `markdown-header-face' will inherit from -`variable-pitch' and the scaling values in -`markdown-header-scaling-values' will be applied to -headers of levels one through six respectively." - :type 'boolean - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (markdown-update-header-faces value)) - :group 'markdown-faces - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-header-scaling-values - '(2.0 1.7 1.4 1.1 1.0 1.0) - "List of scaling values for headers of level one through six. -Used when `markdown-header-scaling' is non-nil." - :type 'list - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (markdown-update-header-faces markdown-header-scaling value)) - :group 'markdown-faces) - -(defun markdown-make-header-faces () - "Build the faces used for Markdown headers." - (let ((inherit-faces '(font-lock-function-name-face))) - (when markdown-header-scaling - (setq inherit-faces (cons 'variable-pitch inherit-faces))) - (defface markdown-header-face - `((t (:inherit ,inherit-faces :weight bold))) - "Base face for headers." - :group 'markdown-faces)) - (dotimes (num 6) - (let* ((num1 (1+ num)) - (face-name (intern (format "markdown-header-face-%s" num1))) - (scale (if markdown-header-scaling - (float (nth num markdown-header-scaling-values)) - 1.0))) - (eval - `(defface ,face-name - '((t (:inherit markdown-header-face :height ,scale))) - (format "Face for level %s headers. -You probably don't want to customize this face directly. Instead -you can customize the base face `markdown-header-face' or the -variable-height variable `markdown-header-scaling'." ,num1) - :group 'markdown-faces))))) - -(markdown-make-header-faces) - -(defun markdown-update-header-faces (&optional scaling scaling-values) - "Update header faces, depending on if header SCALING is desired. -If so, use given list of SCALING-VALUES relative to the baseline -size of `markdown-header-face'." - (dotimes (num 6) - (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) - (scale (cond ((not scaling) 1.0) - (scaling-values (float (nth num scaling-values))) - (t (float (nth num markdown-header-scaling-values)))))) - (unless (get face-name 'saved-face) ; Don't update customized faces - (set-face-attribute face-name nil :height scale))))) - -(defun markdown-syntactic-face (state) - "Return font-lock face for characters with given STATE. -See `font-lock-syntactic-face-function' for details." - (let ((in-comment (nth 4 state))) - (cond - (in-comment 'markdown-comment-face) - (t nil)))) - -(defcustom markdown-list-item-bullets - '("●" "◎" "○" "◆" "◇" "►" "•") - "List of bullets to use for unordered lists. -It can contain any number of symbols, which will be repeated. -Depending on your font, some reasonable choices are: -♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." - :group 'markdown - :type '(repeat (string :tag "Bullet character")) - :package-version '(markdown-mode . "2.3")) - -(defun markdown--footnote-marker-properties () - "Return a font-lock facespec expression for footnote marker text." - `(face markdown-footnote-marker-face - ,@(when markdown-hide-markup - `(display ,markdown-footnote-display)))) - -(defun markdown--pandoc-inline-footnote-properties () - "Return a font-lock facespec expression for Pandoc inline footnote text." - `(face markdown-footnote-text-face - ,@(when markdown-hide-markup - `(display ,markdown-footnote-display)))) - -(defvar markdown-mode-font-lock-keywords - `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) - (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) - (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-language-keyword-properties nil t) - (4 markdown-language-info-properties nil t) - (5 markdown-markup-properties nil t))) - (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) - (markdown-fontify-gfm-code-blocks) - (markdown-fontify-tables) - (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-language-keyword-properties nil t) - (4 markdown-language-info-properties nil t) - (5 markdown-markup-properties nil t))) - (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) - (markdown-fontify-fenced-code-blocks) - (markdown-match-pre-blocks . ((0 'markdown-pre-face))) - (markdown-fontify-headings) - (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-fontify-hrs) - (markdown-match-code . ((1 markdown-markup-properties prepend) - (2 'markdown-inline-code-face prepend) - (3 markdown-markup-properties prepend))) - (,markdown-regex-kbd . ((1 markdown-markup-properties) - (2 'markdown-inline-code-face) - (3 markdown-markup-properties))) - (markdown-fontify-angle-uris) - (,markdown-regex-email . 'markdown-plain-url-face) - (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) - (2 'markdown-html-tag-name-face t) - (3 'markdown-html-tag-delimiter-face t) - ;; Anchored matcher for HTML tag attributes - (,markdown-regex-html-attr - ;; Before searching, move past tag - ;; name; set limit at tag close. - (progn - (goto-char (match-end 2)) (match-end 3)) - nil - . ((1 'markdown-html-attr-name-face) - (3 'markdown-html-tag-delimiter-face nil t) - (4 'markdown-html-attr-value-face nil t))))) - (,markdown-regex-html-entity . 'markdown-html-entity-face) - (markdown-fontify-list-items) - (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ - (2 (markdown--footnote-marker-properties)) ; label - (3 markdown-markup-properties))) ; ] - (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ - (2 markdown-markup-properties) ; [ - (3 (markdown--pandoc-inline-footnote-properties)) ; text - (4 markdown-markup-properties))) ; ] - (markdown-match-includes . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-include-title-properties nil t) - (4 markdown-markup-properties nil t) - (5 markdown-markup-properties) - (6 'markdown-url-face) - (7 markdown-markup-properties))) - (markdown-fontify-inline-links) - (markdown-fontify-reference-links) - (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ - (2 'markdown-reference-face) ; label - (3 'markdown-markup-face) ; ] - (4 'markdown-markup-face) ; : - (5 'markdown-url-face) ; url - (6 'markdown-link-title-face))) ; "title" (optional) - (markdown-fontify-plain-uris) - ;; Math mode $..$ - (markdown-match-math-single . ((1 'markdown-markup-face prepend) - (2 'markdown-math-face append) - (3 'markdown-markup-face prepend))) - ;; Math mode $$..$$ - (markdown-match-math-double . ((1 'markdown-markup-face prepend) - (2 'markdown-math-face append) - (3 'markdown-markup-face prepend))) - ;; Math mode \[..\] and \\[..\\] - (markdown-match-math-display . ((1 'markdown-markup-face prepend) - (3 'markdown-math-face append) - (4 'markdown-markup-face prepend))) - (markdown-match-bold . ((1 markdown-markup-properties prepend) - (2 'markdown-bold-face append) - (3 markdown-markup-properties prepend))) - (markdown-match-italic . ((1 markdown-markup-properties prepend) - (2 'markdown-italic-face append) - (3 markdown-markup-properties prepend))) - (,markdown-regex-strike-through . ((3 markdown-markup-properties) - (4 'markdown-strike-through-face) - (5 markdown-markup-properties))) - (,markdown-regex-line-break . (1 'markdown-line-break-face prepend)) - (markdown-fontify-sub-superscripts) - (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) - (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) - (markdown-fontify-blockquotes) - (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) - "Syntax highlighting for Markdown files.") - -(define-obsolete-variable-alias - 'markdown-mode-font-lock-keywords-basic - 'markdown-mode-font-lock-keywords "v2.4") - -;; Footnotes -(defvar markdown-footnote-counter 0 - "Counter for footnote numbers.") -(make-variable-buffer-local 'markdown-footnote-counter) - -(defconst markdown-footnote-chars - "[[:alnum:]-]" - "Regular expression matching any character that is allowed in a footnote identifier.") - -(defconst markdown-regex-footnote-definition - (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") - "Regular expression matching a footnote definition, capturing the label.") - - -;;; Compatibility ============================================================= - -(defun markdown-replace-regexp-in-string (regexp rep string) - "Replace ocurrences of REGEXP with REP in STRING. -This is a compatibility wrapper to provide `replace-regexp-in-string' -in XEmacs 21." - (if (featurep 'xemacs) - (replace-in-string string regexp rep) - (replace-regexp-in-string regexp rep string))) - -;; `markdown-use-region-p' is a compatibility function which checks -;; for an active region, with fallbacks for older Emacsen and XEmacs. -(eval-and-compile - (cond - ;; Emacs 24 and newer - ((fboundp 'use-region-p) - (defalias 'markdown-use-region-p 'use-region-p)) - ;; XEmacs - ((fboundp 'region-active-p) - (defalias 'markdown-use-region-p 'region-active-p)))) - -;; Use new names for outline-mode functions in Emacs 25 and later. -(eval-and-compile - (defalias 'markdown-hide-sublevels - (if (fboundp 'outline-hide-sublevels) - 'outline-hide-sublevels - 'hide-sublevels)) - (defalias 'markdown-show-all - (if (fboundp 'outline-show-all) - 'outline-show-all - 'show-all)) - (defalias 'markdown-hide-body - (if (fboundp 'outline-hide-body) - 'outline-hide-body - 'hide-body)) - (defalias 'markdown-show-children - (if (fboundp 'outline-show-children) - 'outline-show-children - 'show-children)) - (defalias 'markdown-show-subtree - (if (fboundp 'outline-show-subtree) - 'outline-show-subtree - 'show-subtree)) - (defalias 'markdown-hide-subtree - (if (fboundp 'outline-hide-subtree) - 'outline-hide-subtree - 'hide-subtree))) - -;; Provide directory-name-p to Emacs 24 -(defsubst markdown-directory-name-p (name) - "Return non-nil if NAME ends with a directory separator character. -Taken from `directory-name-p' from Emacs 25 and provided here for -backwards compatibility." - (let ((len (length name)) - (lastc ?.)) - (if (> len 0) - (setq lastc (aref name (1- len)))) - (or (= lastc ?/) - (and (memq system-type '(windows-nt ms-dos)) - (= lastc ?\\))))) - -;; Provide a function to find files recursively in Emacs 24. -(defalias 'markdown-directory-files-recursively - (if (fboundp 'directory-files-recursively) - 'directory-files-recursively - (lambda (dir regexp) - "Return list of all files under DIR that have file names matching REGEXP. -This function works recursively. Files are returned in \"depth first\" -order, and files from each directory are sorted in alphabetical order. -Each file name appears in the returned list in its absolute form. -Based on `directory-files-recursively' from Emacs 25 and provided -here for backwards compatibility." - (let ((result nil) - (files nil) - ;; When DIR is "/", remote file names like "/method:" could - ;; also be offered. We shall suppress them. - (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir))))) - (dolist (file (sort (file-name-all-completions "" dir) - 'string<)) - (unless (member file '("./" "../")) - (if (markdown-directory-name-p file) - (let* ((leaf (substring file 0 (1- (length file)))) - (full-file (expand-file-name leaf dir))) - (setq result - (nconc result (markdown-directory-files-recursively - full-file regexp)))) - (when (string-match-p regexp file) - (push (expand-file-name file dir) files))))) - (nconc result (nreverse files)))))) - -(defun markdown-flyspell-check-word-p () - "Return t if `flyspell' should check word just before point. -Used for `flyspell-generic-check-word-predicate'." - (save-excursion - (goto-char (1- (point))) - (not (or (markdown-code-block-at-point-p) - (markdown-inline-code-at-point-p) - (markdown-in-comment-p) - (let ((faces (get-text-property (point) 'face))) - (if (listp faces) - (or (memq 'markdown-reference-face faces) - (memq 'markdown-markup-face faces) - (memq 'markdown-plain-url-face faces) - (memq 'markdown-inline-code-face faces) - (memq 'markdown-url-face faces)) - (memq faces '(markdown-reference-face - markdown-markup-face - markdown-plain-url-face - markdown-inline-code-face - markdown-url-face)))))))) - -(defun markdown-font-lock-ensure () - "Provide `font-lock-ensure' in Emacs 24." - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (with-no-warnings - ;; Suppress warning about non-interactive use of - ;; `font-lock-fontify-buffer' in Emacs 25. - (font-lock-fontify-buffer)))) - - -;;; Markdown Parsing Functions ================================================ - -(define-obsolete-function-alias - 'markdown-cur-line-blank 'markdown-cur-line-blank-p "v2.4") -(define-obsolete-function-alias - 'markdown-next-line-blank 'markdown-next-line-blank-p "v2.4") - -(defun markdown-cur-line-blank-p () - "Return t if the current line is blank and nil otherwise." - (save-excursion - (beginning-of-line) - (looking-at-p markdown-regex-blank-line))) - -(defun markdown-prev-line-blank () - "Return t if the previous line is blank and nil otherwise. -If we are at the first line, then consider the previous line to be blank." - (or (= (line-beginning-position) (point-min)) - (save-excursion - (forward-line -1) - (looking-at markdown-regex-blank-line)))) - -(defun markdown-prev-line-blank-p () - "Like `markdown-prev-line-blank', but preserve `match-data'." - (save-match-data (markdown-prev-line-blank))) - -(defun markdown-next-line-blank-p () - "Return t if the next line is blank and nil otherwise. -If we are at the last line, then consider the next line to be blank." - (or (= (line-end-position) (point-max)) - (save-excursion - (forward-line 1) - (markdown-cur-line-blank-p)))) - -(defun markdown-prev-line-indent () - "Return the number of leading whitespace characters in the previous line. -Return 0 if the current line is the first line in the buffer." - (save-excursion - (if (= (line-beginning-position) (point-min)) - 0 - (forward-line -1) - (current-indentation)))) - -(defun markdown-next-line-indent () - "Return the number of leading whitespace characters in the next line. -Return 0 if line is the last line in the buffer." - (save-excursion - (if (= (line-end-position) (point-max)) - 0 - (forward-line 1) - (current-indentation)))) - -(defun markdown-new-baseline () - "Determine if the current line begins a new baseline level. -Assume point is positioned at beginning of line." - (or (looking-at markdown-regex-header) - (looking-at markdown-regex-hr) - (and (= (current-indentation) 0) - (not (looking-at markdown-regex-list)) - (markdown-prev-line-blank)))) - -(defun markdown-search-backward-baseline () - "Search backward baseline point with no indentation and not a list item." - (end-of-line) - (let (stop) - (while (not (or stop (bobp))) - (re-search-backward markdown-regex-block-separator-noindent nil t) - (when (match-end 2) - (goto-char (match-end 2)) - (cond - ((markdown-new-baseline) - (setq stop t)) - ((looking-at-p markdown-regex-list) - (setq stop nil)) - (t (setq stop t))))))) - -(defun markdown-update-list-levels (marker indent levels) - "Update list levels given list MARKER, block INDENT, and current LEVELS. -Here, MARKER is a string representing the type of list, INDENT is an integer -giving the indentation, in spaces, of the current block, and LEVELS is a -list of the indentation levels of parent list items. When LEVELS is nil, -it means we are at baseline (not inside of a nested list)." - (cond - ;; New list item at baseline. - ((and marker (null levels)) - (setq levels (list indent))) - ;; List item with greater indentation (four or more spaces). - ;; Increase list level. - ((and marker (>= indent (+ (car levels) 4))) - (setq levels (cons indent levels))) - ;; List item with greater or equal indentation (less than four spaces). - ;; Do not increase list level. - ((and marker (>= indent (car levels))) - levels) - ;; Lesser indentation level. - ;; Pop appropriate number of elements off LEVELS list (e.g., lesser - ;; indentation could move back more than one list level). Note - ;; that this block need not be the beginning of list item. - ((< indent (car levels)) - (while (and (> (length levels) 1) - (< indent (+ (cadr levels) 4))) - (setq levels (cdr levels))) - levels) - ;; Otherwise, do nothing. - (t levels))) - -(defun markdown-calculate-list-levels () - "Calculate list levels at point. -Return a list of the form (n1 n2 n3 ...) where n1 is the -indentation of the deepest nested list item in the branch of -the list at the point, n2 is the indentation of the parent -list item, and so on. The depth of the list item is therefore -the length of the returned list. If the point is not at or -immediately after a list item, return nil." - (save-excursion - (let ((first (point)) levels indent pre-regexp) - ;; Find a baseline point with zero list indentation - (markdown-search-backward-baseline) - ;; Search for all list items between baseline and LOC - (while (and (< (point) first) - (re-search-forward markdown-regex-list first t)) - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) - (beginning-of-line) - (cond - ;; Make sure this is not a header or hr - ((markdown-new-baseline) (setq levels nil)) - ;; Make sure this is not a line from a pre block - ((looking-at-p pre-regexp)) - ;; If not, then update levels - (t - (setq indent (current-indentation)) - (setq levels (markdown-update-list-levels (match-string 2) - indent levels)))) - (end-of-line)) - levels))) - -(defun markdown-prev-list-item (level) - "Search backward from point for a list item with indentation LEVEL. -Set point to the beginning of the item, and return point, or nil -upon failure." - (let (bounds indent prev) - (setq prev (point)) - (forward-line -1) - (setq indent (current-indentation)) - (while - (cond - ;; List item - ((and (looking-at-p markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Stop and return point at item of equal indentation - ((= (nth 3 bounds) level) - (setq prev (point)) - nil) - ;; Stop and return nil at item with lesser indentation - ((< (nth 3 bounds) level) - (setq prev nil) - nil) - ;; Stop at beginning of buffer - ((bobp) (setq prev nil)) - ;; Continue at item with greater indentation - ((> (nth 3 bounds) level) t))) - ;; Stop at beginning of buffer - ((bobp) (setq prev nil)) - ;; Continue if current line is blank - ((markdown-cur-line-blank-p) t) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Stop if current indentation is less than list item - ;; and the next is blank - ((and (< indent level) - (markdown-next-line-blank-p)) - (setq prev nil)) - ;; Stop at a header - ((looking-at-p markdown-regex-header) (setq prev nil)) - ;; Stop at a horizontal rule - ((looking-at-p markdown-regex-hr) (setq prev nil)) - ;; Otherwise, continue. - (t t)) - (forward-line -1) - (setq indent (current-indentation))) - prev)) - -(defun markdown-next-list-item (level) - "Search forward from point for the next list item with indentation LEVEL. -Set point to the beginning of the item, and return point, or nil -upon failure." - (let (bounds indent next) - (setq next (point)) - (if (looking-at markdown-regex-header-setext) - (goto-char (match-end 0))) - (forward-line) - (setq indent (current-indentation)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue if the current line is blank - ((markdown-cur-line-blank-p) t) - ;; List item - ((and (looking-at-p markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Continue at item with greater indentation - ((> (nth 3 bounds) level) t) - ;; Stop and return point at item of equal indentation - ((= (nth 3 bounds) level) - (setq next (point)) - nil) - ;; Stop and return nil at item with lesser indentation - ((< (nth 3 bounds) level) - (setq next nil) - nil))) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Stop if current indentation is less than list item - ;; and the previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank-p)) - (setq next nil)) - ;; Stop at a header - ((looking-at-p markdown-regex-header) (setq next nil)) - ;; Stop at a horizontal rule - ((looking-at-p markdown-regex-hr) (setq next nil)) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (current-indentation))) - next)) - -(defun markdown-cur-list-item-end (level) - "Move to end of list item with pre-marker indentation LEVEL. -Return the point at the end when a list item was found at the -original point. If the point is not in a list item, do nothing." - (let (indent) - (forward-line) - (setq indent (current-indentation)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Continue if the current line is blank - ((looking-at markdown-regex-blank-line) t) - ;; Stop if current indentation is less than list item - ;; and the previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank)) - nil) - ;; Stop at a new list items of the same or lesser - ;; indentation, headings, and horizontal rules. - ((looking-at (concat "\\(?:" markdown-regex-list - "\\|" markdown-regex-header - "\\|" markdown-regex-hr "\\)")) - nil) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (current-indentation))) - ;; Don't skip over whitespace for empty list items (marker and - ;; whitespace only), just move to end of whitespace. - (if (save-excursion - (beginning-of-line) - (looking-at (concat markdown-regex-list "[ \t]*$"))) - (goto-char (match-end 3)) - (skip-chars-backward " \t\n")) - (end-of-line) - (point))) - -(defun markdown-cur-list-item-bounds () - "Return bounds for list item at point. -Return a list of the following form: - - (begin end indent nonlist-indent marker checkbox match) - -The named components are: - - - begin: Position of beginning of list item, including leading indentation. - - end: Position of the end of the list item, including list item text. - - indent: Number of characters of indentation before list marker (an integer). - - nonlist-indent: Number characters of indentation, list - marker, and whitespace following list marker (an integer). - - marker: String containing the list marker and following whitespace - (e.g., \"- \" or \"* \"). - - checkbox: String containing the GFM checkbox portion, if any, - including any trailing whitespace before the text - begins (e.g., \"[x] \"). - - match: match data for markdown-regex-list - -As an example, for the following unordered list item - - - item - -the returned list would be - - (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) - -If the point is not inside a list item, return nil." - (car (get-text-property (point-at-bol) 'markdown-list-item))) - -(defun markdown-list-item-at-point-p () - "Return t if there is a list item at the point and nil otherwise." - (save-match-data (markdown-cur-list-item-bounds))) - -(defun markdown-prev-list-item-bounds () - "Return bounds of previous item in the same list of any level. -The return value has the same form as that of -`markdown-cur-list-item-bounds'." - (save-excursion - (let ((cur-bounds (markdown-cur-list-item-bounds)) - (beginning-of-list (save-excursion (markdown-beginning-of-list))) - stop) - (when cur-bounds - (goto-char (nth 0 cur-bounds)) - (while (and (not stop) (not (bobp)) - (re-search-backward markdown-regex-list - beginning-of-list t)) - (unless (or (looking-at markdown-regex-hr) - (markdown-code-block-at-point-p)) - (setq stop (point)))) - (markdown-cur-list-item-bounds))))) - -(defun markdown-next-list-item-bounds () - "Return bounds of next item in the same list of any level. -The return value has the same form as that of -`markdown-cur-list-item-bounds'." - (save-excursion - (let ((cur-bounds (markdown-cur-list-item-bounds)) - (end-of-list (save-excursion (markdown-end-of-list))) - stop) - (when cur-bounds - (goto-char (nth 0 cur-bounds)) - (end-of-line) - (while (and (not stop) (not (eobp)) - (re-search-forward markdown-regex-list - end-of-list t)) - (unless (or (looking-at markdown-regex-hr) - (markdown-code-block-at-point-p)) - (setq stop (point)))) - (when stop - (markdown-cur-list-item-bounds)))))) - -(defun markdown-beginning-of-list () - "Move point to beginning of list at point, if any." - (interactive) - (let ((orig-point (point)) - (list-begin (save-excursion - (markdown-search-backward-baseline) - ;; Stop at next list item, regardless of the indentation. - (markdown-next-list-item (point-max)) - (when (looking-at markdown-regex-list) - (point))))) - (when (and list-begin (<= list-begin orig-point)) - (goto-char list-begin)))) - -(defun markdown-end-of-list () - "Move point to end of list at point, if any." - (interactive) - (let ((start (point)) - (end (save-excursion - (when (markdown-beginning-of-list) - ;; Items can't have nonlist-indent <= 1, so this - ;; moves past all list items. - (markdown-next-list-item 1) - (skip-syntax-backward "-") - (unless (eobp) (forward-char 1)) - (point))))) - (when (and end (>= end start)) - (goto-char end)))) - -(defun markdown-up-list () - "Move point to beginning of parent list item." - (interactive) - (let ((cur-bounds (markdown-cur-list-item-bounds))) - (when cur-bounds - (markdown-prev-list-item (1- (nth 3 cur-bounds))) - (let ((up-bounds (markdown-cur-list-item-bounds))) - (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) - (point)))))) - -(defun markdown-bounds-of-thing-at-point (thing) - "Call `bounds-of-thing-at-point' for THING with slight modifications. -Does not include trailing newlines when THING is 'line. Handles the -end of buffer case by setting both endpoints equal to the value of -`point-max', since an empty region will trigger empty markup insertion. -Return bounds of form (beg . end) if THING is found, or nil otherwise." - (let* ((bounds (bounds-of-thing-at-point thing)) - (a (car bounds)) - (b (cdr bounds))) - (when bounds - (when (eq thing 'line) - (cond ((and (eobp) (markdown-cur-line-blank-p)) - (setq a b)) - ((char-equal (char-before b) ?\^J) - (setq b (1- b))))) - (cons a b)))) - -(defun markdown-reference-definition (reference) - "Find out whether Markdown REFERENCE is defined. -REFERENCE should not include the square brackets. -When REFERENCE is defined, return a list of the form (text start end) -containing the definition text itself followed by the start and end -locations of the text. Otherwise, return nil. -Leave match data for `markdown-regex-reference-definition' -intact additional processing." - (let ((reference (downcase reference))) - (save-excursion - (goto-char (point-min)) - (catch 'found - (while (re-search-forward markdown-regex-reference-definition nil t) - (when (string= reference (downcase (match-string-no-properties 2))) - (throw 'found - (list (match-string-no-properties 5) - (match-beginning 5) (match-end 5))))))))) - -(defun markdown-get-defined-references () - "Return all defined reference labels and their line numbers (not including square brackets)." - (save-excursion - (goto-char (point-min)) - (let (refs) - (while (re-search-forward markdown-regex-reference-definition nil t) - (let ((target (match-string-no-properties 2))) - (cl-pushnew - (cons (downcase target) - (markdown-line-number-at-pos (match-beginning 2))) - refs :test #'equal :key #'car))) - (reverse refs)))) - -(defun markdown-get-used-uris () - "Return a list of all used URIs in the buffer." - (save-excursion - (goto-char (point-min)) - (let (uris) - (while (re-search-forward - (concat "\\(?:" markdown-regex-link-inline - "\\|" markdown-regex-angle-uri - "\\|" markdown-regex-uri - "\\|" markdown-regex-email - "\\)") - nil t) - (unless (or (markdown-inline-code-at-point-p) - (markdown-code-block-at-point-p)) - (cl-pushnew (or (match-string-no-properties 6) - (match-string-no-properties 10) - (match-string-no-properties 12) - (match-string-no-properties 13)) - uris :test #'equal))) - (reverse uris)))) - -(defun markdown-inline-code-at-pos (pos) - "Return non-nil if there is an inline code fragment at POS. -Return nil otherwise. Set match data according to -`markdown-match-code' upon success. -This function searches the block for a code fragment that -contains the point using `markdown-match-code'. We do this -because `thing-at-point-looking-at' does not work reliably with -`markdown-regex-code'. - -The match data is set as follows: -Group 1 matches the opening backquotes. -Group 2 matches the code fragment itself, without backquotes. -Group 3 matches the closing backquotes." - (save-excursion - (goto-char pos) - (let ((old-point (point)) - (end-of-block (progn (markdown-end-of-text-block) (point))) - found) - (markdown-beginning-of-text-block) - (while (and (markdown-match-code end-of-block) - (setq found t) - (< (match-end 0) old-point))) - (and found ; matched something - (<= (match-beginning 0) old-point) ; match contains old-point - (> (match-end 0) old-point))))) - -(defun markdown-inline-code-at-pos-p (pos) - "Return non-nil if there is an inline code fragment at POS. -Like `markdown-inline-code-at-pos`, but preserves match data." - (save-match-data (markdown-inline-code-at-pos pos))) - -(defun markdown-inline-code-at-point () - "Return non-nil if the point is at an inline code fragment. -See `markdown-inline-code-at-pos' for details." - (markdown-inline-code-at-pos (point))) - -(defun markdown-inline-code-at-point-p (&optional pos) - "Return non-nil if there is inline code at the POS. -This is a predicate function counterpart to -`markdown-inline-code-at-point' which does not modify the match -data. See `markdown-code-block-at-point-p' for code blocks." - (save-match-data (markdown-inline-code-at-pos (or pos (point))))) - -(make-obsolete 'markdown-code-at-point-p 'markdown-inline-code-at-point-p "v2.2") - -(defun markdown-code-block-at-pos (pos) - "Return match data list if there is a code block at POS. -Uses text properties at the beginning of the line position. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. Return nil otherwise." - (let ((bol (save-excursion (goto-char pos) (point-at-bol)))) - (or (get-text-property bol 'markdown-pre) - (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) - (second (cl-second bounds))) - (if second - ;; chunks are right open - (when (< pos second) - bounds) - bounds))))) - -;; Function was renamed to emphasize that it does not modify match-data. -(defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) - -(defun markdown-code-block-at-point-p (&optional pos) - "Return non-nil if there is a code block at the POS. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. This function does not modify the match -data. See `markdown-inline-code-at-point-p' for inline code." - (save-match-data (markdown-code-block-at-pos (or pos (point))))) - -(defun markdown-heading-at-point (&optional pos) - "Return non-nil if there is a heading at the POS. -Set match data for `markdown-regex-header'." - (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) - (when match-data - (set-match-data match-data) - t))) - -(defun markdown-pipe-at-bol-p () - "Return non-nil if the line begins with a pipe symbol. -This may be useful for tables and Pandoc's line_blocks extension." - (char-equal (char-after (point-at-bol)) ?|)) - - -;;; Markdown Font Lock Matching Functions ===================================== - -(defun markdown-range-property-any (begin end prop prop-values) - "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. -Also returns t if PROP is a list containing one of the PROP-VALUES. -Return nil otherwise." - (let (props) - (catch 'found - (dolist (loc (number-sequence begin end)) - (when (setq props (get-text-property loc prop)) - (cond ((listp props) - ;; props is a list, check for membership - (dolist (val prop-values) - (when (memq val props) (throw 'found loc)))) - (t - ;; props is a scalar, check for equality - (dolist (val prop-values) - (when (eq val props) (throw 'found loc)))))))))) - -(defun markdown-range-properties-exist (begin end props) - (cl-loop - for loc in (number-sequence begin end) - with result = nil - while (not - (setq result - (cl-some (lambda (prop) (get-text-property loc prop)) props))) - finally return result)) - -(defun markdown-match-inline-generic (regex last &optional faceless) - "Match inline REGEX from the point to LAST. -When FACELESS is non-nil, do not return matches where faces have been applied." - (when (re-search-forward regex last t) - (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) - (face (and faceless (text-property-not-all - (match-beginning 0) (match-end 0) 'face nil)))) - (cond - ;; In code block: move past it and recursively search again - (bounds - (when (< (goto-char (cl-second bounds)) last) - (markdown-match-inline-generic regex last faceless))) - ;; When faces are found in the match range, skip over the match and - ;; recursively search again. - (face - (when (< (goto-char (match-end 0)) last) - (markdown-match-inline-generic regex last faceless))) - ;; Keep match data and return t when in bounds. - (t - (<= (match-end 0) last)))))) - -(defun markdown-match-code (last) - "Match inline code fragments from point to LAST." - (unless (bobp) - (backward-char 1)) - (when (markdown-search-until-condition - (lambda () - (and - ;; Advance point in case of failure, but without exceeding last. - (goto-char (min (1+ (match-beginning 1)) last)) - (not (markdown-in-comment-p (match-beginning 1))) - (not (markdown-in-comment-p (match-end 1))) - (not (markdown-code-block-at-pos (match-beginning 1))))) - markdown-regex-code last t) - (set-match-data (list (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4))) - (goto-char (min (1+ (match-end 0)) last (point-max))) - t)) - -(defun markdown-match-bold (last) - "Match inline bold from the point to LAST." - (when (markdown-match-inline-generic markdown-regex-bold last) - (let ((begin (match-beginning 2)) - (end (match-end 2))) - (if (or (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p end) - (markdown-in-comment-p) - (markdown-range-property-any - begin begin 'face '(markdown-url-face - markdown-plain-url-face)) - (markdown-range-property-any - begin end 'face '(markdown-hr-face - markdown-math-face))) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-italic last))) - (set-match-data (list (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4) - (match-beginning 5) (match-end 5))) - t)))) - -(defun markdown-match-italic (last) - "Match inline italics from the point to LAST." - (let ((regex (if (memq major-mode '(gfm-mode gfm-view-mode)) - markdown-regex-gfm-italic markdown-regex-italic))) - (when (markdown-match-inline-generic regex last) - (let ((begin (match-beginning 1)) - (end (match-end 1))) - (if (or (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p end) - (markdown-in-comment-p) - (markdown-range-property-any - begin begin 'face '(markdown-url-face - markdown-plain-url-face)) - (markdown-range-property-any - begin end 'face '(markdown-bold-face - markdown-list-face - markdown-hr-face - markdown-math-face))) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-italic last))) - (set-match-data (list (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4))) - t))))) - -(defun markdown-match-math-generic (regex last) - "Match REGEX from point to LAST. -REGEX is either `markdown-regex-math-inline-single' for matching -$..$ or `markdown-regex-math-inline-double' for matching $$..$$." - (when (and markdown-enable-math (markdown-match-inline-generic regex last)) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (prog1 - (if (or (markdown-range-property-any - begin end 'face - '(markdown-inline-code-face markdown-bold-face)) - (markdown-range-properties-exist - begin end - (markdown-get-fenced-block-middle-properties))) - (markdown-match-math-generic regex last) - t) - (goto-char (1+ (match-end 0))))))) - -(defun markdown-match-list-items (last) - "Match list items from point to LAST." - (let* ((first (point)) - (pos first) - (prop 'markdown-list-item) - (bounds (car (get-text-property pos prop)))) - (while - (and (or (null (setq bounds (car (get-text-property pos prop)))) - (< (cl-first bounds) pos)) - (< (point) last) - (setq pos (next-single-property-change pos prop nil last)) - (goto-char pos))) - (when bounds - (set-match-data (cl-seventh bounds)) - ;; Step at least one character beyond point. Otherwise - ;; `font-lock-fontify-keywords-region' infloops. - (goto-char (min (1+ (max (point-at-eol) first)) - (point-max))) - t))) - -(defun markdown-match-math-single (last) - "Match single quoted $..$ math from point to LAST." - (markdown-match-math-generic markdown-regex-math-inline-single last)) - -(defun markdown-match-math-double (last) - "Match double quoted $$..$$ math from point to LAST." - (markdown-match-math-generic markdown-regex-math-inline-double last)) - -(defun markdown-match-math-display (last) - "Match bracketed display math \[..\] and \\[..\\] from point to LAST." - (markdown-match-math-generic markdown-regex-math-display last)) - -(defun markdown-match-propertized-text (property last) - "Match text with PROPERTY from point to LAST. -Restore match data previously stored in PROPERTY." - (let ((saved (get-text-property (point) property)) - pos) - (unless saved - (setq pos (next-single-property-change (point) property nil last)) - (unless (= pos last) - (setq saved (get-text-property pos property)))) - (when saved - (set-match-data saved) - ;; Step at least one character beyond point. Otherwise - ;; `font-lock-fontify-keywords-region' infloops. - (goto-char (min (1+ (max (match-end 0) (point))) - (point-max))) - saved))) - -(defun markdown-match-pre-blocks (last) - "Match preformatted blocks from point to LAST. -Use data stored in 'markdown-pre text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-pre last)) - -(defun markdown-match-gfm-code-blocks (last) - "Match GFM quoted code blocks from point to LAST. -Use data stored in 'markdown-gfm-code text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-gfm-code last)) - -(defun markdown-match-gfm-open-code-blocks (last) - (markdown-match-propertized-text 'markdown-gfm-block-begin last)) - -(defun markdown-match-gfm-close-code-blocks (last) - (markdown-match-propertized-text 'markdown-gfm-block-end last)) - -(defun markdown-match-fenced-code-blocks (last) - "Match fenced code blocks from the point to LAST." - (markdown-match-propertized-text 'markdown-fenced-code last)) - -(defun markdown-match-fenced-start-code-block (last) - (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) - -(defun markdown-match-fenced-end-code-block (last) - (markdown-match-propertized-text 'markdown-tilde-fence-end last)) - -(defun markdown-match-blockquotes (last) - "Match blockquotes from point to LAST. -Use data stored in 'markdown-blockquote text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-blockquote last)) - -(defun markdown-match-hr (last) - "Match horizontal rules comments from the point to LAST." - (markdown-match-propertized-text 'markdown-hr last)) - -(defun markdown-match-comments (last) - "Match HTML comments from the point to LAST." - (when (and (skip-syntax-forward "^<" last)) - (let ((beg (point))) - (when (and (skip-syntax-forward "^>" last) (< (point) last)) - (forward-char) - (set-match-data (list beg (point))) - t)))) - -(defun markdown-match-generic-links (last ref) - "Match inline links from point to LAST. -When REF is non-nil, match reference links instead of standard -links with URLs. -This function should only be used during font-lock, as it -determines syntax based on the presence of faces for previously -processed elements." - ;; Search for the next potential link (not in a code block). - (let ((prohibited-faces '(markdown-pre-face - markdown-code-face - markdown-inline-code-face - markdown-comment-face)) - found) - (while - (and (not found) (< (point) last) - (progn - ;; Clear match data to test for a match after functions returns. - (set-match-data nil) - ;; Preliminary regular expression search so we can return - ;; quickly upon failure. This doesn't handle malformed links - ;; or nested square brackets well, so if it passes we back up - ;; continue with a more precise search. - (re-search-forward - (if ref - markdown-regex-link-reference - markdown-regex-link-inline) - last 'limit))) - ;; Keep searching if this is in a code block, inline code, or a - ;; comment, or if it is include syntax. The link text portion - ;; (group 3) may contain inline code or comments, but the - ;; markup, URL, and title should not be part of such elements. - (if (or (markdown-range-property-any - (match-beginning 0) (match-end 2) 'face prohibited-faces) - (markdown-range-property-any - (match-beginning 4) (match-end 0) 'face prohibited-faces) - (and (char-equal (char-after (point-at-bol)) ?<) - (char-equal (char-after (1+ (point-at-bol))) ?<))) - (set-match-data nil) - (setq found t)))) - ;; Match opening exclamation point (optional) and left bracket. - (when (match-beginning 2) - (let* ((bang (match-beginning 1)) - (first-begin (match-beginning 2)) - ;; Find end of block to prevent matching across blocks. - (end-of-block (save-excursion - (progn - (goto-char (match-beginning 2)) - (markdown-end-of-text-block) - (point)))) - ;; Move over balanced expressions to closing right bracket. - ;; Catch unbalanced expression errors and return nil. - (first-end (condition-case nil - (and (goto-char first-begin) - (scan-sexps (point) 1)) - (error nil))) - ;; Continue with point at CONT-POINT upon failure. - (cont-point (min (1+ first-begin) last)) - second-begin second-end url-begin url-end - title-begin title-end) - ;; When bracket found, in range, and followed by a left paren/bracket... - (when (and first-end (< first-end end-of-block) (goto-char first-end) - (char-equal (char-after (point)) (if ref ?\[ ?\())) - ;; Scan across balanced expressions for closing parenthesis/bracket. - (setq second-begin (point) - second-end (condition-case nil - (scan-sexps (point) 1) - (error nil))) - ;; Check that closing parenthesis/bracket is in range. - (if (and second-end (<= second-end end-of-block) (<= second-end last)) - (progn - ;; Search for (optional) title inside closing parenthesis - (when (and (not ref) (search-forward "\"" second-end t)) - (setq title-begin (1- (point)) - title-end (and (goto-char second-end) - (search-backward "\"" (1+ title-begin) t)) - title-end (and title-end (1+ title-end)))) - ;; Store URL/reference range - (setq url-begin (1+ second-begin) - url-end (1- (or title-begin second-end))) - ;; Set match data, move point beyond link, and return - (set-match-data - (list (or bang first-begin) second-end ; 0 - all - bang (and bang (1+ bang)) ; 1 - bang - first-begin (1+ first-begin) ; 2 - markup - (1+ first-begin) (1- first-end) ; 3 - link text - (1- first-end) first-end ; 4 - markup - second-begin (1+ second-begin) ; 5 - markup - url-begin url-end ; 6 - url/reference - title-begin title-end ; 7 - title - (1- second-end) second-end)) ; 8 - markup - ;; Nullify cont-point and leave point at end and - (setq cont-point nil) - (goto-char second-end)) - ;; If no closing parenthesis in range, update continuation point - (setq cont-point (min end-of-block second-begin)))) - (cond - ;; On failure, continue searching at cont-point - ((and cont-point (< cont-point last)) - (goto-char cont-point) - (markdown-match-generic-links last ref)) - ;; No more text, return nil - ((and cont-point (= cont-point last)) - nil) - ;; Return t if a match occurred - (t t))))) - -(defun markdown-match-angle-uris (last) - "Match angle bracket URIs from point to LAST." - (when (markdown-match-inline-generic markdown-regex-angle-uri last) - (goto-char (1+ (match-end 0))))) - -(defun markdown-match-plain-uris (last) - "Match plain URIs from point to LAST." - (when (markdown-match-inline-generic markdown-regex-uri last t) - (goto-char (1+ (match-end 0))))) - -(defvar markdown-conditional-search-function #'re-search-forward - "Conditional search function used in `markdown-search-until-condition'. -Made into a variable to allow for dynamic let-binding.") - -(defun markdown-search-until-condition (condition &rest args) - (let (ret) - (while (and (not ret) (apply markdown-conditional-search-function args)) - (setq ret (funcall condition))) - ret)) - -(defun markdown-match-generic-metadata (regexp last) - "Match metadata declarations specified by REGEXP from point to LAST. -These declarations must appear inside a metadata block that begins at -the beginning of the buffer and ends with a blank line (or the end of -the buffer)." - (let* ((first (point)) - (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") - (block-begin (goto-char 1)) - (block-end (re-search-forward end-re nil t))) - (if (and block-end (> first block-end)) - ;; Don't match declarations if there is no metadata block or if - ;; the point is beyond the block. Move point to point-max to - ;; prevent additional searches and return return nil since nothing - ;; was found. - (progn (goto-char (point-max)) nil) - ;; If a block was found that begins before LAST and ends after - ;; point, search for declarations inside it. If the starting is - ;; before the beginning of the block, start there. Otherwise, - ;; move back to FIRST. - (goto-char (if (< first block-begin) block-begin first)) - (if (re-search-forward regexp (min last block-end) t) - ;; If a metadata declaration is found, set match-data and return t. - (let ((key-beginning (match-beginning 1)) - (key-end (match-end 1)) - (markup-begin (match-beginning 2)) - (markup-end (match-end 2)) - (value-beginning (match-beginning 3))) - (set-match-data (list key-beginning (point) ; complete metadata - key-beginning key-end ; key - markup-begin markup-end ; markup - value-beginning (point))) ; value - t) - ;; Otherwise, move the point to last and return nil - (goto-char last) - nil)))) - -(defun markdown-match-declarative-metadata (last) - "Match declarative metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) - -(defun markdown-match-pandoc-metadata (last) - "Match Pandoc metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) - -(defun markdown-match-yaml-metadata-begin (last) - (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) - -(defun markdown-match-yaml-metadata-end (last) - (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) - -(defun markdown-match-yaml-metadata-key (last) - (markdown-match-propertized-text 'markdown-metadata-key last)) - -(defun markdown-match-wiki-link (last) - "Match wiki links from point to LAST." - (when (and markdown-enable-wiki-links - (not markdown-wiki-link-fontify-missing) - (markdown-match-inline-generic markdown-regex-wiki-link last)) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (if (or (markdown-in-comment-p begin) - (markdown-in-comment-p end) - (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p end) - (markdown-code-block-at-pos begin)) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-wiki-link last))) - (set-match-data (list begin end)) - t)))) - -(defun markdown-match-inline-attributes (last) - "Match inline attributes from point to LAST." - (when (markdown-match-inline-generic markdown-regex-inline-attributes last) - (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) - (markdown-inline-code-at-pos-p (match-end 0)) - (markdown-in-comment-p)) - t))) - -(defun markdown-match-leanpub-sections (last) - "Match Leanpub section markers from point to LAST." - (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) - (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) - (markdown-inline-code-at-pos-p (match-end 0)) - (markdown-in-comment-p)) - t))) - -(defun markdown-match-includes (last) - "Match include statements from point to LAST. -Sets match data for the following seven groups: -Group 1: opening two angle brackets -Group 2: opening title delimiter (optional) -Group 3: title text (optional) -Group 4: closing title delimiter (optional) -Group 5: opening filename delimiter -Group 6: filename -Group 7: closing filename delimiter" - (when (markdown-match-inline-generic markdown-regex-include last) - (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) - (markdown-in-comment-p (match-end 0)) - (markdown-code-block-at-pos (match-beginning 0)))))) - (cond - ;; Parentheses and maybe square brackets, but no curly braces: - ;; match optional title in square brackets and file in parentheses. - ((and valid (match-beginning 5) - (not (match-beginning 8))) - (set-match-data (list (match-beginning 1) (match-end 7) - (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4) - (match-beginning 5) (match-end 5) - (match-beginning 6) (match-end 6) - (match-beginning 7) (match-end 7)))) - ;; Only square brackets present: match file in square brackets. - ((and valid (match-beginning 2) - (not (match-beginning 5)) - (not (match-beginning 7))) - (set-match-data (list (match-beginning 1) (match-end 4) - (match-beginning 1) (match-end 1) - nil nil - nil nil - nil nil - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4)))) - ;; Only curly braces present: match file in curly braces. - ((and valid (match-beginning 8) - (not (match-beginning 2)) - (not (match-beginning 5))) - (set-match-data (list (match-beginning 1) (match-end 10) - (match-beginning 1) (match-end 1) - nil nil - nil nil - nil nil - (match-beginning 8) (match-end 8) - (match-beginning 9) (match-end 9) - (match-beginning 10) (match-end 10)))) - (t - ;; Not a valid match, move to next line and search again. - (forward-line) - (when (< (point) last) - (setq valid (markdown-match-includes last))))) - valid))) - -(defun markdown-match-html-tag (last) - "Match HTML tags from point to LAST." - (when (and markdown-enable-html - (markdown-match-inline-generic markdown-regex-html-tag last t)) - (set-match-data (list (match-beginning 0) (match-end 0) - (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 9) (match-end 9))) - t)) - - -;;; Markdown Font Fontification Functions ===================================== - -(defun markdown--first-displayable (seq) - "Return the first displayable character or string in SEQ. -SEQ may be an atom or a sequence." - (let ((seq (if (listp seq) seq (list seq)))) - (cond ((stringp (car seq)) - (cl-find-if - (lambda (str) - (and (mapcar #'char-displayable-p (string-to-list str)))) - seq)) - ((characterp (car seq)) - (cl-find-if #'char-displayable-p seq))))) - -(defun markdown--marginalize-string (level) - "Generate atx markup string of given LEVEL for left margin." - (let ((margin-left-space-count - (- markdown-marginalize-headers-margin-width level))) - (concat (make-string margin-left-space-count ? ) - (make-string level ?#)))) - -(defun markdown-marginalize-update-current () - "Update the window configuration to create a left margin." - ;; Emacs 25 or later is needed for window-font-width and default-font-width. - (if (and (fboundp 'window-font-width) (fboundp 'default-font-width)) - (let* ((header-delimiter-font-width - (window-font-width nil 'markdown-header-delimiter-face)) - (margin-pixel-width (* markdown-marginalize-headers-margin-width - header-delimiter-font-width)) - (margin-char-width (/ margin-pixel-width (default-font-width)))) - (set-window-margins nil margin-char-width)) - ;; As a fallback, simply set margin based on character count. - (set-window-margins nil markdown-marginalize-headers-margin-width))) - -(defun markdown-fontify-headings (last) - "Add text properties to headings from point to LAST." - (when (markdown-match-propertized-text 'markdown-heading last) - (let* ((level (markdown-outline-level)) - (heading-face - (intern (format "markdown-header-face-%d" level))) - (heading-props `(face ,heading-face)) - (left-markup-props - `(face markdown-header-delimiter-face - ,@(cond - (markdown-hide-markup - `(display "")) - (markdown-marginalize-headers - `(display ((margin left-margin) - ,(markdown--marginalize-string level))))))) - (right-markup-props - `(face markdown-header-delimiter-face - ,@(when markdown-hide-markup `(display "")))) - (rule-props `(face markdown-header-rule-face - ,@(when markdown-hide-markup `(display ""))))) - (if (match-end 1) - ;; Setext heading - (progn (add-text-properties - (match-beginning 1) (match-end 1) heading-props) - (if (= level 1) - (add-text-properties - (match-beginning 2) (match-end 2) rule-props) - (add-text-properties - (match-beginning 3) (match-end 3) rule-props))) - ;; atx heading - (add-text-properties - (match-beginning 4) (match-end 4) left-markup-props) - (add-text-properties - (match-beginning 5) (match-end 5) heading-props) - (when (match-end 6) - (add-text-properties - (match-beginning 6) (match-end 6) right-markup-props)))) - t)) - -(defun markdown-fontify-tables (last) - (when (and (re-search-forward "|" last t) - (markdown-table-at-point-p)) - (font-lock-append-text-property - (line-beginning-position) (min (1+ (line-end-position)) (point-max)) - 'face 'markdown-table-face) - (forward-line 1) - t)) - -(defun markdown-fontify-blockquotes (last) - "Apply font-lock properties to blockquotes from point to LAST." - (when (markdown-match-blockquotes last) - (let ((display-string - (markdown--first-displayable markdown-blockquote-display-char))) - (add-text-properties - (match-beginning 1) (match-end 1) - (if markdown-hide-markup - `(face markdown-blockquote-face display ,display-string) - `(face markdown-markup-face))) - (font-lock-append-text-property - (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) - t))) - -(defun markdown-fontify-list-items (last) - "Apply font-lock properties to list markers from point to LAST." - (when (markdown-match-list-items last) - (let* ((indent (length (match-string-no-properties 1))) - (level (/ indent 4)) ;; level = 0, 1, 2, ... - (bullet (nth (mod level (length markdown-list-item-bullets)) - markdown-list-item-bullets))) - (add-text-properties - (match-beginning 2) (match-end 2) '(face markdown-list-face)) - (when markdown-hide-markup - (cond - ;; Unordered lists - ((string-match-p "[\\*\\+-]" (match-string 2)) - (add-text-properties - (match-beginning 2) (match-end 2) `(display ,bullet))) - ;; Definition lists - ((string-equal ":" (match-string 2)) - (let ((display-string - (char-to-string (markdown--first-displayable - markdown-definition-display-char)))) - (add-text-properties (match-beginning 2) (match-end 2) - `(display ,display-string))))))) - t)) - -(defun markdown-fontify-hrs (last) - "Add text properties to horizontal rules from point to LAST." - (when (markdown-match-hr last) - (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face markdown-hr-face - font-lock-multiline t - ,@(when (and markdown-hide-markup hr-char) - `(display ,(make-string - (window-body-width) hr-char))))) - t))) - -(defun markdown-fontify-sub-superscripts (last) - "Apply text properties to sub- and superscripts from point to LAST." - (when (markdown-search-until-condition - (lambda () (and (not (markdown-code-block-at-point-p)) - (not (markdown-inline-code-at-point-p)) - (not (markdown-in-comment-p)))) - markdown-regex-sub-superscript last t) - (let* ((subscript-p (string= (match-string 2) "~")) - (props - (if subscript-p - (car markdown-sub-superscript-display) - (cdr markdown-sub-superscript-display))) - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup))) - (when markdown-hide-markup - (put-text-property (match-beginning 3) (match-end 3) - 'display props)) - (add-text-properties (match-beginning 2) (match-end 2) mp) - (add-text-properties (match-beginning 4) (match-end 4) mp) - t))) - - -;;; Syntax Table ============================================================== - -(defvar markdown-mode-syntax-table - (let ((tab (make-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?\" "." tab) - tab) - "Syntax table for `markdown-mode'.") - - -;;; Element Insertion ========================================================= - -(defun markdown-ensure-blank-line-before () - "If previous line is not already blank, insert a blank line before point." - (unless (bolp) (insert "\n")) - (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) - -(defun markdown-ensure-blank-line-after () - "If following line is not already blank, insert a blank line after point. -Return the point where it was originally." - (save-excursion - (unless (eolp) (insert "\n")) - (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) - -(defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) - "Insert the strings S1 and S2, wrapping around region or THING. -If a region is specified by the optional BEG and END arguments, -wrap the strings S1 and S2 around that region. -If there is an active region, wrap the strings S1 and S2 around -the region. If there is not an active region but the point is at -THING, wrap that thing (which defaults to word). Otherwise, just -insert S1 and S2 and place the point in between. Return the -bounds of the entire wrapped string, or nil if nothing was wrapped -and S1 and S2 were only inserted." - (let (a b bounds new-point) - (cond - ;; Given region - ((and beg end) - (setq a beg - b end - new-point (+ (point) (length s1)))) - ;; Active region - ((markdown-use-region-p) - (setq a (region-beginning) - b (region-end) - new-point (+ (point) (length s1)))) - ;; Thing (word) at point - ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) - (setq a (car bounds) - b (cdr bounds) - new-point (+ (point) (length s1)))) - ;; No active region and no word - (t - (setq a (point) - b (point)))) - (goto-char b) - (insert s2) - (goto-char a) - (insert s1) - (when new-point (goto-char new-point)) - (if (= a b) - nil - (setq b (+ b (length s1) (length s2))) - (cons a b)))) - -(defun markdown-point-after-unwrap (cur prefix suffix) - "Return desired position of point after an unwrapping operation. -CUR gives the position of the point before the operation. -Additionally, two cons cells must be provided. PREFIX gives the -bounds of the prefix string and SUFFIX gives the bounds of the -suffix string." - (cond ((< cur (cdr prefix)) (car prefix)) - ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) - ((<= cur (cdr suffix)) - (- cur (+ (- (cdr prefix) (car prefix)) - (- cur (car suffix))))) - (t cur))) - -(defun markdown-unwrap-thing-at-point (regexp all text) - "Remove prefix and suffix of thing at point and reposition the point. -When the thing at point matches REGEXP, replace the subexpression -ALL with the string in subexpression TEXT. Reposition the point -in an appropriate location accounting for the removal of prefix -and suffix strings. Return new bounds of string from group TEXT. -When REGEXP is nil, assumes match data is already set." - (when (or (null regexp) - (thing-at-point-looking-at regexp)) - (let ((cur (point)) - (prefix (cons (match-beginning all) (match-beginning text))) - (suffix (cons (match-end text) (match-end all))) - (bounds (cons (match-beginning text) (match-end text)))) - ;; Replace the thing at point - (replace-match (match-string text) t t nil all) - ;; Reposition the point - (goto-char (markdown-point-after-unwrap cur prefix suffix)) - ;; Adjust bounds - (setq bounds (cons (car prefix) - (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) - -(defun markdown-unwrap-things-in-region (beg end regexp all text) - "Remove prefix and suffix of all things in region from BEG to END. -When a thing in the region matches REGEXP, replace the -subexpression ALL with the string in subexpression TEXT. -Return a cons cell containing updated bounds for the region." - (save-excursion - (goto-char beg) - (let ((removed 0) len-all len-text) - (while (re-search-forward regexp (- end removed) t) - (setq len-all (length (match-string-no-properties all))) - (setq len-text (length (match-string-no-properties text))) - (setq removed (+ removed (- len-all len-text))) - (replace-match (match-string text) t t nil all)) - (cons beg (- end removed))))) - -(defun markdown-insert-hr (arg) - "Insert or replace a horizonal rule. -By default, use the first element of `markdown-hr-strings'. When -ARG is non-nil, as when given a prefix, select a different -element as follows. When prefixed with \\[universal-argument], -use the last element of `markdown-hr-strings' instead. When -prefixed with an integer from 1 to the length of -`markdown-hr-strings', use the element in that position instead." - (interactive "*P") - (when (thing-at-point-looking-at markdown-regex-hr) - (delete-region (match-beginning 0) (match-end 0))) - (markdown-ensure-blank-line-before) - (cond ((equal arg '(4)) - (insert (car (reverse markdown-hr-strings)))) - ((and (integerp arg) (> arg 0) - (<= arg (length markdown-hr-strings))) - (insert (nth (1- arg) markdown-hr-strings))) - (t - (insert (car markdown-hr-strings)))) - (markdown-ensure-blank-line-after)) - -(defun markdown-insert-bold () - "Insert markup to make a region or word bold. -If there is an active region, make the region bold. If the point -is at a non-bold word, make the word bold. If the point is at a -bold word or phrase, remove the bold markup. Otherwise, simply -insert bold delimiters and place the point in between them." - (interactive) - (let ((delim (if markdown-bold-underscore "__" "**"))) - (if (markdown-use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-bold 2 4))) - (markdown-wrap-or-insert delim delim nil (car bounds) (cdr bounds))) - ;; Bold markup removal, bold word at point, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-bold) - (markdown-unwrap-thing-at-point nil 2 4) - (markdown-wrap-or-insert delim delim 'word nil nil))))) - -(defun markdown-insert-italic () - "Insert markup to make a region or word italic. -If there is an active region, make the region italic. If the point -is at a non-italic word, make the word italic. If the point is at an -italic word or phrase, remove the italic markup. Otherwise, simply -insert italic delimiters and place the point in between them." - (interactive) - (let ((delim (if markdown-italic-underscore "_" "*"))) - (if (markdown-use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-italic 1 3))) - (markdown-wrap-or-insert delim delim nil (car bounds) (cdr bounds))) - ;; Italic markup removal, italic word at point, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-italic) - (markdown-unwrap-thing-at-point nil 1 3) - (markdown-wrap-or-insert delim delim 'word nil nil))))) - -(defun markdown-insert-strike-through () - "Insert markup to make a region or word strikethrough. -If there is an active region, make the region strikethrough. If the point -is at a non-bold word, make the word strikethrough. If the point is at a -strikethrough word or phrase, remove the strikethrough markup. Otherwise, -simply insert bold delimiters and place the point in between them." - (interactive) - (let ((delim "~~")) - (if (markdown-use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-strike-through 2 4))) - (markdown-wrap-or-insert delim delim nil (car bounds) (cdr bounds))) - ;; Strikethrough markup removal, strikethrough word at point, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-strike-through) - (markdown-unwrap-thing-at-point nil 2 4) - (markdown-wrap-or-insert delim delim 'word nil nil))))) - -(defun markdown-insert-code () - "Insert markup to make a region or word an inline code fragment. -If there is an active region, make the region an inline code -fragment. If the point is at a word, make the word an inline -code fragment. Otherwise, simply insert code delimiters and -place the point in between them." - (interactive) - (if (markdown-use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-code 1 3))) - (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) - ;; Code markup removal, code markup for word, or empty markup insertion - (if (markdown-inline-code-at-point) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "`" "`" 'word nil nil)))) - -(defun markdown-insert-kbd () - "Insert markup to wrap region or word in <kbd> tags. -If there is an active region, use the region. If the point is at -a word, use the word. Otherwise, simply insert <kbd> tags and -place the point in between them." - (interactive) - (if (markdown-use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-kbd 0 2))) - (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) - ;; Markup removal, markup for word, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-kbd) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) - -(defun markdown-insert-inline-link (text url &optional title) - "Insert an inline link with TEXT pointing to URL. -Optionally, the user can provide a TITLE." - (let ((cur (point))) - (setq title (and title (concat " \"" title "\""))) - (insert (concat "[" text "](" url title ")")) - (cond ((not text) (goto-char (+ 1 cur))) - ((not url) (goto-char (+ 3 (length text) cur)))))) - -(defun markdown-insert-inline-image (text url &optional title) - "Insert an inline link with alt TEXT pointing to URL. -Optionally, also provide a TITLE." - (let ((cur (point))) - (setq title (and title (concat " \"" title "\""))) - (insert (concat "![" text "](" url title ")")) - (cond ((not text) (goto-char (+ 2 cur))) - ((not url) (goto-char (+ 4 (length text) cur)))))) - -(defun markdown-insert-reference-link (text label &optional url title) - "Insert a reference link and, optionally, a reference definition. -The link TEXT will be inserted followed by the optional LABEL. -If a URL is given, also insert a definition for the reference -LABEL according to `markdown-reference-location'. If a TITLE is -given, it will be added to the end of the reference definition -and will be used to populate the title attribute when converted -to XHTML. If URL is nil, insert only the link portion (for -example, when a reference label is already defined)." - (insert (concat "[" text "][" label "]")) - (when url - (markdown-insert-reference-definition - (if (string-equal label "") text label) - url title))) - -(defun markdown-insert-reference-image (text label &optional url title) - "Insert a reference image and, optionally, a reference definition. -The alt TEXT will be inserted followed by the optional LABEL. -If a URL is given, also insert a definition for the reference -LABEL according to `markdown-reference-location'. If a TITLE is -given, it will be added to the end of the reference definition -and will be used to populate the title attribute when converted -to XHTML. If URL is nil, insert only the link portion (for -example, when a reference label is already defined)." - (insert (concat "![" text "][" label "]")) - (when url - (markdown-insert-reference-definition - (if (string-equal label "") text label) - url title))) - -(defun markdown-insert-reference-definition (label &optional url title) - "Add definition for reference LABEL with URL and TITLE. -LABEL is a Markdown reference label without square brackets. -URL and TITLE are optional. When given, the TITLE will -be used to populate the title attribute when converted to XHTML." - ;; END specifies where to leave the point upon return - (let ((end (point))) - (cl-case markdown-reference-location - (end (goto-char (point-max))) - (immediately (markdown-end-of-text-block)) - (subtree (markdown-end-of-subtree)) - (header (markdown-end-of-defun))) - ;; Skip backwards over local variables. This logic is similar to the one - ;; used in ‘hack-local-variables’. - (when (and enable-local-variables (eobp)) - (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) - (when (let ((case-fold-search t)) - (search-forward "Local Variables:" nil :move)) - (beginning-of-line 0) - (when (eq (char-before) ?\n) (backward-char)))) - (unless (or (markdown-cur-line-blank-p) - (thing-at-point-looking-at markdown-regex-reference-definition)) - (insert "\n")) - (insert "\n[" label "]: ") - (if url - (insert url) - ;; When no URL is given, leave point at END following the colon - (setq end (point))) - (when (> (length title) 0) - (insert " \"" title "\"")) - (unless (looking-at-p "\n") - (insert "\n")) - (goto-char end) - (when url - (message - (markdown--substitute-command-keys - "Reference [%s] was defined, press \\[markdown-do] to jump there") - label)))) - -(define-obsolete-function-alias - 'markdown-insert-inline-link-dwim 'markdown-insert-link "v2.3") -(define-obsolete-function-alias - 'markdown-insert-reference-link-dwim 'markdown-insert-link "v2.3") - -(defun markdown--insert-link-or-image (image) - "Interactively insert new or update an existing link or image. -When IMAGE is non-nil, insert an image. Otherwise, insert a link. -This is an internal function called by -`markdown-insert-link' and `markdown-insert-image'." - (cl-multiple-value-bind (begin end text uri ref title) - (if (markdown-use-region-p) - ;; Use region as either link text or URL as appropriate. - (let ((region (buffer-substring-no-properties - (region-beginning) (region-end)))) - (if (string-match markdown-regex-uri region) - ;; Region contains a URL; use it as such. - (list (region-beginning) (region-end) - nil (match-string 0 region) nil nil) - ;; Region doesn't contain a URL, so use it as text. - (list (region-beginning) (region-end) - region nil nil nil))) - ;; Extract and use properties of existing link, if any. - (markdown-link-at-pos (point))) - (let* ((ref (when ref (concat "[" ref "]"))) - (defined-refs (append - (mapcar (lambda (ref) (concat "[" ref "]")) - (mapcar #'car (markdown-get-defined-references))))) - (used-uris (markdown-get-used-uris)) - (uri-or-ref (completing-read - "URL or [reference]: " - (append defined-refs used-uris) - nil nil (or uri ref))) - (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) - (match-string 1 uri-or-ref)) - ((string-equal "" uri-or-ref) - ""))) - (uri (unless ref uri-or-ref)) - (text-prompt (if image - "Alt text: " - (if ref - "Link text: " - "Link text (blank for plain URL): "))) - (text (read-string text-prompt text)) - (text (if (= (length text) 0) nil text)) - (plainp (and uri (not text))) - (implicitp (string-equal ref "")) - (ref (if implicitp text ref)) - (definedp (and ref (markdown-reference-definition ref))) - (ref-url (unless (or uri definedp) - (completing-read "Reference URL: " used-uris))) - (title (unless (or plainp definedp) - (read-string "Title (tooltip text, optional): " title))) - (title (if (= (length title) 0) nil title))) - (when (and image implicitp) - (user-error "Reference required: implicit image references are invalid")) - (when (and begin end) - (delete-region begin end)) - (cond - ((and (not image) uri text) - (markdown-insert-inline-link text uri title)) - ((and image uri text) - (markdown-insert-inline-image text uri title)) - ((and ref text) - (if image - (markdown-insert-reference-image text (unless implicitp ref) nil title) - (markdown-insert-reference-link text (unless implicitp ref) nil title)) - (unless definedp - (markdown-insert-reference-definition ref ref-url title))) - ((and (not image) uri) - (markdown-insert-uri uri)))))) - -(defun markdown-insert-link () - "Insert new or update an existing link, with interactive prompts. -If the point is at an existing link or URL, update the link text, -URL, reference label, and/or title. Otherwise, insert a new link. -The type of link inserted (inline, reference, or plain URL) -depends on which values are provided: - -* If a URL and TEXT are given, insert an inline link: [TEXT](URL). -* If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. -* If only TEXT is given, insert an implicit reference link: [TEXT][]. -* If only a URL is given, insert a plain link: <URL>. - -In other words, to create an implicit reference link, leave the -URL prompt empty and to create a plain URL link, leave the link -text empty. - -If there is an active region, use the text as the default URL, if -it seems to be a URL, or link text value otherwise. - -If a given reference is not defined, this function will -additionally prompt for the URL and optional title. In this case, -the reference definition is placed at the location determined by -`markdown-reference-location'. - -Through updating the link, this function can be used to convert a -link of one type (inline, reference, or plain) to another type by -selectively adding or removing information via the prompts." - (interactive) - (markdown--insert-link-or-image nil)) - -(defun markdown-insert-image () - "Insert new or update an existing image, with interactive prompts. -If the point is at an existing image, update the alt text, URL, -reference label, and/or title. Otherwise, insert a new image. -The type of image inserted (inline or reference) depends on which -values are provided: - -* If a URL and ALT-TEXT are given, insert an inline image: - . -* If [REF] and ALT-TEXT are given, insert a reference image: - ![ALT-TEXT][REF]. - -If there is an active region, use the text as the default URL, if -it seems to be a URL, or alt text value otherwise. - -If a given reference is not defined, this function will -additionally prompt for the URL and optional title. In this case, -the reference definition is placed at the location determined by -`markdown-reference-location'. - -Through updating the image, this function can be used to convert an -image of one type (inline or reference) to another type by -selectively adding or removing information via the prompts." - (interactive) - (markdown--insert-link-or-image t)) - -(defun markdown-insert-uri (&optional uri) - "Insert markup for an inline URI. -If there is an active region, use it as the URI. If the point is -at a URI, wrap it with angle brackets. If the point is at an -inline URI, remove the angle brackets. Otherwise, simply insert -angle brackets place the point between them." - (interactive) - (if (markdown-use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-angle-uri 0 2))) - (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) - ;; Markup removal, URI at point, new URI, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-angle-uri) - (markdown-unwrap-thing-at-point nil 0 2) - (if uri - (insert "<" uri ">") - (markdown-wrap-or-insert "<" ">" 'url nil nil))))) - -(defun markdown-insert-wiki-link () - "Insert a wiki link of the form [[WikiLink]]. -If there is an active region, use the region as the link text. -If the point is at a word, use the word as the link text. If -there is no active region and the point is not at word, simply -insert link markup." - (interactive) - (if (markdown-use-region-p) - ;; Active region - (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) - ;; Markup removal, wiki link at at point, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-wiki-link) - (if (or markdown-wiki-link-alias-first - (null (match-string 5))) - (markdown-unwrap-thing-at-point nil 1 3) - (markdown-unwrap-thing-at-point nil 1 5)) - (markdown-wrap-or-insert "[[" "]]")))) - -(defun markdown-remove-header () - "Remove header markup if point is at a header. -Return bounds of remaining header text if a header was removed -and nil otherwise." - (interactive "*") - (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) - (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) - -(defun markdown-insert-header (&optional level text setext) - "Insert or replace header markup. -The level of the header is specified by LEVEL and header text is -given by TEXT. LEVEL must be an integer from 1 and 6, and the -default value is 1. -When TEXT is nil, the header text is obtained as follows. -If there is an active region, it is used as the header text. -Otherwise, the current line will be used as the header text. -If there is not an active region and the point is at a header, -remove the header markup and replace with level N header. -Otherwise, insert empty header markup and place the point in -between. -The style of the header will be atx (hash marks) unless -SETEXT is non-nil, in which case a setext-style (underlined) -header will be inserted." - (interactive "p\nsHeader text: ") - (setq level (min (max (or level 1) 1) (if setext 2 6))) - ;; Determine header text if not given - (when (null text) - (if (markdown-use-region-p) - ;; Active region - (setq text (delete-and-extract-region (region-beginning) (region-end))) - ;; No active region - (markdown-remove-header) - (setq text (delete-and-extract-region - (line-beginning-position) (line-end-position))) - (when (and setext (string-match-p "^[ \t]*$" text)) - (setq text (read-string "Header text: ")))) - (setq text (markdown-compress-whitespace-string text))) - ;; Insertion with given text - (markdown-ensure-blank-line-before) - (let (hdr) - (cond (setext - (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) - (insert text "\n" hdr)) - (t - (setq hdr (make-string level ?#)) - (insert hdr " " text) - (when (null markdown-asymmetric-header) (insert " " hdr))))) - (markdown-ensure-blank-line-after) - ;; Leave point at end of text - (cond (setext - (backward-char (1+ (string-width text)))) - ((null markdown-asymmetric-header) - (backward-char (1+ level))))) - -(defun markdown-insert-header-dwim (&optional arg setext) - "Insert or replace header markup. -The level and type of the header are determined automatically by -the type and level of the previous header, unless a prefix -argument is given via ARG. -With a numeric prefix valued 1 to 6, insert a header of the given -level, with the type being determined automatically (note that -only level 1 or 2 setext headers are possible). - -With a \\[universal-argument] prefix (i.e., when ARG is (4)), -promote the heading by one level. -With two \\[universal-argument] prefixes (i.e., when ARG is (16)), -demote the heading by one level. -When SETEXT is non-nil, prefer setext-style headers when -possible (levels one and two). - -When there is an active region, use it for the header text. When -the point is at an existing header, change the type and level -according to the rules above. -Otherwise, if the line is not empty, create a header using the -text on the current line as the header text. -Finally, if the point is on a blank line, insert empty header -markup (atx) or prompt for text (setext). -See `markdown-insert-header' for more details about how the -header text is determined." - (interactive "*P") - (let (level) - (save-excursion - (when (or (thing-at-point-looking-at markdown-regex-header) - (re-search-backward markdown-regex-header nil t)) - ;; level of current or previous header - (setq level (markdown-outline-level)) - ;; match group 1 indicates a setext header - (setq setext (match-end 1)))) - ;; check prefix argument - (cond - ((and (equal arg '(4)) level (> level 1)) ;; C-u - (cl-decf level)) - ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u - (cl-incf level)) - (arg ;; numeric prefix - (setq level (prefix-numeric-value arg)))) - ;; setext headers must be level one or two - (and level (setq setext (and setext (<= level 2)))) - ;; insert the heading - (markdown-insert-header level nil setext))) - -(defun markdown-insert-header-setext-dwim (&optional arg) - "Insert or replace header markup, with preference for setext. -See `markdown-insert-header-dwim' for details, including how ARG is handled." - (interactive "*P") - (markdown-insert-header-dwim arg t)) - -(defun markdown-insert-header-atx-1 () - "Insert a first level atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 1 nil nil)) - -(defun markdown-insert-header-atx-2 () - "Insert a level two atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 2 nil nil)) - -(defun markdown-insert-header-atx-3 () - "Insert a level three atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 3 nil nil)) - -(defun markdown-insert-header-atx-4 () - "Insert a level four atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 4 nil nil)) - -(defun markdown-insert-header-atx-5 () - "Insert a level five atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 5 nil nil)) - -(defun markdown-insert-header-atx-6 () - "Insert a sixth level atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 6 nil nil)) - -(defun markdown-insert-header-setext-1 () - "Insert a setext-style (underlined) first-level header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 1 nil t)) - -(defun markdown-insert-header-setext-2 () - "Insert a setext-style (underlined) second-level header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 2 nil t)) - -(defun markdown-blockquote-indentation (loc) - "Return string containing necessary indentation for a blockquote at LOC. -Also see `markdown-pre-indentation'." - (save-excursion - (goto-char loc) - (let* ((list-level (length (markdown-calculate-list-levels))) - (indent "")) - (dotimes (_ list-level indent) - (setq indent (concat indent " ")))))) - -(defun markdown-insert-blockquote () - "Start a blockquote section (or blockquote the region). -If Transient Mark mode is on and a region is active, it is used as -the blockquote text." - (interactive) - (if (markdown-use-region-p) - (markdown-blockquote-region (region-beginning) (region-end)) - (markdown-ensure-blank-line-before) - (insert (markdown-blockquote-indentation (point)) "> ") - (markdown-ensure-blank-line-after))) - -(defun markdown-block-region (beg end prefix) - "Format the region using a block prefix. -Arguments BEG and END specify the beginning and end of the -region. The characters PREFIX will appear at the beginning -of each line." - (save-excursion - (let* ((end-marker (make-marker)) - (beg-marker (make-marker)) - (prefix-without-trailing-whitespace - (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) - ;; Ensure blank line after and remove extra whitespace - (goto-char end) - (skip-syntax-backward "-") - (set-marker end-marker (point)) - (delete-horizontal-space) - (markdown-ensure-blank-line-after) - ;; Ensure blank line before and remove extra whitespace - (goto-char beg) - (skip-syntax-forward "-") - (delete-horizontal-space) - (markdown-ensure-blank-line-before) - (set-marker beg-marker (point)) - ;; Insert PREFIX before each line - (goto-char beg-marker) - (while (and (< (line-beginning-position) end-marker) - (not (eobp))) - ;; Don’t insert trailing whitespace. - (insert (if (eolp) prefix-without-trailing-whitespace prefix)) - (forward-line))))) - -(defun markdown-blockquote-region (beg end) - "Blockquote the region. -Arguments BEG and END specify the beginning and end of the region." - (interactive "*r") - (markdown-block-region - beg end (concat (markdown-blockquote-indentation - (max (point-min) (1- beg))) "> "))) - -(defun markdown-pre-indentation (loc) - "Return string containing necessary whitespace for a pre block at LOC. -Also see `markdown-blockquote-indentation'." - (save-excursion - (goto-char loc) - (let* ((list-level (length (markdown-calculate-list-levels))) - indent) - (dotimes (_ (1+ list-level) indent) - (setq indent (concat indent " ")))))) - -(defun markdown-insert-pre () - "Start a preformatted section (or apply to the region). -If Transient Mark mode is on and a region is active, it is marked -as preformatted text." - (interactive) - (if (markdown-use-region-p) - (markdown-pre-region (region-beginning) (region-end)) - (markdown-ensure-blank-line-before) - (insert (markdown-pre-indentation (point))) - (markdown-ensure-blank-line-after))) - -(defun markdown-pre-region (beg end) - "Format the region as preformatted text. -Arguments BEG and END specify the beginning and end of the region." - (interactive "*r") - (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) - (markdown-block-region beg end indent))) - -(defun markdown-electric-backquote (arg) - "Insert a backquote. -The numeric prefix argument ARG says how many times to repeat the insertion. -Call `markdown-insert-gfm-code-block' interactively -if three backquotes inserted at the beginning of line." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) - (replace-match "") - (call-interactively #'markdown-insert-gfm-code-block))) - -(defconst markdown-gfm-recognized-languages - ;; To reproduce/update, evaluate the let-form in - ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, - ;; but with appropriate use of a keyboard macro, indenting and filling it - ;; properly is pretty fast. - '("1C-Enterprise" "ABAP" "ABNF" "AGS-Script" "AMPL" "ANTLR" - "API-Blueprint" "APL" "ASN.1" "ASP" "ATS" "ActionScript" "Ada" "Agda" - "Alloy" "Alpine-Abuild" "Ant-Build-System" "ApacheConf" "Apex" - "Apollo-Guidance-Computer" "AppleScript" "Arc" "Arduino" "AsciiDoc" - "AspectJ" "Assembly" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Batchfile" - "Befunge" "Bison" "BitBake" "Blade" "BlitzBasic" "BlitzMax" "Bluespec" - "Boo" "Brainfuck" "Brightscript" "Bro" "C#" "C++" "C-ObjDump" - "C2hs-Haskell" "CLIPS" "CMake" "COBOL" "COLLADA" "CSON" "CSS" "CSV" - "CWeb" "Cap'n-Proto" "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK" - "Cirru" "Clarion" "Clean" "Click" "Clojure" "Closure-Templates" - "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" - "Component-Pascal" "Cool" "Coq" "Cpp-ObjDump" "Creole" "Crystal" - "Csound" "Csound-Document" "Csound-Score" "Cuda" "Cycript" "Cython" - "D-ObjDump" "DIGITAL-Command-Language" "DM" "DNS-Zone" "DTrace" - "Darcs-Patch" "Dart" "Diff" "Dockerfile" "Dogescript" "Dylan" "EBNF" - "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Ecere-Projects" "Eiffel" "Elixir" - "Elm" "Emacs-Lisp" "EmberScript" "Erlang" "F#" "FLUX" "Factor" "Fancy" - "Fantom" "Filebench-WML" "Filterscript" "Formatted" "Forth" "Fortran" - "FreeMarker" "Frege" "G-code" "GAMS" "GAP" "GCC-Machine-Description" - "GDB" "GDScript" "GLSL" "GN" "Game-Maker-Language" "Genie" "Genshi" - "Gentoo-Ebuild" "Gentoo-Eclass" "Gettext-Catalog" "Gherkin" "Glyph" - "Gnuplot" "Go" "Golo" "Gosu" "Grace" "Gradle" "Grammatical-Framework" - "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" - "Groovy-Server-Pages" "HCL" "HLSL" "HTML" "HTML+Django" "HTML+ECR" - "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTTP" "Hack" "Haml" "Handlebars" - "Harbour" "Haskell" "Haxe" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" - "IRC-log" "Idris" "Inform-7" "Inno-Setup" "Io" "Ioke" "Isabelle" - "Isabelle-ROOT" "JFlex" "JSON" "JSON5" "JSONLD" "JSONiq" "JSX" - "Jasmin" "Java" "Java-Server-Pages" "JavaScript" "Jison" "Jison-Lex" - "Jolie" "Julia" "Jupyter-Notebook" "KRL" "KiCad" "Kit" "Kotlin" "LFE" - "LLVM" "LOLCODE" "LSL" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex" - "LilyPond" "Limbo" "Linker-Script" "Linux-Kernel-Module" "Liquid" - "Literate-Agda" "Literate-CoffeeScript" "Literate-Haskell" - "LiveScript" "Logos" "Logtalk" "LookML" "LoomScript" "Lua" "M4" - "M4Sugar" "MAXScript" "MQL4" "MQL5" "MTML" "MUF" "Makefile" "Mako" - "Markdown" "Marko" "Mask" "Mathematica" "Matlab" "Maven-POM" "Max" - "MediaWiki" "Mercury" "Meson" "Metal" "MiniD" "Mirah" "Modelica" - "Modula-2" "Module-Management-System" "Monkey" "Moocode" "MoonScript" - "Myghty" "NCL" "NL" "NSIS" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" - "NewLisp" "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml" - "ObjDump" "Objective-C" "Objective-C++" "Objective-J" "Omgrofl" "Opa" - "Opal" "OpenCL" "OpenEdge-ABL" "OpenRC-runscript" "OpenSCAD" - "OpenType-Feature-File" "Org" "Ox" "Oxygene" "Oz" "P4" "PAWN" "PHP" - "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pan" "Papyrus" "Parrot" - "Parrot-Assembly" "Parrot-Internal-Representation" "Pascal" "Pep8" - "Perl" "Perl6" "Pic" "Pickle" "PicoLisp" "PigLatin" "Pike" "Pod" - "PogoScript" "Pony" "PostScript" "PowerBuilder" "PowerShell" - "Processing" "Prolog" "Propeller-Spin" "Protocol-Buffer" "Public-Key" - "Pug" "Puppet" "Pure-Data" "PureBasic" "PureScript" "Python" - "Python-console" "Python-traceback" "QML" "QMake" "RAML" "RDoc" - "REALbasic" "REXX" "RHTML" "RMarkdown" "RPM-Spec" "RUNOFF" "Racket" - "Ragel" "Rascal" "Raw-token-data" "Reason" "Rebol" "Red" "Redcode" - "Regular-Expression" "Ren'Py" "RenderScript" "RobotFramework" "Roff" - "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" "SPARQL" "SQF" "SQL" "SQLPL" - "SRecode-Template" "STON" "SVG" "Sage" "SaltStack" "Sass" "Scala" - "Scaml" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" "ShellSession" - "Shen" "Slash" "Slim" "Smali" "Smalltalk" "Smarty" "SourcePawn" - "Spline-Font-Database" "Squirrel" "Stan" "Standard-ML" "Stata" - "Stylus" "SubRip-Text" "Sublime-Text-Config" "SuperCollider" "Swift" - "SystemVerilog" "TI-Program" "TLA" "TOML" "TXL" "Tcl" "Tcsh" "TeX" - "Tea" "Terra" "Text" "Textile" "Thrift" "Turing" "Turtle" "Twig" - "Type-Language" "TypeScript" "Unified-Parallel-C" "Unity3D-Asset" - "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "VCL" "VHDL" "Vala" - "Verilog" "Vim-script" "Visual-Basic" "Volt" "Vue" - "Wavefront-Material" "Wavefront-Object" "Web-Ontology-Language" - "WebAssembly" "WebIDL" "World-of-Warcraft-Addon-Data" "X10" "XC" - "XCompose" "XML" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" "Xtend" - "YAML" "YANG" "Yacc" "Zephir" "Zimpl" "desktop" "eC" "edn" "fish" - "mupad" "nesC" "ooc" "reStructuredText" "wisp" "xBase") - "Language specifiers recognized by GitHub's syntax highlighting features.") - -(defvar markdown-gfm-used-languages nil - "Language names used in GFM code blocks.") -(make-variable-buffer-local 'markdown-gfm-used-languages) - -(defun markdown-trim-whitespace (str) - (markdown-replace-regexp-in-string - "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) - -(defun markdown-clean-language-string (str) - (markdown-replace-regexp-in-string - "{\\.?\\|}" "" (markdown-trim-whitespace str))) - -(defun markdown-validate-language-string (widget) - (let ((str (widget-value widget))) - (unless (string= str (markdown-clean-language-string str)) - (widget-put widget :error (format "Invalid language spec: '%s'" str)) - widget))) - -(defun markdown-gfm-get-corpus () - "Create corpus of recognized GFM code block languages for the given buffer." - (let ((given-corpus (append markdown-gfm-additional-languages - markdown-gfm-recognized-languages))) - (append - markdown-gfm-used-languages - (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) - given-corpus)))) - -(defun markdown-gfm-add-used-language (lang) - "Clean LANG and add to list of used languages." - (setq markdown-gfm-used-languages - (cons lang (remove lang markdown-gfm-used-languages)))) - -(defcustom markdown-spaces-after-code-fence 1 - "Number of space characters to insert after a code fence. -\\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an -opening code fence and an info string." - :group 'markdown - :type 'integer - :safe #'natnump - :package-version '(markdown-mode . "2.3")) - -(defun markdown-insert-gfm-code-block (&optional lang edit) - "Insert GFM code block for language LANG. -If LANG is nil, the language will be queried from user. If a -region is active, wrap this region with the markup instead. If -the region boundaries are not on empty lines, these are added -automatically in order to have the correct markup. When EDIT is -non-nil (e.g., when \\[universal-argument] is given), edit the -code block in an indirect buffer after insertion." - (interactive - (list (let ((completion-ignore-case nil)) - (condition-case nil - (markdown-clean-language-string - (completing-read - "Programming language: " - (markdown-gfm-get-corpus) - nil 'confirm (car markdown-gfm-used-languages) - 'markdown-gfm-language-history)) - (quit ""))) - current-prefix-arg)) - (unless (string= lang "") (markdown-gfm-add-used-language lang)) - (when (> (length lang) 0) - (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) - lang))) - (if (markdown-use-region-p) - (let* ((b (region-beginning)) (e (region-end)) end - (indent (progn (goto-char b) (current-indentation)))) - (goto-char e) - ;; if we're on a blank line, don't newline, otherwise the ``` - ;; should go on its own line - (unless (looking-back "\n" nil) - (newline)) - (indent-to indent) - (insert "```") - (markdown-ensure-blank-line-after) - (setq end (point)) - (goto-char b) - ;; if we're on a blank line, insert the quotes here, otherwise - ;; add a new line first - (unless (looking-at-p "\n") - (newline) - (forward-line -1)) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert "```" lang) - (markdown-syntax-propertize-fenced-block-constructs (point-at-bol) end)) - (let ((indent (current-indentation)) start-bol) - (delete-horizontal-space :backward-only) - (markdown-ensure-blank-line-before) - (indent-to indent) - (setq start-bol (point-at-bol)) - (insert "```" lang "\n") - (indent-to indent) - (unless edit (insert ?\n)) - (indent-to indent) - (insert "```") - (markdown-ensure-blank-line-after) - (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) - (end-of-line 0) - (when edit (markdown-edit-code-block)))) - -(defun markdown-code-block-lang (&optional pos-prop) - "Return the language name for a GFM or tilde fenced code block. -The beginning of the block may be described by POS-PROP, -a cons of (pos . prop) giving the position and property -at the beginning of the block." - (or pos-prop - (setq pos-prop - (markdown-max-of-seq - #'car - (cl-remove-if - #'null - (cl-mapcar - #'markdown-find-previous-prop - (markdown-get-fenced-block-begin-properties)))))) - (when pos-prop - (goto-char (car pos-prop)) - (set-match-data (get-text-property (point) (cdr pos-prop))) - ;; Note: Hard-coded group number assumes tilde - ;; and GFM fenced code regexp groups agree. - (let ((begin (match-beginning 3)) - (end (match-end 3))) - (when (and begin end) - ;; Fix language strings beginning with periods, like ".ruby". - (when (eq (char-after begin) ?.) - (setq begin (1+ begin))) - (buffer-substring-no-properties begin end))))) - -(defun markdown-gfm-parse-buffer-for-languages (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (goto-char (point-min)) - (cl-loop - with prop = 'markdown-gfm-block-begin - for pos-prop = (markdown-find-next-prop prop) - while pos-prop - for lang = (markdown-code-block-lang pos-prop) - do (progn (when lang (markdown-gfm-add-used-language lang)) - (goto-char (next-single-property-change (point) prop))))))) - - -;;; Footnotes ================================================================== - -(defun markdown-footnote-counter-inc () - "Increment `markdown-footnote-counter' and return the new value." - (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. - (save-excursion - (goto-char (point-min)) - (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") - (point-max) t) - (let ((fn (string-to-number (match-string 1)))) - (when (> fn markdown-footnote-counter) - (setq markdown-footnote-counter fn)))))) - (cl-incf markdown-footnote-counter)) - -(defun markdown-insert-footnote () - "Insert footnote with a new number and move point to footnote definition." - (interactive) - (let ((fn (markdown-footnote-counter-inc))) - (insert (format "[^%d]" fn)) - (markdown-footnote-text-find-new-location) - (markdown-ensure-blank-line-before) - (unless (markdown-cur-line-blank-p) - (insert "\n")) - (insert (format "[^%d]: " fn)) - (markdown-ensure-blank-line-after))) - -(defun markdown-footnote-text-find-new-location () - "Position the point at the proper location for a new footnote text." - (cond - ((eq markdown-footnote-location 'end) (goto-char (point-max))) - ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) - ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) - ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) - -(defun markdown-footnote-kill () - "Kill the footnote at point. -The footnote text is killed (and added to the kill ring), the -footnote marker is deleted. Point has to be either at the -footnote marker or in the footnote text." - (interactive) - (let ((marker-pos nil) - (skip-deleting-marker nil) - (starting-footnote-text-positions - (markdown-footnote-text-positions))) - (when starting-footnote-text-positions - ;; We're starting in footnote text, so mark our return position and jump - ;; to the marker if possible. - (let ((marker-pos (markdown-footnote-find-marker - (cl-first starting-footnote-text-positions)))) - (if marker-pos - (goto-char (1- marker-pos)) - ;; If there isn't a marker, we still want to kill the text. - (setq skip-deleting-marker t)))) - ;; Either we didn't start in the text, or we started in the text and jumped - ;; to the marker. We want to assume we're at the marker now and error if - ;; we're not. - (unless skip-deleting-marker - (let ((marker (markdown-footnote-delete-marker))) - (unless marker - (error "Not at a footnote")) - ;; Even if we knew the text position before, it changed when we deleted - ;; the label. - (setq marker-pos (cl-second marker)) - (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) - (unless new-text-pos - (error "No text for footnote `%s'" (cl-first marker))) - (goto-char new-text-pos)))) - (let ((pos (markdown-footnote-kill-text))) - (goto-char (if starting-footnote-text-positions - pos - marker-pos))))) - -(defun markdown-footnote-delete-marker () - "Delete a footnote marker at point. -Returns a list (ID START) containing the footnote ID and the -start position of the marker before deletion. If no footnote -marker was deleted, this function returns NIL." - (let ((marker (markdown-footnote-marker-positions))) - (when marker - (delete-region (cl-second marker) (cl-third marker)) - (butlast marker)))) - -(defun markdown-footnote-kill-text () - "Kill footnote text at point. -Returns the start position of the footnote text before deletion, -or NIL if point was not inside a footnote text. - -The killed text is placed in the kill ring (without the footnote -number)." - (let ((fn (markdown-footnote-text-positions))) - (when fn - (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) - (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) - (kill-new (match-string 1 text)) - (when (and (markdown-cur-line-blank-p) - (markdown-prev-line-blank-p) - (not (bobp))) - (delete-region (1- (point)) (point))) - (cl-second fn))))) - -(defun markdown-footnote-goto-text () - "Jump to the text of the footnote at point." - (interactive) - (let ((fn (car (markdown-footnote-marker-positions)))) - (unless fn - (user-error "Not at a footnote marker")) - (let ((new-pos (markdown-footnote-find-text fn))) - (unless new-pos - (error "No definition found for footnote `%s'" fn)) - (goto-char new-pos)))) - -(defun markdown-footnote-return () - "Return from a footnote to its footnote number in the main text." - (interactive) - (let ((fn (save-excursion - (car (markdown-footnote-text-positions))))) - (unless fn - (user-error "Not in a footnote")) - (let ((new-pos (markdown-footnote-find-marker fn))) - (unless new-pos - (error "Footnote marker `%s' not found" fn)) - (goto-char new-pos)))) - -(defun markdown-footnote-find-marker (id) - "Find the location of the footnote marker with ID. -The actual buffer position returned is the position directly -following the marker's closing bracket. If no marker is found, -NIL is returned." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) - (skip-chars-backward "^]") - (point)))) - -(defun markdown-footnote-find-text (id) - "Find the location of the text of footnote ID. -The actual buffer position returned is the position of the first -character of the text, after the footnote's identifier. If no -footnote text is found, NIL is returned." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) - (skip-chars-forward "[ \t]") - (point)))) - -(defun markdown-footnote-marker-positions () - "Return the position and ID of the footnote marker point is on. -The return value is a list (ID START END). If point is not on a -footnote, NIL is returned." - ;; first make sure we're at a footnote marker - (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) - (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) - (save-excursion - ;; move point between [ and ^: - (if (looking-at-p "\\[") - (forward-char 1) - (skip-chars-backward "^[")) - (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) - (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) - -(defun markdown-footnote-text-positions () - "Return the start and end positions of the footnote text point is in. -The exact return value is a list of three elements: (ID START END). -The start position is the position of the opening bracket -of the footnote id. The end position is directly after the -newline that ends the footnote. If point is not in a footnote, -NIL is returned instead." - (save-excursion - (let (result) - (move-beginning-of-line 1) - ;; Try to find the label. If we haven't found the label and we're at a blank - ;; or indented line, back up if possible. - (while (and - (not (and (looking-at markdown-regex-footnote-definition) - (setq result (list (match-string 1) (point))))) - (and (not (bobp)) - (or (markdown-cur-line-blank-p) - (>= (current-indentation) 4)))) - (forward-line -1)) - (when result - ;; Advance if there is a next line that is either blank or indented. - ;; (Need to check if we're on the last line, because - ;; markdown-next-line-blank-p returns true for last line in buffer.) - (while (and (/= (line-end-position) (point-max)) - (or (markdown-next-line-blank-p) - (>= (markdown-next-line-indent) 4))) - (forward-line)) - ;; Move back while the current line is blank. - (while (markdown-cur-line-blank-p) - (forward-line -1)) - ;; Advance to capture this line and a single trailing newline (if there - ;; is one). - (forward-line) - (append result (list (point))))))) - -(defun markdown-get-defined-footnotes () - "Return a list of all defined footnotes. -Result is an alist of pairs (MARKER . LINE), where MARKER is the -footnote marker, a string, and LINE is the line number containing -the footnote definition. - -For example, suppose the following footnotes are defined at positions -448 and 475: - -\[^1]: First footnote here. -\[^marker]: Second footnote. - -Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" - (save-excursion - (goto-char (point-min)) - (let (footnotes) - (while (markdown-search-until-condition - (lambda () (and (not (markdown-code-block-at-point-p)) - (not (markdown-inline-code-at-point-p)) - (not (markdown-in-comment-p)))) - markdown-regex-footnote-definition nil t) - (let ((marker (match-string-no-properties 1)) - (pos (match-beginning 0))) - (unless (zerop (length marker)) - (cl-pushnew (cons marker pos) footnotes :test #'equal)))) - (reverse footnotes)))) - - -;;; Element Removal =========================================================== - -(defun markdown-kill-thing-at-point () - "Kill thing at point and add important text, without markup, to kill ring. -Possible things to kill include (roughly in order of precedence): -inline code, headers, horizonal rules, links (add link text to -kill ring), images (add alt text to kill ring), angle uri, email -addresses, bold, italics, reference definition (add URI to kill -ring), footnote markers and text (kill both marker and text, add -text to kill ring), and list items." - (interactive "*") - (let (val) - (cond - ;; Inline code - ((markdown-inline-code-at-point) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; ATX header - ((thing-at-point-looking-at markdown-regex-header-atx) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Setext header - ((thing-at-point-looking-at markdown-regex-header-setext) - (kill-new (match-string 1)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Horizonal rule - ((thing-at-point-looking-at markdown-regex-hr) - (kill-new (match-string 0)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Inline link or image (add link or alt text to kill ring) - ((thing-at-point-looking-at markdown-regex-link-inline) - (kill-new (match-string 3)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Reference link or image (add link or alt text to kill ring) - ((thing-at-point-looking-at markdown-regex-link-reference) - (kill-new (match-string 3)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Angle URI (add URL to kill ring) - ((thing-at-point-looking-at markdown-regex-angle-uri) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Email address in angle brackets (add email address to kill ring) - ((thing-at-point-looking-at markdown-regex-email) - (kill-new (match-string 1)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Wiki link (add alias text to kill ring) - ((and markdown-enable-wiki-links - (thing-at-point-looking-at markdown-regex-wiki-link)) - (kill-new (markdown-wiki-link-alias)) - (delete-region (match-beginning 1) (match-end 1))) - ;; Bold - ((thing-at-point-looking-at markdown-regex-bold) - (kill-new (match-string 4)) - (delete-region (match-beginning 2) (match-end 2))) - ;; Italics - ((thing-at-point-looking-at markdown-regex-italic) - (kill-new (match-string 3)) - (delete-region (match-beginning 1) (match-end 1))) - ;; Strikethrough - ((thing-at-point-looking-at markdown-regex-strike-through) - (kill-new (match-string 4)) - (delete-region (match-beginning 2) (match-end 2))) - ;; Footnote marker (add footnote text to kill ring) - ((thing-at-point-looking-at markdown-regex-footnote) - (markdown-footnote-kill)) - ;; Footnote text (add footnote text to kill ring) - ((setq val (markdown-footnote-text-positions)) - (markdown-footnote-kill)) - ;; Reference definition (add URL to kill ring) - ((thing-at-point-looking-at markdown-regex-reference-definition) - (kill-new (match-string 5)) - (delete-region (match-beginning 0) (match-end 0))) - ;; List item - ((setq val (markdown-cur-list-item-bounds)) - (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) - (t - (user-error "Nothing found at point to kill"))))) - - -;;; Indentation ==================================================================== - -(defun markdown-indent-find-next-position (cur-pos positions) - "Return the position after the index of CUR-POS in POSITIONS. -Positions are calculated by `markdown-calc-indents'." - (while (and positions - (not (equal cur-pos (car positions)))) - (setq positions (cdr positions))) - (or (cadr positions) 0)) - -(define-obsolete-function-alias 'markdown-exdent-find-next-position - 'markdown-outdent-find-next-position "v2.3") - -(defun markdown-outdent-find-next-position (cur-pos positions) - "Return the maximal element that precedes CUR-POS from POSITIONS. -Positions are calculated by `markdown-calc-indents'." - (let ((result 0)) - (dolist (i positions) - (when (< i cur-pos) - (setq result (max result i)))) - result)) - -(defun markdown-indent-line () - "Indent the current line using some heuristics. -If the _previous_ command was either `markdown-enter-key' or -`markdown-cycle', then we should cycle to the next -reasonable indentation position. Otherwise, we could have been -called directly by `markdown-enter-key', by an initial call of -`markdown-cycle', or indirectly by `auto-fill-mode'. In -these cases, indent to the default position. -Positions are calculated by `markdown-calc-indents'." - (interactive) - (let ((positions (markdown-calc-indents)) - (point-pos (current-column)) - (_ (back-to-indentation)) - (cur-pos (current-column))) - (if (not (equal this-command 'markdown-cycle)) - (indent-line-to (car positions)) - (setq positions (sort (delete-dups positions) '<)) - (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) - (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) - (indent-line-to next-pos) - (move-to-column new-point-pos))))) - -(defun markdown-calc-indents () - "Return a list of indentation columns to cycle through. -The first element in the returned list should be considered the -default indentation level. This function does not worry about -duplicate positions, which are handled up by calling functions." - (let (pos prev-line-pos positions) - - ;; Indentation of previous line - (setq prev-line-pos (markdown-prev-line-indent)) - (setq positions (cons prev-line-pos positions)) - - ;; Indentation of previous non-list-marker text - (when (setq pos (save-excursion - (forward-line -1) - (when (looking-at markdown-regex-list) - (- (match-end 3) (match-beginning 0))))) - (setq positions (cons pos positions))) - - ;; Indentation required for a pre block in current context - (setq pos (length (markdown-pre-indentation (point)))) - (setq positions (cons pos positions)) - - ;; Indentation of the previous line + tab-width - (if prev-line-pos - (setq positions (cons (+ prev-line-pos tab-width) positions)) - (setq positions (cons tab-width positions))) - - ;; Indentation of the previous line - tab-width - (if (and prev-line-pos (> prev-line-pos tab-width)) - (setq positions (cons (- prev-line-pos tab-width) positions))) - - ;; Indentation of all preceeding list markers (when in a list) - (when (setq pos (markdown-calculate-list-levels)) - (setq positions (append pos positions))) - - ;; First column - (setq positions (cons 0 positions)) - - ;; Return reversed list - (reverse positions))) - -(defun markdown-enter-key () - "Handle RET depending on the context. -If the point is at a table, move to the next row. Otherwise, -indent according to value of `markdown-indent-on-enter'. -When it is nil, simply call `newline'. Otherwise, indent the next line -following RET using `markdown-indent-line'. Furthermore, when it -is set to 'indent-and-new-item and the point is in a list item, -start a new item with the same indentation. If the point is in an -empty list item, remove it (so that pressing RET twice when in a -list simply adds a blank line)." - (interactive) - (cond - ;; Table - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-next-row)) - ;; Indent non-table text - (markdown-indent-on-enter - (let (bounds) - (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) - (setq bounds (markdown-cur-list-item-bounds))) - (let ((beg (cl-first bounds)) - (end (cl-second bounds)) - (length (cl-fourth bounds))) - ;; Point is in a list item - (if (= (- end beg) length) - ;; Delete blank list - (progn - (delete-region beg end) - (newline) - (markdown-indent-line)) - (call-interactively #'markdown-insert-list-item))) - ;; Point is not in a list - (newline) - (markdown-indent-line)))) - ;; Insert a raw newline - (t (newline)))) - -(define-obsolete-function-alias 'markdown-exdent-or-delete - 'markdown-outdent-or-delete "v2.3") - -(defun markdown-outdent-or-delete (arg) - "Handle BACKSPACE by cycling through indentation points. -When BACKSPACE is pressed, if there is only whitespace -before the current point, then outdent the line one level. -Otherwise, do normal delete by repeating -`backward-delete-char-untabify' ARG times." - (interactive "*p") - (if (use-region-p) - (backward-delete-char-untabify arg) - (let ((cur-pos (current-column)) - (start-of-indention (save-excursion - (back-to-indentation) - (current-column))) - (positions (markdown-calc-indents))) - (if (and (> cur-pos 0) (= cur-pos start-of-indention)) - (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) - (backward-delete-char-untabify arg))))) - -(defun markdown-find-leftmost-column (beg end) - "Find the leftmost column in the region from BEG to END." - (let ((mincol 1000)) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (unless (looking-at-p "[ \t]*$") - (setq mincol (min mincol (current-column)))) - (forward-line 1) - )) - mincol)) - -(defun markdown-indent-region (beg end arg) - "Indent the region from BEG to END using some heuristics. -When ARG is non-nil, outdent the region instead. -See `markdown-indent-line' and `markdown-indent-line'." - (interactive "*r\nP") - (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) - (leftmostcol (markdown-find-leftmost-column beg end)) - (next-pos (if arg - (markdown-outdent-find-next-position leftmostcol positions) - (markdown-indent-find-next-position leftmostcol positions)))) - (indent-rigidly beg end (- next-pos leftmostcol)) - (setq deactivate-mark nil))) - -(define-obsolete-function-alias 'markdown-exdent-region - 'markdown-outdent-region "v2.3") - -(defun markdown-outdent-region (beg end) - "Call `markdown-indent-region' on region from BEG to END with prefix." - (interactive "*r") - (markdown-indent-region beg end t)) - - -;;; Markup Completion ========================================================= - -(defconst markdown-complete-alist - '((markdown-regex-header-atx . markdown-complete-atx) - (markdown-regex-header-setext . markdown-complete-setext) - (markdown-regex-hr . markdown-complete-hr)) - "Association list of form (regexp . function) for markup completion.") - -(defun markdown-incomplete-atx-p () - "Return t if ATX header markup is incomplete and nil otherwise. -Assumes match data is available for `markdown-regex-header-atx'. -Checks that the number of trailing hash marks equals the number of leading -hash marks, that there is only a single space before and after the text, -and that there is no extraneous whitespace in the text." - (or - ;; Number of starting and ending hash marks differs - (not (= (length (match-string 1)) (length (match-string 3)))) - ;; When the header text is not empty... - (and (> (length (match-string 2)) 0) - ;; ...if there are extra leading, trailing, or interior spaces - (or (not (= (match-beginning 2) (1+ (match-end 1)))) - (not (= (match-beginning 3) (1+ (match-end 2)))) - (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) - ;; When the header text is empty... - (and (= (length (match-string 2)) 0) - ;; ...if there are too many or too few spaces - (not (= (match-beginning 3) (+ (match-end 1) 2)))))) - -(defun markdown-complete-atx () - "Complete and normalize ATX headers. -Add or remove hash marks to the end of the header to match the -beginning. Ensure that there is only a single space between hash -marks and header text. Removes extraneous whitespace from header text. -Assumes match data is available for `markdown-regex-header-atx'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-atx-p) - (let* ((new-marker (make-marker)) - (new-marker (set-marker new-marker (match-end 2)))) - ;; Hash marks and spacing at end - (goto-char (match-end 2)) - (delete-region (match-end 2) (match-end 3)) - (insert " " (match-string 1)) - ;; Remove extraneous whitespace from title - (replace-match (markdown-compress-whitespace-string (match-string 2)) - t t nil 2) - ;; Spacing at beginning - (goto-char (match-end 1)) - (delete-region (match-end 1) (match-beginning 2)) - (insert " ") - ;; Leave point at end of text - (goto-char new-marker)))) - -(defun markdown-incomplete-setext-p () - "Return t if setext header markup is incomplete and nil otherwise. -Assumes match data is available for `markdown-regex-header-setext'. -Checks that length of underline matches text and that there is no -extraneous whitespace in the text." - (or (not (= (length (match-string 1)) (length (match-string 2)))) - (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) - -(defun markdown-complete-setext () - "Complete and normalize setext headers. -Add or remove underline characters to match length of header -text. Removes extraneous whitespace from header text. Assumes -match data is available for `markdown-regex-header-setext'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-setext-p) - (let* ((text (markdown-compress-whitespace-string (match-string 1))) - (char (char-after (match-beginning 2))) - (level (if (char-equal char ?-) 2 1))) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (markdown-insert-header level text t) - t))) - -(defun markdown-incomplete-hr-p () - "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. -Assumes match data is available for `markdown-regex-hr'." - (not (member (match-string 0) markdown-hr-strings))) - -(defun markdown-complete-hr () - "Complete horizontal rules. -If horizontal rule string is a member of `markdown-hr-strings', -do nothing. Otherwise, replace with the car of -`markdown-hr-strings'. -Assumes match data is available for `markdown-regex-hr'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-hr-p) - (replace-match (car markdown-hr-strings)) - t)) - -(defun markdown-complete () - "Complete markup of object near point or in region when active. -Handle all objects in `markdown-complete-alist', in order. -See `markdown-complete-at-point' and `markdown-complete-region'." - (interactive "*") - (if (markdown-use-region-p) - (markdown-complete-region (region-beginning) (region-end)) - (markdown-complete-at-point))) - -(defun markdown-complete-at-point () - "Complete markup of object near point. -Handle all elements of `markdown-complete-alist' in order." - (interactive "*") - (let ((list markdown-complete-alist) found changed) - (while list - (let ((regexp (eval (caar list))) - (function (cdar list))) - (setq list (cdr list)) - (when (thing-at-point-looking-at regexp) - (setq found t) - (setq changed (funcall function)) - (setq list nil)))) - (if found - (or changed (user-error "Markup at point is complete")) - (user-error "Nothing to complete at point")))) - -(defun markdown-complete-region (beg end) - "Complete markup of objects in region from BEG to END. -Handle all objects in `markdown-complete-alist', in order. Each -match is checked to ensure that a previous regexp does not also -match." - (interactive "*r") - (let ((end-marker (set-marker (make-marker) end)) - previous) - (dolist (element markdown-complete-alist) - (let ((regexp (eval (car element))) - (function (cdr element))) - (goto-char beg) - (while (re-search-forward regexp end-marker 'limit) - (when (match-string 0) - ;; Make sure this is not a match for any of the preceding regexps. - ;; This prevents mistaking an HR for a Setext subheading. - (let (match) - (save-match-data - (dolist (prev-regexp previous) - (or match (setq match (looking-back prev-regexp nil))))) - (unless match - (save-excursion (funcall function)))))) - (cl-pushnew regexp previous :test #'equal))) - previous)) - -(defun markdown-complete-buffer () - "Complete markup for all objects in the current buffer." - (interactive "*") - (markdown-complete-region (point-min) (point-max))) - - -;;; Markup Cycling ============================================================ - -(defun markdown-cycle-atx (arg &optional remove) - "Cycle ATX header markup. -Promote header (decrease level) when ARG is 1 and demote -header (increase level) if arg is -1. When REMOVE is non-nil, -remove the header when the level reaches zero and stop cycling -when it reaches six. Otherwise, perform a proper cycling through -levels one through six. Assumes match data is available for -`markdown-regex-header-atx'." - (let* ((old-level (length (match-string 1))) - (new-level (+ old-level arg)) - (text (match-string 2))) - (when (not remove) - (setq new-level (% new-level 6)) - (setq new-level (cond ((= new-level 0) 6) - ((< new-level 0) (+ new-level 6)) - (t new-level)))) - (cond - ((= new-level 0) - (markdown-unwrap-thing-at-point nil 0 2)) - ((<= new-level 6) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (markdown-insert-header new-level text nil))))) - -(defun markdown-cycle-setext (arg &optional remove) - "Cycle setext header markup. -Promote header (increase level) when ARG is 1 and demote -header (decrease level or remove) if arg is -1. When demoting a -level-two setext header, replace with a level-three atx header. -When REMOVE is non-nil, remove the header when the level reaches -zero. Otherwise, cycle back to a level six atx header. Assumes -match data is available for `markdown-regex-header-setext'." - (let* ((char (char-after (match-beginning 2))) - (old-level (if (char-equal char ?=) 1 2)) - (new-level (+ old-level arg))) - (when (and (not remove) (= new-level 0)) - (setq new-level 6)) - (cond - ((= new-level 0) - (markdown-unwrap-thing-at-point nil 0 1)) - ((<= new-level 2) - (markdown-insert-header new-level nil t)) - ((<= new-level 6) - (markdown-insert-header new-level nil nil))))) - -(defun markdown-cycle-hr (arg &optional remove) - "Cycle string used for horizontal rule from `markdown-hr-strings'. -When ARG is 1, cycle forward (demote), and when ARG is -1, cycle -backwards (promote). When REMOVE is non-nil, remove the hr instead -of cycling when the end of the list is reached. -Assumes match data is available for `markdown-regex-hr'." - (let* ((strings (if (= arg -1) - (reverse markdown-hr-strings) - markdown-hr-strings)) - (tail (member (match-string 0) strings)) - (new (or (cadr tail) - (if remove - (if (= arg 1) - "" - (car tail)) - (car strings))))) - (replace-match new))) - -(defun markdown-cycle-bold () - "Cycle bold markup between underscores and asterisks. -Assumes match data is available for `markdown-regex-bold'." - (save-excursion - (let* ((old-delim (match-string 3)) - (new-delim (if (string-equal old-delim "**") "__" "**"))) - (replace-match new-delim t t nil 3) - (replace-match new-delim t t nil 5)))) - -(defun markdown-cycle-italic () - "Cycle italic markup between underscores and asterisks. -Assumes match data is available for `markdown-regex-italic'." - (save-excursion - (let* ((old-delim (match-string 2)) - (new-delim (if (string-equal old-delim "*") "_" "*"))) - (replace-match new-delim t t nil 2) - (replace-match new-delim t t nil 4)))) - - -;;; Keymap ==================================================================== - -(defun markdown--style-map-prompt () - "Return a formatted prompt for Markdown markup insertion." - (when markdown-enable-prefix-prompts - (concat - "Markdown: " - (propertize "bold" 'face 'markdown-bold-face) ", " - (propertize "italic" 'face 'markdown-italic-face) ", " - (propertize "code" 'face 'markdown-inline-code-face) ", " - (propertize "C = GFM code" 'face 'markdown-code-face) ", " - (propertize "pre" 'face 'markdown-pre-face) ", " - (propertize "footnote" 'face 'markdown-footnote-text-face) ", " - (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " - (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " - (propertize "- = hr" 'face 'markdown-hr-face) ", " - "C-h = more"))) - -(defun markdown--command-map-prompt () - "Return prompt for Markdown buffer-wide commands." - (when markdown-enable-prefix-prompts - (concat - "Command: " - (propertize "m" 'face 'markdown-bold-face) "arkdown, " - (propertize "p" 'face 'markdown-bold-face) "review, " - (propertize "o" 'face 'markdown-bold-face) "pen, " - (propertize "e" 'face 'markdown-bold-face) "xport, " - "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " - (propertize "c" 'face 'markdown-bold-face) "heck refs, " - (propertize "u" 'face 'markdown-bold-face) "nused refs, " - "C-h = more"))) - -(defvar markdown-mode-style-map - (let ((map (make-keymap (markdown--style-map-prompt)))) - (define-key map (kbd "1") 'markdown-insert-header-atx-1) - (define-key map (kbd "2") 'markdown-insert-header-atx-2) - (define-key map (kbd "3") 'markdown-insert-header-atx-3) - (define-key map (kbd "4") 'markdown-insert-header-atx-4) - (define-key map (kbd "5") 'markdown-insert-header-atx-5) - (define-key map (kbd "6") 'markdown-insert-header-atx-6) - (define-key map (kbd "!") 'markdown-insert-header-setext-1) - (define-key map (kbd "@") 'markdown-insert-header-setext-2) - (define-key map (kbd "b") 'markdown-insert-bold) - (define-key map (kbd "c") 'markdown-insert-code) - (define-key map (kbd "C") 'markdown-insert-gfm-code-block) - (define-key map (kbd "f") 'markdown-insert-footnote) - (define-key map (kbd "h") 'markdown-insert-header-dwim) - (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) - (define-key map (kbd "i") 'markdown-insert-italic) - (define-key map (kbd "k") 'markdown-insert-kbd) - (define-key map (kbd "l") 'markdown-insert-link) - (define-key map (kbd "p") 'markdown-insert-pre) - (define-key map (kbd "P") 'markdown-pre-region) - (define-key map (kbd "q") 'markdown-insert-blockquote) - (define-key map (kbd "s") 'markdown-insert-strike-through) - (define-key map (kbd "Q") 'markdown-blockquote-region) - (define-key map (kbd "w") 'markdown-insert-wiki-link) - (define-key map (kbd "-") 'markdown-insert-hr) - (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) - ;; Deprecated keys that may be removed in a future version - (define-key map (kbd "e") 'markdown-insert-italic) - map) - "Keymap for Markdown text styling commands.") - -(defvar markdown-mode-command-map - (let ((map (make-keymap (markdown--command-map-prompt)))) - (define-key map (kbd "m") 'markdown-other-window) - (define-key map (kbd "p") 'markdown-preview) - (define-key map (kbd "e") 'markdown-export) - (define-key map (kbd "v") 'markdown-export-and-preview) - (define-key map (kbd "o") 'markdown-open) - (define-key map (kbd "l") 'markdown-live-preview-mode) - (define-key map (kbd "w") 'markdown-kill-ring-save) - (define-key map (kbd "c") 'markdown-check-refs) - (define-key map (kbd "u") 'markdown-unused-refs) - (define-key map (kbd "n") 'markdown-cleanup-list-numbers) - (define-key map (kbd "]") 'markdown-complete-buffer) - (define-key map (kbd "^") 'markdown-table-sort-lines) - (define-key map (kbd "|") 'markdown-table-convert-region) - (define-key map (kbd "t") 'markdown-table-transpose) - map) - "Keymap for Markdown buffer-wide commands.") - -(defvar markdown-mode-map - (let ((map (make-keymap))) - ;; Markup insertion & removal - (define-key map (kbd "C-c C-s") markdown-mode-style-map) - (define-key map (kbd "C-c C-l") 'markdown-insert-link) - (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) - ;; Promotion, demotion, and cycling - (define-key map (kbd "C-c C--") 'markdown-promote) - (define-key map (kbd "C-c C-=") 'markdown-demote) - (define-key map (kbd "C-c C-]") 'markdown-complete) - ;; Following and doing things - (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) - (define-key map (kbd "C-c C-d") 'markdown-do) - (define-key map (kbd "C-c '") 'markdown-edit-code-block) - ;; Indentation - (define-key map (kbd "C-m") 'markdown-enter-key) - (define-key map (kbd "DEL") 'markdown-outdent-or-delete) - (define-key map (kbd "C-c >") 'markdown-indent-region) - (define-key map (kbd "C-c <") 'markdown-outdent-region) - ;; Visibility cycling - (define-key map (kbd "TAB") 'markdown-cycle) - (define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) - (define-key map (kbd "<S-tab>") 'markdown-shifttab) - (define-key map (kbd "<backtab>") 'markdown-shifttab) - ;; Heading and list navigation - (define-key map (kbd "C-c C-n") 'markdown-outline-next) - (define-key map (kbd "C-c C-p") 'markdown-outline-previous) - (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) - (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) - (define-key map (kbd "C-c C-u") 'markdown-outline-up) - ;; Buffer-wide commands - (define-key map (kbd "C-c C-c") markdown-mode-command-map) - ;; Subtree, list, and table editing - (define-key map (kbd "C-c <up>") 'markdown-move-up) - (define-key map (kbd "C-c <down>") 'markdown-move-down) - (define-key map (kbd "C-c <left>") 'markdown-promote) - (define-key map (kbd "C-c <right>") 'markdown-demote) - (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) - (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) - (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) - (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) - (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) - (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) - (define-key map (kbd "M-RET") 'markdown-insert-list-item) - (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) - ;; Paragraphs (Markdown context aware) - (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) - (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) - (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) - ;; Blocks (one or more paragraphs) - (define-key map (kbd "C-M-{") 'markdown-backward-block) - (define-key map (kbd "C-M-}") 'markdown-forward-block) - (define-key map (kbd "C-c M-h") 'markdown-mark-block) - (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) - ;; Pages (top-level sections) - (define-key map [remap backward-page] 'markdown-backward-page) - (define-key map [remap forward-page] 'markdown-forward-page) - (define-key map [remap mark-page] 'markdown-mark-page) - (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) - ;; Link Movement - (define-key map (kbd "M-n") 'markdown-next-link) - (define-key map (kbd "M-p") 'markdown-previous-link) - ;; Toggling functionality - (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) - (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) - (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) - (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) - (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) - ;; Alternative keys (in case of problems with the arrow keys) - (define-key map (kbd "C-c C-x u") 'markdown-move-up) - (define-key map (kbd "C-c C-x d") 'markdown-move-down) - (define-key map (kbd "C-c C-x l") 'markdown-promote) - (define-key map (kbd "C-c C-x r") 'markdown-demote) - ;; Deprecated keys that may be removed in a future version - (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l - (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) - (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) - (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) - (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) - (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) - (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) - (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) - (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) - (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) - (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) - (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) - (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) - (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) - (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) - (define-key map (kbd "C-c C-i") 'markdown-insert-image) - (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j - (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d - (define-key map (kbd "C-c -") 'markdown-insert-hr) - map) - "Keymap for Markdown major mode.") - -(defvar markdown-mode-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] 'markdown-follow-link-at-point) - map) - "Keymap for following links with mouse.") - -(defvar gfm-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map markdown-mode-map) - (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) - (define-key map "`" 'markdown-electric-backquote) - map) - "Keymap for `gfm-mode'. -See also `markdown-mode-map'.") - - -;;; Menu ================================================================== - -(easy-menu-define markdown-mode-menu markdown-mode-map - "Menu for Markdown mode" - '("Markdown" - "---" - ("Movement" - ["Jump" markdown-do] - ["Follow Link" markdown-follow-thing-at-point] - ["Next Link" markdown-next-link] - ["Previous Link" markdown-previous-link] - "---" - ["Next Heading or List Item" markdown-outline-next] - ["Previous Heading or List Item" markdown-outline-previous] - ["Next at Same Level" markdown-outline-next-same-level] - ["Previous at Same Level" markdown-outline-previous-same-level] - ["Up to Parent" markdown-outline-up] - "---" - ["Forward Paragraph" markdown-forward-paragraph] - ["Backward Paragraph" markdown-backward-paragraph] - ["Forward Block" markdown-forward-block] - ["Backward Block" markdown-backward-block]) - ("Show & Hide" - ["Cycle Heading Visibility" markdown-cycle - :enable (markdown-on-heading-p)] - ["Cycle Heading Visibility (Global)" markdown-shifttab] - "---" - ["Narrow to Region" narrow-to-region] - ["Narrow to Block" markdown-narrow-to-block] - ["Narrow to Section" narrow-to-defun] - ["Narrow to Subtree" markdown-narrow-to-subtree] - ["Widen" widen (buffer-narrowed-p)] - "---" - ["Toggle Markup Hiding" markdown-toggle-markup-hiding - :keys "C-c C-x C-m" - :style radio - :selected markdown-hide-markup]) - "---" - ("Headings & Structure" - ["Automatic Heading" markdown-insert-header-dwim - :keys "C-c C-s h"] - ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim - :keys "C-c C-s H"] - ("Specific Heading (atx)" - ["First Level atx" markdown-insert-header-atx-1 - :keys "C-c C-s 1"] - ["Second Level atx" markdown-insert-header-atx-2 - :keys "C-c C-s 2"] - ["Third Level atx" markdown-insert-header-atx-3 - :keys "C-c C-s 3"] - ["Fourth Level atx" markdown-insert-header-atx-4 - :keys "C-c C-s 4"] - ["Fifth Level atx" markdown-insert-header-atx-5 - :keys "C-c C-s 5"] - ["Sixth Level atx" markdown-insert-header-atx-6 - :keys "C-c C-s 6"]) - ("Specific Heading (Setext)" - ["First Level Setext" markdown-insert-header-setext-1 - :keys "C-c C-s !"] - ["Second Level Setext" markdown-insert-header-setext-2 - :keys "C-c C-s @"]) - ["Horizontal Rule" markdown-insert-hr - :keys "C-c C-s -"] - "---" - ["Move Subtree Up" markdown-move-up - :keys "C-c <up>"] - ["Move Subtree Down" markdown-move-down - :keys "C-c <down>"] - ["Promote Subtree" markdown-promote - :keys "C-c <left>"] - ["Demote Subtree" markdown-demote - :keys "C-c <right>"]) - ("Region & Mark" - ["Indent Region" markdown-indent-region] - ["Outdent Region" markdown-outdent-region] - "--" - ["Mark Paragraph" mark-paragraph] - ["Mark Block" markdown-mark-block] - ["Mark Section" mark-defun] - ["Mark Subtree" markdown-mark-subtree]) - ("Tables" - ["Move Row Up" markdown-move-up - :enable (markdown-table-at-point-p) - :keys "C-c <up>"] - ["Move Row Down" markdown-move-down - :enable (markdown-table-at-point-p) - :keys "C-c <down>"] - ["Move Column Left" markdown-demote - :enable (markdown-table-at-point-p) - :keys "C-c <left>"] - ["Move Column Right" markdown-promote - :enable (markdown-table-at-point-p) - :keys "C-c <right>"] - ["Delete Row" markdown-table-delete-row - :enable (markdown-table-at-point-p)] - ["Insert Row" markdown-table-insert-row - :enable (markdown-table-at-point-p)] - ["Delete Column" markdown-table-delete-column - :enable (markdown-table-at-point-p)] - ["Insert Column" markdown-table-insert-column - :enable (markdown-table-at-point-p)] - "--" - ["Convert Region to Table" markdown-table-convert-region] - ["Sort Table Lines" markdown-table-sort-lines - :enable (markdown-table-at-point-p)] - ["Transpose Table" markdown-table-transpose - :enable (markdown-table-at-point-p)]) - ("Lists" - ["Insert List Item" markdown-insert-list-item] - ["Move Subtree Up" markdown-move-up - :keys "C-c <up>"] - ["Move Subtree Down" markdown-move-down - :keys "C-c <down>"] - ["Indent Subtree" markdown-demote - :keys "C-c <right>"] - ["Outdent Subtree" markdown-promote - :keys "C-c <left>"] - ["Renumber List" markdown-cleanup-list-numbers] - ["Insert Task List Item" markdown-insert-gfm-checkbox - :keys "C-c C-x ["] - ["Toggle Task List Item" markdown-toggle-gfm-checkbox - :enable (markdown-gfm-task-list-item-at-point) - :keys "C-c C-d"]) - ("Links & Images" - ["Insert Link" markdown-insert-link] - ["Insert Image" markdown-insert-image] - ["Insert Footnote" markdown-insert-footnote - :keys "C-c C-s f"] - ["Insert Wiki Link" markdown-insert-wiki-link - :keys "C-c C-s w"] - "---" - ["Check References" markdown-check-refs] - ["Find Unused References" markdown-unused-refs] - ["Toggle URL Hiding" markdown-toggle-url-hiding - :style radio - :selected markdown-hide-urls] - ["Toggle Inline Images" markdown-toggle-inline-images - :keys "C-c C-x C-i" - :style radio - :selected markdown-inline-image-overlays] - ["Toggle Wiki Links" markdown-toggle-wiki-links - :style radio - :selected markdown-enable-wiki-links]) - ("Styles" - ["Bold" markdown-insert-bold] - ["Italic" markdown-insert-italic] - ["Code" markdown-insert-code] - ["Strikethrough" markdown-insert-strike-through] - ["Keyboard" markdown-insert-kbd] - "---" - ["Blockquote" markdown-insert-blockquote] - ["Preformatted" markdown-insert-pre] - ["GFM Code Block" markdown-insert-gfm-code-block] - ["Edit Code Block" markdown-edit-code-block - :enable (markdown-code-block-at-point-p)] - "---" - ["Blockquote Region" markdown-blockquote-region] - ["Preformatted Region" markdown-pre-region] - "---" - ["Fontify Code Blocks Natively" - markdown-toggle-fontify-code-blocks-natively - :style radio - :selected markdown-fontify-code-blocks-natively] - ["LaTeX Math Support" markdown-toggle-math - :style radio - :selected markdown-enable-math]) - "---" - ("Preview & Export" - ["Compile" markdown-other-window] - ["Preview" markdown-preview] - ["Export" markdown-export] - ["Export & View" markdown-export-and-preview] - ["Open" markdown-open] - ["Live Export" markdown-live-preview-mode - :style radio - :selected markdown-live-preview-mode] - ["Kill ring save" markdown-kill-ring-save]) - ("Markup Completion and Cycling" - ["Complete Markup" markdown-complete] - ["Promote Element" markdown-promote - :keys "C-c C--"] - ["Demote Element" markdown-demote - :keys "C-c C-="]) - "---" - ["Kill Element" markdown-kill-thing-at-point] - "---" - ("Documentation" - ["Version" markdown-show-version] - ["Homepage" markdown-mode-info] - ["Describe Mode" (describe-function 'markdown-mode)] - ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) - - -;;; imenu ===================================================================== - -(defun markdown-imenu-create-nested-index () - "Create and return a nested imenu index alist for the current buffer. -See `imenu-create-index-function' and `imenu--index-alist' for details." - (let* ((root '(nil . nil)) - cur-alist - (cur-level 0) - (empty-heading "-") - (self-heading ".") - hashes pos level heading) - (save-excursion - ;; Headings - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (unless (markdown-code-block-at-point-p) - (cond - ((match-string-no-properties 2) ;; level 1 setext - (setq heading (match-string-no-properties 1)) - (setq pos (match-beginning 1) - level 1)) - ((match-string-no-properties 3) ;; level 2 setext - (setq heading (match-string-no-properties 1)) - (setq pos (match-beginning 1) - level 2)) - ((setq hashes (markdown-trim-whitespace - (match-string-no-properties 4))) - (setq heading (match-string-no-properties 5) - pos (match-beginning 4) - level (length hashes)))) - (let ((alist (list (cons heading pos)))) - (cond - ((= cur-level level) ; new sibling - (setcdr cur-alist alist) - (setq cur-alist alist)) - ((< cur-level level) ; first child - (dotimes (_ (- level cur-level 1)) - (setq alist (list (cons empty-heading alist)))) - (if cur-alist - (let* ((parent (car cur-alist)) - (self-pos (cdr parent))) - (setcdr parent (cons (cons self-heading self-pos) alist))) - (setcdr root alist)) ; primogenitor - (setq cur-alist alist) - (setq cur-level level)) - (t ; new sibling of an ancestor - (let ((sibling-alist (last (cdr root)))) - (dotimes (_ (1- level)) - (setq sibling-alist (last (cdar sibling-alist)))) - (setcdr sibling-alist alist) - (setq cur-alist alist)) - (setq cur-level level)))))) - ;; Footnotes - (let ((fn (markdown-get-defined-footnotes))) - (if (or (zerop (length fn)) - (null markdown-add-footnotes-to-imenu)) - (cdr root) - (nconc (cdr root) (list (cons "Footnotes" fn)))))))) - -(defun markdown-imenu-create-flat-index () - "Create and return a flat imenu index alist for the current buffer. -See `imenu-create-index-function' and `imenu--index-alist' for details." - (let* ((empty-heading "-") index heading pos) - (save-excursion - ;; Headings - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (when (and (not (markdown-code-block-at-point-p (point-at-bol))) - (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) - (cond - ((setq heading (match-string-no-properties 1)) - (setq pos (match-beginning 1))) - ((setq heading (match-string-no-properties 5)) - (setq pos (match-beginning 4)))) - (or (> (length heading) 0) - (setq heading empty-heading)) - (setq index (append index (list (cons heading pos)))))) - ;; Footnotes - (when markdown-add-footnotes-to-imenu - (nconc index (markdown-get-defined-footnotes))) - index))) - - -;;; References ================================================================ - -(defun markdown-reference-goto-definition () - "Jump to the definition of the reference at point or create it." - (interactive) - (when (thing-at-point-looking-at markdown-regex-link-reference) - (let* ((text (match-string-no-properties 3)) - (reference (match-string-no-properties 6)) - (target (downcase (if (string= reference "") text reference))) - (loc (cadr (save-match-data (markdown-reference-definition target))))) - (if loc - (goto-char loc) - (goto-char (match-beginning 0)) - (markdown-insert-reference-definition target))))) - -(defun markdown-reference-find-links (reference) - "Return a list of all links for REFERENCE. -REFERENCE should not include the surrounding square brackets. -Elements of the list have the form (text start line), where -text is the link text, start is the location at the beginning of -the link, and line is the line number on which the link appears." - (let* ((ref-quote (regexp-quote reference)) - (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" - ref-quote ref-quote)) - links) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let* ((text (or (match-string-no-properties 1) - (match-string-no-properties 2))) - (start (match-beginning 0)) - (line (markdown-line-number-at-pos))) - (cl-pushnew (list text start line) links :test #'equal)))) - links)) - -(defmacro markdown-for-all-refs (f) - `(let ((result)) - (save-excursion - (goto-char (point-min)) - (while - (re-search-forward markdown-regex-link-reference nil t) - (let* ((text (match-string-no-properties 3)) - (reference (match-string-no-properties 6)) - (target (downcase (if (string= reference "") text reference)))) - (,f text target result)))) - (reverse result))) - -(defmacro markdown-collect-always (_ target result) - `(cl-pushnew ,target ,result :test #'equal)) - -(defmacro markdown-collect-undefined (text target result) - `(unless (markdown-reference-definition target) - (let ((entry (assoc ,target ,result))) - (if (not entry) - (cl-pushnew - (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) - ,result :test #'equal) - (setcdr entry - (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) - -(defun markdown-get-all-refs () - "Return a list of all Markdown references." - (markdown-for-all-refs markdown-collect-always)) - -(defun markdown-get-undefined-refs () - "Return a list of undefined Markdown references. -Result is an alist of pairs (reference . occurrences), where -occurrences is itself another alist of pairs (label . line-number). -For example, an alist corresponding to [Nice editor][Emacs] at line 12, -\[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is -\((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." - (markdown-for-all-refs markdown-collect-undefined)) - -(defun markdown-get-unused-refs () - (cl-sort - (cl-set-difference - (markdown-get-defined-references) (markdown-get-all-refs) - :test (lambda (e1 e2) (equal (car e1) e2))) - #'< :key #'cdr)) - -(defmacro defun-markdown-buffer (name docstring) - "Define a function to name and return a buffer. - -By convention, NAME must be a name of a string constant with -%buffer% placeholder used to name the buffer, and will also be -used as a name of the function defined. - -DOCSTRING will be used as the first part of the docstring." - `(defun ,name (&optional buffer-name) - ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") - (or buffer-name (setq buffer-name (buffer-name))) - (let ((refbuf (get-buffer-create (markdown-replace-regexp-in-string - "%buffer%" buffer-name - ,name)))) - (with-current-buffer refbuf - (when view-mode - (View-exit-and-edit)) - (use-local-map button-buffer-map) - (erase-buffer)) - refbuf))) - -(defconst markdown-reference-check-buffer - "*Undefined references for %buffer%*" - "Pattern for name of buffer for listing undefined references. -The string %buffer% will be replaced by the corresponding -`markdown-mode' buffer name.") - -(defun-markdown-buffer - markdown-reference-check-buffer - "Name and return buffer for reference checking.") - -(defconst markdown-unused-references-buffer - "*Unused references for %buffer%*" - "Pattern for name of buffer for listing unused references. -The string %buffer% will be replaced by the corresponding -`markdown-mode' buffer name.") - -(defun-markdown-buffer - markdown-unused-references-buffer - "Name and return buffer for unused reference checking.") - -(defconst markdown-reference-links-buffer - "*Reference links for %buffer%*" - "Pattern for name of buffer for listing references. -The string %buffer% will be replaced by the corresponding buffer name.") - -(defun-markdown-buffer - markdown-reference-links-buffer - "Name, setup, and return a buffer for listing links.") - -;; Add an empty Markdown reference definition to buffer -;; specified in the 'target-buffer property. The reference name is -;; the button's label. -(define-button-type 'markdown-undefined-reference-button - 'help-echo "mouse-1, RET: create definition for undefined reference" - 'follow-link t - 'face 'bold - 'action (lambda (b) - (let ((buffer (button-get b 'target-buffer)) - (line (button-get b 'target-line)) - (label (button-label b))) - (switch-to-buffer-other-window buffer) - (goto-char (point-min)) - (forward-line line) - (markdown-insert-reference-definition label) - (markdown-check-refs t)))) - -;; Jump to line in buffer specified by 'target-buffer property. -;; Line number is button's 'target-line property. -(define-button-type 'markdown-goto-line-button - 'help-echo "mouse-1, RET: go to line" - 'follow-link t - 'face 'italic - 'action (lambda (b) - (switch-to-buffer-other-window (button-get b 'target-buffer)) - ;; use call-interactively to silence compiler - (let ((current-prefix-arg (button-get b 'target-line))) - (call-interactively 'goto-line)))) - -;; Kill a line in buffer specified by 'target-buffer property. -;; Line number is button's 'target-line property. -(define-button-type 'markdown-kill-line-button - 'help-echo "mouse-1, RET: kill line" - 'follow-link t - 'face 'italic - 'action (lambda (b) - (switch-to-buffer-other-window (button-get b 'target-buffer)) - ;; use call-interactively to silence compiler - (let ((current-prefix-arg (button-get b 'target-line))) - (call-interactively 'goto-line)) - (kill-line 1) - (markdown-unused-refs t))) - -;; Jumps to a particular link at location given by 'target-char -;; property in buffer given by 'target-buffer property. -(define-button-type 'markdown-location-button - 'help-echo "mouse-1, RET: jump to location of link" - 'follow-link t - 'face 'bold - 'action (lambda (b) - (let ((target (button-get b 'target-buffer)) - (loc (button-get b 'target-char))) - (kill-buffer-and-window) - (switch-to-buffer target) - (goto-char loc)))) - -(defun markdown-insert-undefined-reference-button (reference oldbuf) - "Insert a button for creating REFERENCE in buffer OLDBUF. -REFERENCE should be a list of the form (reference . occurrences), -as returned by `markdown-get-undefined-refs'." - (let ((label (car reference))) - ;; Create a reference button - (insert-button label - :type 'markdown-undefined-reference-button - 'target-buffer oldbuf - 'target-line (cdr (car (cdr reference)))) - (insert " (") - (dolist (occurrence (cdr reference)) - (let ((line (cdr occurrence))) - ;; Create a line number button - (insert-button (number-to-string line) - :type 'markdown-goto-line-button - 'target-buffer oldbuf - 'target-line line) - (insert " "))) - (delete-char -1) - (insert ")") - (newline))) - -(defun markdown-insert-unused-reference-button (reference oldbuf) - "Insert a button for creating REFERENCE in buffer OLDBUF. -REFERENCE must be a pair of (ref . line-number)." - (let ((label (car reference)) - (line (cdr reference))) - ;; Create a reference button - (insert-button label - :type 'markdown-goto-line-button - 'face 'bold - 'target-buffer oldbuf - 'target-line line) - (insert (format " (%d) [" line)) - (insert-button "X" - :type 'markdown-kill-line-button - 'face 'bold - 'target-buffer oldbuf - 'target-line line) - (insert "]") - (newline))) - -(defun markdown-insert-link-button (link oldbuf) - "Insert a button for jumping to LINK in buffer OLDBUF. -LINK should be a list of the form (text char line) containing -the link text, location, and line number." - (let ((label (cl-first link)) - (char (cl-second link)) - (line (cl-third link))) - ;; Create a reference button - (insert-button label - :type 'markdown-location-button - 'target-buffer oldbuf - 'target-char char) - (insert (format " (line %d)\n" line)))) - -(defun markdown-reference-goto-link (&optional reference) - "Jump to the location of the first use of REFERENCE." - (interactive) - (unless reference - (if (thing-at-point-looking-at markdown-regex-reference-definition) - (setq reference (match-string-no-properties 2)) - (user-error "No reference definition at point"))) - (let ((links (markdown-reference-find-links reference))) - (cond ((= (length links) 1) - (goto-char (cadr (car links)))) - ((> (length links) 1) - (let ((oldbuf (current-buffer)) - (linkbuf (markdown-reference-links-buffer))) - (with-current-buffer linkbuf - (insert "Links using reference " reference ":\n\n") - (dolist (link (reverse links)) - (markdown-insert-link-button link oldbuf))) - (view-buffer-other-window linkbuf) - (goto-char (point-min)) - (forward-line 2))) - (t - (error "No links for reference %s" reference))))) - -(defmacro defun-markdown-ref-checker - (name docstring checker-function buffer-function none-message buffer-header insert-reference) - "Define a function NAME acting on result of CHECKER-FUNCTION. - -DOCSTRING is used as a docstring for the defined function. - -BUFFER-FUNCTION should name and return an auxiliary buffer to put -results in. - -NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. - -BUFFER-HEADER is put into the auxiliary buffer first, followed by -calling INSERT-REFERENCE for each element in the list returned by -CHECKER-FUNCTION." - `(defun ,name (&optional silent) - ,(concat - docstring - "\n\nIf SILENT is non-nil, do not message anything when no -such references found.") - (interactive "P") - (when (not (memq major-mode '(markdown-mode gfm-mode))) - (user-error "Not available in current mode")) - (let ((oldbuf (current-buffer)) - (refs (,checker-function)) - (refbuf (,buffer-function))) - (if (null refs) - (progn - (when (not silent) - (message ,none-message)) - (kill-buffer refbuf)) - (with-current-buffer refbuf - (insert ,buffer-header) - (dolist (ref refs) - (,insert-reference ref oldbuf)) - (view-buffer-other-window refbuf) - (goto-char (point-min)) - (forward-line 2)))))) - -(defun-markdown-ref-checker - markdown-check-refs - "Show all undefined Markdown references in current `markdown-mode' buffer. - -Links which have empty reference definitions are considered to be -defined." - markdown-get-undefined-refs - markdown-reference-check-buffer - "No undefined references found" - "The following references are undefined:\n\n" - markdown-insert-undefined-reference-button) - - -(defun-markdown-ref-checker - markdown-unused-refs - "Show all unused Markdown references in current `markdown-mode' buffer." - markdown-get-unused-refs - markdown-unused-references-buffer - "No unused references found" - "The following references are unused:\n\n" - markdown-insert-unused-reference-button) - - - -;;; Lists ===================================================================== - -(defun markdown-insert-list-item (&optional arg) - "Insert a new list item. -If the point is inside unordered list, insert a bullet mark. If -the point is inside ordered list, insert the next number followed -by a period. Use the previous list item to determine the amount -of whitespace to place before and after list markers. - -With a \\[universal-argument] prefix (i.e., when ARG is (4)), -decrease the indentation by one level. - -With two \\[universal-argument] prefixes (i.e., when ARG is (16)), -increase the indentation by one level." - (interactive "p") - (let (bounds cur-indent marker indent new-indent new-loc) - (save-match-data - ;; Look for a list item on current or previous non-blank line - (save-excursion - (while (and (not (setq bounds (markdown-cur-list-item-bounds))) - (not (bobp)) - (markdown-cur-line-blank-p)) - (forward-line -1))) - (when bounds - (cond ((save-excursion - (skip-chars-backward " \t") - (looking-at-p markdown-regex-list)) - (beginning-of-line) - (insert "\n") - (forward-line -1)) - ((not (markdown-cur-line-blank-p)) - (newline))) - (setq new-loc (point))) - ;; Look ahead for a list item on next non-blank line - (unless bounds - (save-excursion - (while (and (null bounds) - (not (eobp)) - (markdown-cur-line-blank-p)) - (forward-line) - (setq bounds (markdown-cur-list-item-bounds)))) - (when bounds - (setq new-loc (point)) - (unless (markdown-cur-line-blank-p) - (newline)))) - (if (not bounds) - ;; When not in a list, start a new unordered one - (progn - (unless (markdown-cur-line-blank-p) - (insert "\n")) - (insert markdown-unordered-list-item-prefix)) - ;; Compute indentation and marker for new list item - (setq cur-indent (nth 2 bounds)) - (setq marker (nth 4 bounds)) - ;; If current item is a GFM checkbox, insert new unchecked checkbox. - (when (nth 5 bounds) - (setq marker - (concat marker - (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) - (cond - ;; Dedent: decrement indentation, find previous marker. - ((= arg 4) - (setq indent (max (- cur-indent 4) 0)) - (let ((prev-bounds - (save-excursion - (goto-char (nth 0 bounds)) - (when (markdown-up-list) - (markdown-cur-list-item-bounds))))) - (when prev-bounds - (setq marker (nth 4 prev-bounds))))) - ;; Indent: increment indentation by 4, use same marker. - ((= arg 16) (setq indent (+ cur-indent 4))) - ;; Same level: keep current indentation and marker. - (t (setq indent cur-indent))) - (setq new-indent (make-string indent 32)) - (goto-char new-loc) - (cond - ;; Ordered list - ((string-match-p "[0-9]" marker) - (if (= arg 16) ;; starting a new column indented one more level - (insert (concat new-indent "1. ")) - ;; Don't use previous match-data - (set-match-data nil) - ;; travel up to the last item and pick the correct number. If - ;; the argument was nil, "new-indent = cur-indent" is the same, - ;; so we don't need special treatment. Neat. - (save-excursion - (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) - (>= (forward-line -1) 0)))) - (let* ((old-prefix (match-string 1)) - (old-spacing (match-string 2)) - (new-prefix (if old-prefix - (int-to-string (1+ (string-to-number old-prefix))) - "1")) - (space-adjust (- (length old-prefix) (length new-prefix))) - (new-spacing (if (and (match-string 2) - (not (string-match-p "\t" old-spacing)) - (< space-adjust 0) - (> space-adjust (- 1 (length (match-string 2))))) - (substring (match-string 2) 0 space-adjust) - (or old-spacing ". ")))) - (insert (concat new-indent new-prefix new-spacing))))) - ;; Unordered list, GFM task list, or ordered list with hash mark - ((string-match-p "[\\*\\+-]\\|#\\." marker) - (insert new-indent marker)))) - ;; Propertize the newly inserted list item now - (markdown-syntax-propertize-list-items (point-at-bol) (point-at-eol))))) - -(defun markdown-move-list-item-up () - "Move the current list item up in the list when possible. -In nested lists, move child items with the parent item." - (interactive) - (let (cur prev old) - (when (setq cur (markdown-cur-list-item-bounds)) - (setq old (point)) - (goto-char (nth 0 cur)) - (if (markdown-prev-list-item (nth 3 cur)) - (progn - (setq prev (markdown-cur-list-item-bounds)) - (condition-case nil - (progn - (transpose-regions (nth 0 prev) (nth 1 prev) - (nth 0 cur) (nth 1 cur) t) - (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) - ;; Catch error in case regions overlap. - (error (goto-char old)))) - (goto-char old))))) - -(defun markdown-move-list-item-down () - "Move the current list item down in the list when possible. -In nested lists, move child items with the parent item." - (interactive) - (let (cur next old) - (when (setq cur (markdown-cur-list-item-bounds)) - (setq old (point)) - (if (markdown-next-list-item (nth 3 cur)) - (progn - (setq next (markdown-cur-list-item-bounds)) - (condition-case nil - (progn - (transpose-regions (nth 0 cur) (nth 1 cur) - (nth 0 next) (nth 1 next) nil) - (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) - ;; Catch error in case regions overlap. - (error (goto-char old)))) - (goto-char old))))) - -(defun markdown-demote-list-item (&optional bounds) - "Indent (or demote) the current list item. -Optionally, BOUNDS of the current list item may be provided if available. -In nested lists, demote child items as well." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) - (item-end (set-marker (make-marker) (nth 1 bounds))) - (list-start (progn (markdown-beginning-of-list) - (set-marker (make-marker) (point)))) - (list-end (progn (markdown-end-of-list) - (set-marker (make-marker) (point))))) - (goto-char item-start) - (while (< (point) item-end) - (unless (markdown-cur-line-blank-p) - (insert (make-string markdown-list-indent-width ? ))) - (forward-line)) - (markdown-syntax-propertize-list-items list-start list-end))))) - -(defun markdown-promote-list-item (&optional bounds) - "Unindent (or promote) the current list item. -Optionally, BOUNDS of the current list item may be provided if available. -In nested lists, demote child items as well." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (save-match-data - (let ((item-start (set-marker (make-marker) (nth 0 bounds))) - (item-end (set-marker (make-marker) (nth 1 bounds))) - (list-start (progn (markdown-beginning-of-list) - (set-marker (make-marker) (point)))) - (list-end (progn (markdown-end-of-list) - (set-marker (make-marker) (point)))) - num regexp) - (goto-char item-start) - (when (looking-at (format "^[ ]\\{1,%d\\}" - markdown-list-indent-width)) - (setq num (- (match-end 0) (match-beginning 0))) - (setq regexp (format "^[ ]\\{1,%d\\}" num)) - (while (and (< (point) item-end) - (re-search-forward regexp item-end t)) - (replace-match "" nil nil) - (forward-line)) - (markdown-syntax-propertize-list-items list-start list-end))))))) - -(defun markdown-cleanup-list-numbers-level (&optional pfx) - "Update the numbering for level PFX (as a string of spaces). - -Assume that the previously found match was for a numbered item in -a list." - (let ((cpfx pfx) - (idx 0) - (continue t) - (step t) - (sep nil)) - (while (and continue (not (eobp))) - (setq step t) - (cond - ((looking-at "^\\([\s-]*\\)[0-9]+\\. ") - (setq cpfx (match-string-no-properties 1)) - (cond - ((string= cpfx pfx) - (save-excursion - (replace-match - (concat pfx (number-to-string (setq idx (1+ idx))) ". "))) - (setq sep nil)) - ;; indented a level - ((string< pfx cpfx) - (setq sep (markdown-cleanup-list-numbers-level cpfx)) - (setq step nil)) - ;; exit the loop - (t - (setq step nil) - (setq continue nil)))) - - ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") - (setq cpfx (match-string-no-properties 1)) - (cond - ;; reset if separated before - ((string= cpfx pfx) (when sep (setq idx 0))) - ((string< cpfx pfx) - (setq step nil) - (setq continue nil)))) - (t (setq sep t))) - - (when step - (beginning-of-line) - (setq continue (= (forward-line) 0)))) - sep)) - -(defun markdown-cleanup-list-numbers () - "Update the numbering of ordered lists." - (interactive) - (save-excursion - (goto-char (point-min)) - (markdown-cleanup-list-numbers-level ""))) - - -;;; Movement ================================================================== - -(defun markdown-beginning-of-defun (&optional arg) - "`beginning-of-defun-function' for Markdown. -This is used to find the beginning of the defun and should behave -like ‘beginning-of-defun’, returning non-nil if it found the -beginning of a defun. It moves the point backward, right before a -heading which defines a defun. When ARG is non-nil, repeat that -many times. When ARG is negative, move forward to the ARG-th -following section." - (or arg (setq arg 1)) - (when (< arg 0) (end-of-line)) - ;; Adjust position for setext headings. - (when (and (thing-at-point-looking-at markdown-regex-header-setext) - (not (= (point) (match-beginning 0))) - (not (markdown-code-block-at-point-p))) - (goto-char (match-end 0))) - (let (found) - ;; Move backward with positive argument. - (while (and (not (bobp)) (> arg 0)) - (setq found nil) - (while (and (not found) - (not (bobp)) - (re-search-backward markdown-regex-header nil 'move)) - (when (not (markdown-code-block-at-pos (match-beginning 0)))) - (setq found (match-beginning 0))) - (setq arg (1- arg))) - ;; Move forward with negative argument. - (while (and (not (eobp)) (< arg 0)) - (setq found nil) - (while (and (not found) - (not (eobp)) - (re-search-forward markdown-regex-header nil 'move)) - (when (not (markdown-code-block-at-pos (match-beginning 0)))) - (setq found (match-beginning 0))) - (setq arg (1+ arg))) - (when found - (beginning-of-line) - t))) - -(defun markdown-end-of-defun () - "`end-of-defun-function’ for Markdown. -This is used to find the end of the defun at point. -It is called with no argument, right after calling ‘beginning-of-defun-raw’, -so it can assume that point is at the beginning of the defun body. -It should move point to the first position after the defun." - (or (eobp) (forward-char 1)) - (let (found) - (while (and (not found) - (not (eobp)) - (re-search-forward markdown-regex-header nil 'move)) - (when (not (markdown-code-block-at-pos (match-beginning 0))) - (setq found (match-beginning 0)))) - (when found - (goto-char found) - (skip-syntax-backward "-")))) - -(make-obsolete 'markdown-beginning-of-block 'markdown-beginning-of-text-block "v2.2") - -(defun markdown-beginning-of-text-block () - "Move backward to previous beginning of a plain text block. -This function simply looks for blank lines without considering -the surrounding context in light of Markdown syntax. For that, see -`markdown-backward-block'." - (interactive) - (let ((start (point))) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-min))) - (when (and (= start (point)) (not (bobp))) - (forward-line -1) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-min)))))) - -(make-obsolete 'markdown-end-of-block 'markdown-end-of-text-block "v2.2") - -(defun markdown-end-of-text-block () - "Move forward to next beginning of a plain text block. -This function simply looks for blank lines without considering -the surrounding context in light of Markdown syntax. For that, see -`markdown-forward-block'." - (interactive) - (beginning-of-line) - (skip-chars-forward " \t\n") - (when (= (point) (point-min)) - (forward-char)) - (if (re-search-forward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-max))) - (skip-chars-backward " \t\n") - (forward-line)) - -(defun markdown-backward-paragraph (&optional arg) - "Move the point to the start of the current paragraph. -With argument ARG, do it ARG times; a negative argument ARG = -N -means move forward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-forward-paragraph (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between paragraphs when moving backward. - (skip-chars-backward " \t\n") - (beginning-of-line) - ;; Skip over code block endings. - (when (markdown-range-properties-exist - (point-at-bol) (point-at-eol) - '(markdown-gfm-block-end - markdown-tilde-fence-end)) - (forward-line -1)) - ;; Skip over blank lines inside blockquotes. - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (= (length (match-string 3)) 0)) - (forward-line -1)) - ;; Proceed forward based on the type of block of paragraph. - (let (bounds skip) - (cond - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (while (and (not (bobp)) - (looking-at markdown-regex-blockquote) - (> (length (match-string 3)) 0)) ;; not blank - (forward-line -1)) - (forward-line)) - ;; List items - ((setq bounds (markdown-cur-list-item-bounds)) - (goto-char (nth 0 bounds))) - ;; Other - (t - (while (and (not (bobp)) - (not skip) - (not (markdown-cur-line-blank-p)) - (not (looking-at markdown-regex-blockquote)) - (not (markdown-range-properties-exist - (point-at-bol) (point-at-eol) - '(markdown-gfm-block-end - markdown-tilde-fence-end)))) - (setq skip (markdown-range-properties-exist - (point-at-bol) (point-at-eol) - '(markdown-gfm-block-begin - markdown-tilde-fence-begin))) - (forward-line -1)) - (unless (bobp) - (forward-line 1)))))))) - -(defun markdown-forward-paragraph (&optional arg) - "Move forward to the next end of a paragraph. -With argument ARG, do it ARG times; a negative argument ARG = -N -means move backward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-backward-paragraph (- arg)) - (dotimes (_ arg) - ;; Skip whitespace in between paragraphs. - (when (markdown-cur-line-blank-p) - (skip-syntax-forward "-") - (beginning-of-line)) - ;; Proceed forward based on the type of block. - (let (bounds skip) - (cond - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - ;; Skip over blank lines inside blockquotes. - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (= (length (match-string 3)) 0)) - (forward-line)) - ;; Move to end of quoted text block - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (> (length (match-string 3)) 0)) ;; not blank - (forward-line))) - ;; List items - ((and (markdown-cur-list-item-bounds) - (setq bounds (markdown-next-list-item-bounds))) - (goto-char (nth 0 bounds))) - ;; Other - (t - (forward-line) - (while (and (not (eobp)) - (not skip) - (not (markdown-cur-line-blank-p)) - (not (looking-at markdown-regex-blockquote)) - (not (markdown-range-properties-exist - (point-at-bol) (point-at-eol) - '(markdown-gfm-block-begin - markdown-tilde-fence-begin)))) - (setq skip (markdown-range-properties-exist - (point-at-bol) (point-at-eol) - '(markdown-gfm-block-end - markdown-tilde-fence-end))) - (forward-line)))))))) - -(defun markdown-backward-block (&optional arg) - "Move the point to the start of the current Markdown block. -Moves across complete code blocks, list items, and blockquotes, -but otherwise stops at blank lines, headers, and horizontal -rules. With argument ARG, do it ARG times; a negative argument -ARG = -N means move forward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-forward-block (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between blocks when moving backward, - ;; unless at a block boundary with no whitespace. - (skip-syntax-backward "-") - (beginning-of-line) - ;; Proceed forward based on the type of block. - (cond - ;; Code blocks - ((and (markdown-code-block-at-pos (point)) ;; this line - (markdown-code-block-at-pos (point-at-bol 0))) ;; previous line - (forward-line -1) - (while (and (markdown-code-block-at-point-p) (not (bobp))) - (forward-line -1)) - (forward-line)) - ;; Headings - ((markdown-heading-at-point) - (goto-char (match-beginning 0))) - ;; Horizontal rules - ((looking-at markdown-regex-hr)) - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (forward-line -1) - (while (and (looking-at markdown-regex-blockquote) - (not (bobp))) - (forward-line -1)) - (forward-line)) - ;; List items - ((markdown-cur-list-item-bounds) - (markdown-beginning-of-list)) - ;; Other - (t - ;; Move forward in case it is a one line regular paragraph. - (unless (markdown-next-line-blank-p) - (forward-line)) - (unless (markdown-prev-line-blank-p) - (markdown-backward-paragraph))))))) - -(defun markdown-forward-block (&optional arg) - "Move forward to the next end of a Markdown block. -Moves across complete code blocks, list items, and blockquotes, -but otherwise stops at blank lines, headers, and horizontal -rules. With argument ARG, do it ARG times; a negative argument -ARG = -N means move backward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-backward-block (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between blocks when moving forward. - (if (markdown-cur-line-blank-p) - (skip-syntax-forward "-") - (beginning-of-line)) - ;; Proceed forward based on the type of block. - (cond - ;; Code blocks - ((markdown-code-block-at-point-p) - (forward-line) - (while (and (markdown-code-block-at-point-p) (not (eobp))) - (forward-line))) - ;; Headings - ((looking-at markdown-regex-header) - (goto-char (or (match-end 4) (match-end 2) (match-end 3))) - (forward-line)) - ;; Horizontal rules - ((looking-at markdown-regex-hr) - (forward-line)) - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (forward-line) - (while (and (looking-at markdown-regex-blockquote) (not (eobp))) - (forward-line))) - ;; List items - ((markdown-cur-list-item-bounds) - (markdown-end-of-list) - (forward-line)) - ;; Other - (t (markdown-forward-paragraph)))) - (skip-syntax-backward "-") - (unless (eobp) - (forward-char 1)))) - -(defun markdown-backward-page (&optional count) - "Move backward to boundary of the current toplevel section. -With COUNT, repeat, or go forward if negative." - (interactive "p") - (or count (setq count 1)) - (if (< count 0) - (markdown-forward-page (- count)) - (skip-syntax-backward "-") - (or (markdown-back-to-heading-over-code-block t t) - (goto-char (point-min))) - (when (looking-at markdown-regex-header) - (let ((level (markdown-outline-level))) - (when (> level 1) (markdown-up-heading level)) - (when (> count 1) - (condition-case nil - (markdown-backward-same-level (1- count)) - (error (goto-char (point-min))))))))) - -(defun markdown-forward-page (&optional count) - "Move forward to boundary of the current toplevel section. -With COUNT, repeat, or go backward if negative." - (interactive "p") - (or count (setq count 1)) - (if (< count 0) - (markdown-backward-page (- count)) - (if (markdown-back-to-heading-over-code-block t t) - (let ((level (markdown-outline-level))) - (when (> level 1) (markdown-up-heading level)) - (condition-case nil - (markdown-forward-same-level count) - (error (goto-char (point-max))))) - (markdown-next-visible-heading 1)))) - -(defun markdown-next-link () - "Jump to next inline, reference, or wiki link. -If successful, return point. Otherwise, return nil. -See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." - (interactive) - (let ((opoint (point))) - (when (or (markdown-link-p) (markdown-wiki-link-p)) - ;; At a link already, move past it. - (goto-char (+ (match-end 0) 1))) - ;; Search for the next wiki link and move to the beginning. - (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) - (markdown-code-block-at-point-p) - (< (point) (point-max)))) - (if (and (not (eq (point) opoint)) - (or (markdown-link-p) (markdown-wiki-link-p))) - ;; Group 1 will move past non-escape character in wiki link regexp. - ;; Go to beginning of group zero for all other link types. - (goto-char (or (match-beginning 1) (match-beginning 0))) - (goto-char opoint) - nil))) - -(defun markdown-previous-link () - "Jump to previous wiki link. -If successful, return point. Otherwise, return nil. -See `markdown-wiki-link-p' and `markdown-next-wiki-link'." - (interactive) - (let ((opoint (point))) - (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) - (markdown-code-block-at-point-p) - (> (point) (point-min)))) - (if (and (not (eq (point) opoint)) - (or (markdown-link-p) (markdown-wiki-link-p))) - (goto-char (or (match-beginning 1) (match-beginning 0))) - (goto-char opoint) - nil))) - - -;;; Outline =================================================================== - -(defun markdown-move-heading-common (move-fn &optional arg adjust) - "Wrapper for `outline-mode' functions to skip false positives. -MOVE-FN is a function and ARG is its argument. For example, -headings inside preformatted code blocks may match -`outline-regexp' but should not be considered as headings. -When ADJUST is non-nil, adjust the point for interactive calls -to avoid leaving the point at invisible markup. This adjustment -generally should only be done for interactive calls, since other -functions may expect the point to be at the beginning of the -regular expression." - (let ((prev -1) (start (point))) - (if arg (funcall move-fn arg) (funcall move-fn)) - (while (and (/= prev (point)) (markdown-code-block-at-point-p)) - (setq prev (point)) - (if arg (funcall move-fn arg) (funcall move-fn))) - ;; Adjust point for setext headings and invisible text. - (save-match-data - (when (and adjust (thing-at-point-looking-at markdown-regex-header)) - (if markdown-hide-markup - ;; Move to beginning of heading text if markup is hidden. - (goto-char (or (match-beginning 1) (match-beginning 5))) - ;; Move to beginning of markup otherwise. - (goto-char (or (match-beginning 1) (match-beginning 4)))))) - (if (= (point) start) nil (point)))) - -(defun markdown-next-visible-heading (arg) - "Move to the next visible heading line of any level. -With argument, repeats or can move backward if negative. ARG is -passed to `outline-next-visible-heading'." - (interactive "p") - (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) - -(defun markdown-previous-visible-heading (arg) - "Move to the previous visible heading line of any level. -With argument, repeats or can move backward if negative. ARG is -passed to `outline-previous-visible-heading'." - (interactive "p") - (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) - -(defun markdown-next-heading () - "Move to the next heading line of any level." - (markdown-move-heading-common #'outline-next-heading)) - -(defun markdown-previous-heading () - "Move to the previous heading line of any level." - (markdown-move-heading-common #'outline-previous-heading)) - -(defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) - "Move back to the beginning of the previous heading. -Returns t if the point is at a heading, the location if a heading -was found, and nil otherwise. -Only visible heading lines are considered, unless INVISIBLE-OK is -non-nil. Throw an error if there is no previous heading unless -NO-ERROR is non-nil. -Leaves match data intact for `markdown-regex-header'." - (beginning-of-line) - (or (and (markdown-heading-at-point) - (not (markdown-code-block-at-point-p))) - (let (found) - (save-excursion - (while (and (not found) - (re-search-backward markdown-regex-header nil t)) - (when (and (or invisible-ok (not (outline-invisible-p))) - (not (markdown-code-block-at-point-p))) - (setq found (point)))) - (if (not found) - (unless no-error (user-error "Before first heading")) - (setq found (point)))) - (when found (goto-char found))))) - -(defun markdown-forward-same-level (arg) - "Move forward to the ARG'th heading at same level as this one. -Stop at the first and last headings of a superior heading." - (interactive "p") - (markdown-back-to-heading-over-code-block) - (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) - -(defun markdown-backward-same-level (arg) - "Move backward to the ARG'th heading at same level as this one. -Stop at the first and last headings of a superior heading." - (interactive "p") - (markdown-back-to-heading-over-code-block) - (while (> arg 0) - (let ((point-to-move-to - (save-excursion - (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (user-error "No previous same-level heading"))))) - -(defun markdown-up-heading (arg) - "Move to the visible heading line of which the present line is a subheading. -With argument, move up ARG levels." - (interactive "p") - (and (called-interactively-p 'any) - (not (eq last-command 'markdown-up-heading)) (push-mark)) - (markdown-move-heading-common #'outline-up-heading arg 'adjust)) - -(defun markdown-back-to-heading (&optional invisible-ok) - "Move to previous heading line, or beg of this line if it's a heading. -Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) - -(defalias 'markdown-end-of-heading 'outline-end-of-heading) - -(defun markdown-on-heading-p () - "Return non-nil if point is on a heading line." - (get-text-property (point-at-bol) 'markdown-heading)) - -(defun markdown-end-of-subtree (&optional invisible-OK) - "Move to the end of the current subtree. -Only visible heading lines are considered, unless INVISIBLE-OK is -non-nil. -Derived from `org-end-of-subtree'." - (markdown-back-to-heading invisible-OK) - (let ((first t) - (level (markdown-outline-level))) - (while (and (not (eobp)) - (or first (> (markdown-outline-level) level))) - (setq first nil) - (markdown-next-heading)) - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1))))) - (point)) - -(defun markdown-outline-fix-visibility () - "Hide any false positive headings that should not be shown. -For example, headings inside preformatted code blocks may match -`outline-regexp' but should not be shown as headings when cycling. -Also, the ending --- line in metadata blocks appears to be a -setext header, but should not be folded." - (save-excursion - (goto-char (point-min)) - ;; Unhide any false positives in metadata blocks - (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) - (let ((body (progn (forward-line) - (markdown-text-property-at-point - 'markdown-yaml-metadata-section)))) - (when body - (let ((end (progn (goto-char (cl-second body)) - (markdown-text-property-at-point - 'markdown-yaml-metadata-end)))) - (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) - ;; Hide any false positives in code blocks - (unless (outline-on-heading-p) - (outline-next-visible-heading 1)) - (while (< (point) (point-max)) - (when (markdown-code-block-at-point-p) - (outline-flag-region (1- (point-at-bol)) (point-at-eol) t)) - (outline-next-visible-heading 1)))) - -(defvar markdown-cycle-global-status 1) -(defvar markdown-cycle-subtree-status nil) - -(defun markdown-next-preface () - (let (finish) - (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") - nil 'move)) - (unless (markdown-code-block-at-point-p) - (goto-char (match-beginning 0)) - (setq finish t)))) - (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) - (forward-char -1))) - -(defun markdown-show-entry () - (save-excursion - (outline-back-to-heading t) - (outline-flag-region (1- (point)) - (progn - (markdown-next-preface) - (if (= 1 (- (point-max) (point))) - (point-max) - (point))) - nil))) - -;; This function was originally derived from `org-cycle' from org.el. -(defun markdown-cycle (&optional arg) - "Visibility cycling for Markdown mode. -If ARG is t, perform global visibility cycling. If the point is -at an atx-style header, cycle visibility of the corresponding -subtree. Otherwise, indent the current line or insert a tab, -as appropriate, by calling `indent-for-tab-command'." - (interactive "P") - (cond - - ;; Global cycling - ((eq arg t) - (cond - ;; Move from overview to contents - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 2)) - (markdown-hide-sublevels 1) - (message "CONTENTS") - (setq markdown-cycle-global-status 3) - (markdown-outline-fix-visibility)) - ;; Move from contents to all - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 3)) - (markdown-show-all) - (message "SHOW ALL") - (setq markdown-cycle-global-status 1)) - ;; Defaults to overview - (t - (markdown-hide-body) - (message "OVERVIEW") - (setq markdown-cycle-global-status 2) - (markdown-outline-fix-visibility)))) - - ;; At a heading: rotate between three different views - ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) - (markdown-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; Determine boundaries - (save-excursion - (markdown-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (markdown-end-of-heading) (setq eoh (point)) - (markdown-end-of-subtree t) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ;; Nothing is hidden behind this heading - ((= eos eoh) - (message "EMPTY ENTRY") - (setq markdown-cycle-subtree-status nil)) - ;; Entire subtree is hidden in one line: open it - ((>= eol eos) - (markdown-show-entry) - (markdown-show-children) - (message "CHILDREN") - (setq markdown-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - ((and (eq last-command this-command) - (eq markdown-cycle-subtree-status 'children)) - (markdown-show-subtree) - (message "SUBTREE") - (setq markdown-cycle-subtree-status 'subtree)) - ;; Default action: hide the subtree. - (t - (markdown-hide-subtree) - (message "FOLDED") - (setq markdown-cycle-subtree-status 'folded))))) - - ;; In a table, move forward by one cell - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-forward-cell)) - - ;; Otherwise, indent as appropriate - (t - (indent-for-tab-command)))) - -(defun markdown-shifttab () - "Handle S-TAB keybinding based on context. -When in a table, move backward one cell. -Otherwise, cycle global heading visibility by calling -`markdown-cycle' with argument t." - (interactive) - (cond ((markdown-table-at-point-p) - (call-interactively #'markdown-table-backward-cell)) - (t (markdown-cycle t)))) - -(defun markdown-outline-level () - "Return the depth to which a statement is nested in the outline." - (cond - ((and (match-beginning 0) - (markdown-code-block-at-pos (match-beginning 0))) - 7) ;; Only 6 header levels are defined. - ((match-end 2) 1) - ((match-end 3) 2) - ((match-end 4) - (length (markdown-trim-whitespace (match-string-no-properties 4)))))) - -(defun markdown-promote-subtree (&optional arg) - "Promote the current subtree of ATX headings. -Note that Markdown does not support heading levels higher than -six and therefore level-six headings will not be promoted -further. If ARG is non-nil promote the heading, otherwise -demote." - (interactive "*P") - (save-excursion - (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) - (re-search-backward markdown-regex-header-atx nil t)) - (not (markdown-code-block-at-point-p))) - (let ((level (length (match-string 1))) - (promote-or-demote (if arg 1 -1)) - (remove 't)) - (markdown-cycle-atx promote-or-demote remove) - (catch 'end-of-subtree - (while (and (markdown-next-heading) - (looking-at markdown-regex-header-atx)) - ;; Exit if this not a higher level heading; promote otherwise. - (if (and (looking-at markdown-regex-header-atx) - (<= (length (match-string-no-properties 1)) level)) - (throw 'end-of-subtree nil) - (markdown-cycle-atx promote-or-demote remove)))))))) - -(defun markdown-demote-subtree () - "Demote the current subtree of ATX headings." - (interactive) - (markdown-promote-subtree t)) - -(defun markdown-move-subtree-up () - "Move the current subtree of ATX headings up." - (interactive) - (outline-move-subtree-up 1)) - -(defun markdown-move-subtree-down () - "Move the current subtree of ATX headings down." - (interactive) - (outline-move-subtree-down 1)) - -(defun markdown-outline-next () - "Move to next list item, when in a list, or next visible heading." - (interactive) - (let ((bounds (markdown-next-list-item-bounds))) - (if bounds - (goto-char (nth 0 bounds)) - (markdown-next-visible-heading 1)))) - -(defun markdown-outline-previous () - "Move to previous list item, when in a list, or previous visible heading." - (interactive) - (let ((bounds (markdown-prev-list-item-bounds))) - (if bounds - (goto-char (nth 0 bounds)) - (markdown-previous-visible-heading 1)))) - -(defun markdown-outline-next-same-level () - "Move to next list item or heading of same level." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (markdown-next-list-item (nth 3 bounds)) - (markdown-forward-same-level 1)))) - -(defun markdown-outline-previous-same-level () - "Move to previous list item or heading of same level." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (markdown-prev-list-item (nth 3 bounds)) - (markdown-backward-same-level 1)))) - -(defun markdown-outline-up () - "Move to previous list item, when in a list, or next heading." - (interactive) - (unless (markdown-up-list) - (markdown-up-heading 1))) - - -;;; Marking and Narrowing ===================================================== - -(defun markdown-mark-paragraph () - "Put mark at end of this block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-paragraph) - (point))) - (let ((beginning-of-defun-function 'markdown-backward-paragraph) - (end-of-defun-function 'markdown-forward-paragraph)) - (mark-defun)))) - -(defun markdown-mark-block () - "Put mark at end of this block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-block) - (point))) - (let ((beginning-of-defun-function 'markdown-backward-block) - (end-of-defun-function 'markdown-forward-block)) - (mark-defun)))) - -(defun markdown-narrow-to-block () - "Make text outside current block invisible. -The current block is the one that contains point or follows point." - (interactive) - (let ((beginning-of-defun-function 'markdown-backward-block) - (end-of-defun-function 'markdown-forward-block)) - (narrow-to-defun))) - -(defun markdown-mark-text-block () - "Put mark at end of this plain text block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-end-of-text-block) - (point))) - (let ((beginning-of-defun-function 'markdown-beginning-of-text-block) - (end-of-defun-function 'markdown-end-of-text-block)) - (mark-defun)))) - -(defun markdown-mark-page () - "Put mark at end of this top level section, point at beginning. -The top level section marked is the one that contains point or -follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next page after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-page) - (point))) - (let ((beginning-of-defun-function 'markdown-backward-page) - (end-of-defun-function 'markdown-forward-page)) - (mark-defun)))) - -(defun markdown-narrow-to-page () - "Make text outside current top level section invisible. -The current section is the one that contains point or follows point." - (interactive) - (let ((beginning-of-defun-function 'markdown-backward-page) - (end-of-defun-function 'markdown-forward-page)) - (narrow-to-defun))) - -(defun markdown-mark-subtree () - "Mark the current subtree. -This puts point at the start of the current subtree, and mark at the end." - (interactive) - (let ((beg)) - (if (markdown-heading-at-point) - (beginning-of-line) - (markdown-previous-visible-heading 1)) - (setq beg (point)) - (markdown-end-of-subtree) - (push-mark (point) nil t) - (goto-char beg))) - -(defun markdown-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (save-match-data - (narrow-to-region - (progn (markdown-back-to-heading-over-code-block t) (point)) - (progn (markdown-end-of-subtree) - (if (and (markdown-heading-at-point) (not (eobp))) - (backward-char 1)) - (point)))))) - - -;;; Generic Structure Editing, Completion, and Cycling Commands =============== - -(defun markdown-move-up () - "Move thing at point up. -When in a list item, call `markdown-move-list-item-up'. -When in a table, call `markdown-table-move-row-up'. -Otherwise, move the current heading subtree up with -`markdown-move-subtree-up'." - (interactive) - (cond - ((markdown-list-item-at-point-p) - (call-interactively #'markdown-move-list-item-up)) - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-row-up)) - (t - (call-interactively #'markdown-move-subtree-up)))) - -(defun markdown-move-down () - "Move thing at point down. -When in a list item, call `markdown-move-list-item-down'. -Otherwise, move the current heading subtree up with -`markdown-move-subtree-down'." - (interactive) - (cond - ((markdown-list-item-at-point-p) - (call-interactively #'markdown-move-list-item-down)) - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-row-down)) - (t - (call-interactively #'markdown-move-subtree-down)))) - -(defun markdown-promote () - "Promote or move element at point to the left. -Depending on the context, this function will promote a heading or -list item at the point, move a table column to the left, or cycle -markup." - (interactive) - (let (bounds) - (cond - ;; Promote atx heading subtree - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-promote-subtree)) - ;; Promote setext heading - ((thing-at-point-looking-at markdown-regex-header-setext) - (markdown-cycle-setext -1)) - ;; Promote horizonal rule - ((thing-at-point-looking-at markdown-regex-hr) - (markdown-cycle-hr -1)) - ;; Promote list item - ((setq bounds (markdown-cur-list-item-bounds)) - (markdown-promote-list-item bounds)) - ;; Move table column to the left - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-column-left)) - ;; Promote bold - ((thing-at-point-looking-at markdown-regex-bold) - (markdown-cycle-bold)) - ;; Promote italic - ((thing-at-point-looking-at markdown-regex-italic) - (markdown-cycle-italic)) - (t - (user-error "Nothing to promote at point"))))) - -(defun markdown-demote () - "Demote or move element at point to the right. -Depending on the context, this function will demote a heading or -list item at the point, move a table column to the right, or cycle -or remove markup." - (interactive) - (let (bounds) - (cond - ;; Demote atx heading subtree - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-demote-subtree)) - ;; Demote setext heading - ((thing-at-point-looking-at markdown-regex-header-setext) - (markdown-cycle-setext 1)) - ;; Demote horizonal rule - ((thing-at-point-looking-at markdown-regex-hr) - (markdown-cycle-hr 1)) - ;; Demote list item - ((setq bounds (markdown-cur-list-item-bounds)) - (markdown-demote-list-item bounds)) - ;; Move table column to the right - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-column-right)) - ;; Demote bold - ((thing-at-point-looking-at markdown-regex-bold) - (markdown-cycle-bold)) - ;; Demote italic - ((thing-at-point-looking-at markdown-regex-italic) - (markdown-cycle-italic)) - (t - (user-error "Nothing to demote at point"))))) - - -;;; Commands ================================================================== - -(defun markdown (&optional output-buffer-name) - "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. -The output buffer name defaults to `markdown-output-buffer-name'. -Return the name of the output buffer used." - (interactive) - (save-window-excursion - (let ((begin-region) - (end-region)) - (if (markdown-use-region-p) - (setq begin-region (region-beginning) - end-region (region-end)) - (setq begin-region (point-min) - end-region (point-max))) - - (unless output-buffer-name - (setq output-buffer-name markdown-output-buffer-name)) - (let ((exit-code - (cond - ;; Handle case when `markdown-command' does not read from stdin - ((and (stringp markdown-command) markdown-command-needs-filename) - (if (not buffer-file-name) - (user-error "Must be visiting a file") - ;; Don’t use ‘shell-command’ because it’s not guaranteed to - ;; return the exit code of the process. - (shell-command-on-region - ;; Pass an empty region so that stdin is empty. - (point) (point) - (concat markdown-command " " - (shell-quote-argument buffer-file-name)) - output-buffer-name))) - ;; Pass region to `markdown-command' via stdin - (t - (let ((buf (get-buffer-create output-buffer-name))) - (with-current-buffer buf - (setq buffer-read-only nil) - (erase-buffer)) - (if (stringp markdown-command) - (call-process-region begin-region end-region - shell-file-name nil buf nil - shell-command-switch markdown-command) - (funcall markdown-command begin-region end-region buf) - ;; If the ‘markdown-command’ function didn’t signal an - ;; error, assume it succeeded by binding ‘exit-code’ to 0. - 0)))))) - ;; The exit code can be a signal description string, so don’t use ‘=’ - ;; or ‘zerop’. - (unless (eq exit-code 0) - (user-error "%s failed with exit code %s" - markdown-command exit-code)))) - output-buffer-name)) - -(defun markdown-standalone (&optional output-buffer-name) - "Special function to provide standalone HTML output. -Insert the output in the buffer named OUTPUT-BUFFER-NAME." - (interactive) - (setq output-buffer-name (markdown output-buffer-name)) - (with-current-buffer output-buffer-name - (set-buffer output-buffer-name) - (unless (markdown-output-standalone-p) - (markdown-add-xhtml-header-and-footer output-buffer-name)) - (goto-char (point-min)) - (html-mode)) - output-buffer-name) - -(defun markdown-other-window (&optional output-buffer-name) - "Run `markdown-command' on current buffer and display in other window. -When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with -that name." - (interactive) - (markdown-display-buffer-other-window - (markdown-standalone output-buffer-name))) - -(defun markdown-output-standalone-p () - "Determine whether `markdown-command' output is standalone XHTML. -Standalone XHTML output is identified by an occurrence of -`markdown-xhtml-standalone-regexp' in the first five lines of output." - (save-excursion - (goto-char (point-min)) - (save-match-data - (re-search-forward - markdown-xhtml-standalone-regexp - (save-excursion (goto-char (point-min)) (forward-line 4) (point)) - t)))) - -(defun markdown-stylesheet-link-string (stylesheet-path) - (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" - stylesheet-path - "\" />")) - -(defun markdown-add-xhtml-header-and-footer (title) - "Wrap XHTML header and footer with given TITLE around current buffer." - (goto-char (point-min)) - (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" - "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" - "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" - "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" - "<head>\n<title>") - (insert title) - (insert "</title>\n") - (unless (= (length markdown-content-type) 0) - (insert - (format - "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" - markdown-content-type - (or (and markdown-coding-system - (fboundp 'coding-system-get) - (coding-system-get markdown-coding-system - 'mime-charset)) - (and (fboundp 'coding-system-get) - (coding-system-get buffer-file-coding-system - 'mime-charset)) - "utf-8")))) - (if (> (length markdown-css-paths) 0) - (insert (mapconcat #'markdown-stylesheet-link-string - markdown-css-paths "\n"))) - (when (> (length markdown-xhtml-header-content) 0) - (insert markdown-xhtml-header-content)) - (insert "\n</head>\n\n" - "<body>\n\n") - (when (> (length markdown-xhtml-body-preamble) 0) - (insert markdown-xhtml-body-preamble "\n")) - (goto-char (point-max)) - (when (> (length markdown-xhtml-body-epilogue) 0) - (insert "\n" markdown-xhtml-body-epilogue)) - (insert "\n" - "</body>\n" - "</html>\n")) - -(defun markdown-preview (&optional output-buffer-name) - "Run `markdown-command' on the current buffer and view output in browser. -When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with -that name." - (interactive) - (browse-url-of-buffer - (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) - -(defun markdown-export-file-name (&optional extension) - "Attempt to generate a filename for Markdown output. -The file extension will be EXTENSION if given, or .html by default. -If the current buffer is visiting a file, we construct a new -output filename based on that filename. Otherwise, return nil." - (when (buffer-file-name) - (unless extension - (setq extension ".html")) - (let ((candidate - (concat - (cond - ((buffer-file-name) - (file-name-sans-extension (buffer-file-name))) - (t (buffer-name))) - extension))) - (cond - ((equal candidate (buffer-file-name)) - (concat candidate extension)) - (t - candidate))))) - -(defun markdown-export (&optional output-file) - "Run Markdown on the current buffer, save to file, and return the filename. -If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename -generated by `markdown-export-file-name', which will be constructed using the -current filename, but with the extension removed and replaced with .html." - (interactive) - (unless output-file - (setq output-file (markdown-export-file-name ".html"))) - (when output-file - (let* ((init-buf (current-buffer)) - (init-point (point)) - (init-buf-string (buffer-string)) - (output-buffer (find-file-noselect output-file)) - (output-buffer-name (buffer-name output-buffer))) - (run-hooks 'markdown-before-export-hook) - (markdown-standalone output-buffer-name) - (with-current-buffer output-buffer - (run-hooks 'markdown-after-export-hook) - (save-buffer) - (when markdown-export-kill-buffer (kill-buffer))) - ;; if modified, restore initial buffer - (when (buffer-modified-p init-buf) - (erase-buffer) - (insert init-buf-string) - (save-buffer) - (goto-char init-point)) - output-file))) - -(defun markdown-export-and-preview () - "Export to XHTML using `markdown-export' and browse the resulting file." - (interactive) - (browse-url-of-file (markdown-export))) - -(defvar markdown-live-preview-buffer nil - "Buffer used to preview markdown output in `markdown-live-preview-export'.") -(make-variable-buffer-local 'markdown-live-preview-buffer) - -(defvar markdown-live-preview-source-buffer nil - "Source buffer from which current buffer was generated. -This is the inverse of `markdown-live-preview-buffer'.") -(make-variable-buffer-local 'markdown-live-preview-source-buffer) - -(defvar markdown-live-preview-currently-exporting nil) - -(defun markdown-live-preview-get-filename () - "Standardize the filename exported by `markdown-live-preview-export'." - (markdown-export-file-name ".html")) - -(defun markdown-live-preview-window-eww (file) - "Preview FILE with eww. -To be used with `markdown-live-preview-window-function'." - (if (require 'eww nil t) - (progn - (eww-open-file file) - (get-buffer "*eww*")) - (error "EWW is not present or not loaded on this version of Emacs"))) - -(defun markdown-visual-lines-between-points (beg end) - (save-excursion - (goto-char beg) - (cl-loop with count = 0 - while (progn (end-of-visual-line) - (and (< (point) end) (line-move-visual 1 t))) - do (cl-incf count) - finally return count))) - -(defun markdown-live-preview-window-serialize (buf) - "Get window point and scroll data for all windows displaying BUF." - (when (buffer-live-p buf) - (with-current-buffer buf - (mapcar - (lambda (win) - (with-selected-window win - (let* ((start (window-start)) - (pt (window-point)) - (pt-or-sym (cond ((= pt (point-min)) 'min) - ((= pt (point-max)) 'max) - (t pt))) - (diff (markdown-visual-lines-between-points - start pt))) - (list win pt-or-sym diff)))) - (get-buffer-window-list buf))))) - -(defun markdown-get-point-back-lines (pt num-lines) - (save-excursion - (goto-char pt) - (line-move-visual (- num-lines) t) - ;; in testing, can occasionally overshoot the number of lines to traverse - (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) - (when (> actual-num-lines num-lines) - (line-move-visual (- actual-num-lines num-lines) t))) - (point))) - -(defun markdown-live-preview-window-deserialize (window-posns) - "Apply window point and scroll data from WINDOW-POSNS. -WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." - (cl-destructuring-bind (win pt-or-sym diff) window-posns - (when (window-live-p win) - (with-current-buffer markdown-live-preview-buffer - (set-window-buffer win (current-buffer)) - (cl-destructuring-bind (actual-pt actual-diff) - (cl-case pt-or-sym - (min (list (point-min) 0)) - (max (list (point-max) diff)) - (t (list pt-or-sym diff))) - (set-window-start - win (markdown-get-point-back-lines actual-pt actual-diff)) - (set-window-point win actual-pt)))))) - -(defun markdown-live-preview-export () - "Export to XHTML using `markdown-export'. -Browse the resulting file within Emacs using -`markdown-live-preview-window-function' Return the buffer -displaying the rendered output." - (interactive) - (let ((filename (markdown-live-preview-get-filename))) - (when filename - (let* ((markdown-live-preview-currently-exporting t) - (cur-buf (current-buffer)) - (export-file (markdown-export filename)) - ;; get positions in all windows currently displaying output buffer - (window-data - (markdown-live-preview-window-serialize - markdown-live-preview-buffer))) - (save-window-excursion - (let ((output-buffer - (funcall markdown-live-preview-window-function export-file))) - (with-current-buffer output-buffer - (setq markdown-live-preview-source-buffer cur-buf) - (add-hook 'kill-buffer-hook - #'markdown-live-preview-remove-on-kill t t)) - (with-current-buffer cur-buf - (setq markdown-live-preview-buffer output-buffer)))) - (with-current-buffer cur-buf - ;; reset all windows displaying output buffer to where they were, - ;; now with the new output - (mapc #'markdown-live-preview-window-deserialize window-data) - ;; delete html editing buffer - (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) - (when (and export-file (file-exists-p export-file) - (eq markdown-live-preview-delete-export - 'delete-on-export)) - (delete-file export-file)) - markdown-live-preview-buffer))))) - -(defun markdown-live-preview-remove () - (when (buffer-live-p markdown-live-preview-buffer) - (kill-buffer markdown-live-preview-buffer)) - (setq markdown-live-preview-buffer nil) - ;; if set to 'delete-on-export, the output has already been deleted - (when (eq markdown-live-preview-delete-export 'delete-on-destroy) - (let ((outfile-name (markdown-live-preview-get-filename))) - (when (and outfile-name (file-exists-p outfile-name)) - (delete-file outfile-name))))) - -(defun markdown-get-other-window () - "Find another window to display preview or output content." - (cond - ((memq markdown-split-window-direction '(vertical below)) - (or (window-in-direction 'below) (split-window-vertically))) - ((memq markdown-split-window-direction '(horizontal right)) - (or (window-in-direction 'right) (split-window-horizontally))) - (t (split-window-sensibly (get-buffer-window))))) - -(defun markdown-display-buffer-other-window (buf) - "Display preview or output buffer BUF in another window." - (let ((cur-buf (current-buffer)) - (window (markdown-get-other-window))) - (set-window-buffer window buf) - (set-buffer cur-buf))) - -(defun markdown-live-preview-if-markdown () - (when (and (derived-mode-p 'markdown-mode) - markdown-live-preview-mode) - (unless markdown-live-preview-currently-exporting - (if (buffer-live-p markdown-live-preview-buffer) - (markdown-live-preview-export) - (markdown-display-buffer-other-window - (markdown-live-preview-export)))))) - -(defun markdown-live-preview-remove-on-kill () - (cond ((and (derived-mode-p 'markdown-mode) - markdown-live-preview-mode) - (markdown-live-preview-remove)) - (markdown-live-preview-source-buffer - (with-current-buffer markdown-live-preview-source-buffer - (setq markdown-live-preview-buffer nil)) - (setq markdown-live-preview-source-buffer nil)))) - -(defun markdown-live-preview-switch-to-output () - "Switch to output buffer." - (interactive) - "Turn on `markdown-live-preview-mode' if not already on, and switch to its -output buffer in another window." - (if markdown-live-preview-mode - (markdown-display-buffer-other-window (markdown-live-preview-export))) - (markdown-live-preview-mode)) - -(defun markdown-live-preview-re-export () - "Re export source buffer." - (interactive) - "If the current buffer is a buffer displaying the exported version of a -`markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and -update this buffer's contents." - (when markdown-live-preview-source-buffer - (with-current-buffer markdown-live-preview-source-buffer - (markdown-live-preview-export)))) - -(defun markdown-open () - "Open file for the current buffer with `markdown-open-command'." - (interactive) - (unless markdown-open-command - (user-error "Variable `markdown-open-command' must be set")) - (if (stringp markdown-open-command) - (if (not buffer-file-name) - (user-error "Must be visiting a file") - (save-buffer) - (let ((exit-code (call-process markdown-open-command nil nil nil - buffer-file-name))) - ;; The exit code can be a signal description string, so don’t use ‘=’ - ;; or ‘zerop’. - (unless (eq exit-code 0) - (user-error "%s failed with exit code %s" - markdown-open-command exit-code)))) - (funcall markdown-open-command)) - nil) - -(defun markdown-kill-ring-save () - "Run Markdown on file and store output in the kill ring." - (interactive) - (save-window-excursion - (markdown) - (with-current-buffer markdown-output-buffer-name - (kill-ring-save (point-min) (point-max))))) - - -;;; Links ===================================================================== - -(defun markdown-link-p () - "Return non-nil when `point' is at a non-wiki link. -See `markdown-wiki-link-p' for more information." - (let ((case-fold-search nil)) - (and (not (markdown-wiki-link-p)) - (not (markdown-code-block-at-point-p)) - (or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference) - (thing-at-point-looking-at markdown-regex-uri) - (thing-at-point-looking-at markdown-regex-angle-uri))))) - -(make-obsolete 'markdown-link-link 'markdown-link-url "v2.3") - -(defun markdown-link-at-pos (pos) - "Return properties of link or image at position POS. -Value is a list of elements describing the link: - 0. beginning position - 1. end position - 2. link text - 3. URL - 4. reference label - 5. title text - 6. bang (nil or \"!\")" - (save-excursion - (goto-char pos) - (let (begin end text url reference title bang) - (cond - ;; Inline or reference image or link at point. - ((or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference)) - (setq bang (match-string-no-properties 1) - begin (match-beginning 0) - end (match-end 0) - text (match-string-no-properties 3)) - (if (char-equal (char-after (match-beginning 5)) ?\[) - ;; Reference link - (setq reference (match-string-no-properties 6)) - ;; Inline link - (setq url (match-string-no-properties 6)) - (when (match-end 7) - (setq title (substring (match-string-no-properties 7) 1 -1))))) - ;; Angle bracket URI at point. - ((thing-at-point-looking-at markdown-regex-angle-uri) - (setq begin (match-beginning 0) - end (match-end 0) - url (match-string-no-properties 2))) - ;; Plain URI at point. - ((thing-at-point-looking-at markdown-regex-uri) - (setq begin (match-beginning 0) - end (match-end 0) - url (match-string-no-properties 1)))) - (list begin end text url reference title bang)))) - -(defun markdown-link-url () - "Return the URL part of the regular (non-wiki) link at point. -Works with both inline and reference style links, and with images. -If point is not at a link or the link reference is not defined -returns nil." - (let* ((values (markdown-link-at-pos (point))) - (text (nth 2 values)) - (url (nth 3 values)) - (ref (nth 4 values))) - (or url (and ref (car (markdown-reference-definition - (downcase (if (string= ref "") text ref)))))))) - -(defun markdown-follow-link-at-point () - "Open the current non-wiki link. -If the link is a complete URL, open in browser with `browse-url'. -Otherwise, open with `find-file' after stripping anchor and/or query string. -Translate filenames using `markdown-filename-translate-function'." - (interactive) - (if (markdown-link-p) - (let* ((url (markdown-link-url)) - (struct (url-generic-parse-url url)) - (full (url-fullness struct)) - (file url)) - ;; Parse URL, determine fullness, strip query string - (if (fboundp 'url-path-and-query) - (setq file (car (url-path-and-query struct))) - (when (and (setq file (url-filename struct)) - (string-match "\\?" file)) - (setq file (substring file 0 (match-beginning 0))))) - ;; Open full URLs in browser, files in Emacs - (if full - (browse-url url) - (when (and file (> (length file) 0)) - (find-file (funcall markdown-translate-filename-function file))))) - (user-error "Point is not at a Markdown link or URL"))) - -(defun markdown-fontify-inline-links (last) - "Add text properties to next inline link from point to LAST." - (when (markdown-match-generic-links last nil) - (let* ((link-start (match-beginning 3)) - (link-end (match-end 3)) - (url-start (match-beginning 6)) - (url-end (match-end 6)) - (url (match-string-no-properties 6)) - (title-start (match-beginning 7)) - (title-end (match-end 7)) - (title (match-string-no-properties 7)) - ;; Markup part - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; Link part (without face) - (lp (list 'keymap markdown-mode-mouse-map - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t - 'help-echo (if title (concat title "\n" url) url))) - ;; URL part - (up (list 'keymap markdown-mode-mouse-map - 'face 'markdown-url-face - 'invisible 'markdown-markup - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t)) - ;; URL composition character - (url-char (markdown--first-displayable markdown-url-compose-char)) - ;; Title part - (tp (list 'face 'markdown-link-title-face - 'invisible 'markdown-markup - 'font-lock-multiline t))) - (dolist (g '(1 2 4 5 8)) - (when (match-end g) - (add-text-properties (match-beginning g) (match-end g) mp))) - ;; Preserve existing faces applied to link part (e.g., inline code) - (when link-start - (add-text-properties link-start link-end lp) - (add-face-text-property link-start link-end - 'markdown-link-face 'append)) - (when url-start (add-text-properties url-start url-end up)) - (when title-start (add-text-properties url-end title-end tp)) - (when (and markdown-hide-urls url-start) - (compose-region url-start (or title-end url-end) url-char)) - t))) - -(defun markdown-fontify-reference-links (last) - "Add text properties to next reference link from point to LAST." - (when (markdown-match-generic-links last t) - (let* ((link-start (match-beginning 3)) - (link-end (match-end 3)) - (ref-start (match-beginning 6)) - (ref-end (match-end 6)) - ;; Markup part - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; Link part - (lp (list 'keymap markdown-mode-mouse-map - 'face 'markdown-link-face - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t - 'help-echo (lambda (_ __ pos) - (save-match-data - (save-excursion - (goto-char pos) - (or (markdown-link-url) - "Undefined reference")))))) - ;; URL composition character - (url-char (markdown--first-displayable markdown-url-compose-char)) - ;; Reference part - (rp (list 'face 'markdown-reference-face - 'invisible 'markdown-markup - 'font-lock-multiline t))) - (dolist (g '(1 2 4 5 8)) - (when (match-end g) - (add-text-properties (match-beginning g) (match-end g) mp))) - (when link-start (add-text-properties link-start link-end lp)) - (when ref-start (add-text-properties ref-start ref-end rp) - (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) - (compose-region ref-start ref-end url-char))) - t))) - -(defun markdown-fontify-angle-uris (last) - "Add text properties to angle URIs from point to LAST." - (when (markdown-match-angle-uris last) - (let* ((url-start (match-beginning 2)) - (url-end (match-end 2)) - ;; Markup part - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; URI part - (up (list 'keymap markdown-mode-mouse-map - 'face 'markdown-plain-url-face - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t))) - (dolist (g '(1 3)) - (add-text-properties (match-beginning g) (match-end g) mp)) - (add-text-properties url-start url-end up) - t))) - -(defun markdown-fontify-plain-uris (last) - "Add text properties to plain URLs from point to LAST." - (when (markdown-match-plain-uris last) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (props (list 'keymap markdown-mode-mouse-map - 'face 'markdown-plain-url-face - 'mouse-face 'markdown-highlight-face - 'rear-nonsticky t - 'font-lock-multiline t))) - (add-text-properties start end props) - t))) - -(defun markdown-toggle-url-hiding (&optional arg) - "Toggle the display or hiding of URLs. -With a prefix argument ARG, enable URL hiding if ARG is positive, -and disable it otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-hide-urls - (if (eq arg 'toggle) - (not markdown-hide-urls) - (> (prefix-numeric-value arg) 0))) - (if markdown-hide-urls - (message "markdown-mode URL hiding enabled") - (message "markdown-mode URL hiding disabled")) - (markdown-reload-extensions)) - - -;;; Wiki Links ================================================================ - -(defun markdown-wiki-link-p () - "Return non-nil if wiki links are enabled and `point' is at a true wiki link. -A true wiki link name matches `markdown-regex-wiki-link' but does -not match the current file name after conversion. This modifies -the data returned by `match-data'. Note that the potential wiki -link name must be available via `match-string'." - (when markdown-enable-wiki-links - (let ((case-fold-search nil)) - (and (thing-at-point-looking-at markdown-regex-wiki-link) - (not (markdown-code-block-at-point-p)) - (or (not buffer-file-name) - (not (string-equal (buffer-file-name) - (markdown-convert-wiki-link-to-filename - (markdown-wiki-link-link))))))))) - -(defun markdown-wiki-link-link () - "Return the link part of the wiki link using current match data. -The location of the link component depends on the value of -`markdown-wiki-link-alias-first'." - (if markdown-wiki-link-alias-first - (or (match-string-no-properties 5) (match-string-no-properties 3)) - (match-string-no-properties 3))) - -(defun markdown-wiki-link-alias () - "Return the alias or text part of the wiki link using current match data. -The location of the alias component depends on the value of -`markdown-wiki-link-alias-first'." - (if markdown-wiki-link-alias-first - (match-string-no-properties 3) - (or (match-string-no-properties 5) (match-string-no-properties 3)))) - -(defun markdown-convert-wiki-link-to-filename (name) - "Generate a filename from the wiki link NAME. -Spaces in NAME are replaced with `markdown-link-space-sub-char'. -When in `gfm-mode', follow GitHub's conventions where [[Test Test]] -and [[test test]] both map to Test-test.ext. Look in the current -directory first, then in subdirectories if -`markdown-wiki-link-search-subdirectories' is non-nil, and then -in parent directories if -`markdown-wiki-link-search-parent-directories' is non-nil." - (let* ((basename (markdown-replace-regexp-in-string - "[[:space:]\n]" markdown-link-space-sub-char name)) - (basename (if (memq major-mode '(gfm-mode gfm-view-mode)) - (concat (upcase (substring basename 0 1)) - (downcase (substring basename 1 nil))) - basename)) - directory extension default candidates dir) - (when buffer-file-name - (setq directory (file-name-directory buffer-file-name) - extension (file-name-extension buffer-file-name))) - (setq default (concat basename - (when extension (concat "." extension)))) - (cond - ;; Look in current directory first. - ((or (null buffer-file-name) - (file-exists-p default)) - default) - ;; Possibly search in subdirectories, next. - ((and markdown-wiki-link-search-subdirectories - (setq candidates - (markdown-directory-files-recursively - directory (concat "^" default "$")))) - (car candidates)) - ;; Possibly search in parent directories as a last resort. - ((and markdown-wiki-link-search-parent-directories - (setq dir (locate-dominating-file directory default))) - (concat dir default)) - ;; If nothing is found, return default in current directory. - (t default)))) - -(defun markdown-follow-wiki-link (name &optional other) - "Follow the wiki link NAME. -Convert the name to a file name and call `find-file'. Ensure that -the new buffer remains in `markdown-mode'. Open the link in another -window when OTHER is non-nil." - (let ((filename (markdown-convert-wiki-link-to-filename name)) - (wp (when buffer-file-name - (file-name-directory buffer-file-name)))) - (if (not wp) - (user-error "Must be visiting a file") - (when other (other-window 1)) - (let ((default-directory wp)) - (find-file filename))) - (when (not (eq major-mode 'markdown-mode)) - (markdown-mode)))) - -(defun markdown-follow-wiki-link-at-point (&optional arg) - "Find Wiki Link at point. -With prefix argument ARG, open the file in other window. -See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." - (interactive "P") - (if (markdown-wiki-link-p) - (markdown-follow-wiki-link (markdown-wiki-link-link) arg) - (user-error "Point is not at a Wiki Link"))) - -(defun markdown-highlight-wiki-link (from to face) - "Highlight the wiki link in the region between FROM and TO using FACE." - (put-text-property from to 'font-lock-face face)) - -(defun markdown-unfontify-region-wiki-links (from to) - "Remove wiki link faces from the region specified by FROM and TO." - (interactive "*r") - (let ((modified (buffer-modified-p))) - (remove-text-properties from to '(font-lock-face markdown-link-face)) - (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) - ;; remove-text-properties marks the buffer modified in emacs 24.3, - ;; undo that if it wasn't originally marked modified - (set-buffer-modified-p modified))) - -(defun markdown-fontify-region-wiki-links (from to) - "Search region given by FROM and TO for wiki links and fontify them. -If a wiki link is found check to see if the backing file exists -and highlight accordingly." - (goto-char from) - (save-match-data - (while (re-search-forward markdown-regex-wiki-link to t) - (when (not (markdown-code-block-at-point-p)) - (let ((highlight-beginning (match-beginning 1)) - (highlight-end (match-end 1)) - (file-name - (markdown-convert-wiki-link-to-filename - (markdown-wiki-link-link)))) - (if (condition-case nil (file-exists-p file-name) (error nil)) - (markdown-highlight-wiki-link - highlight-beginning highlight-end 'markdown-link-face) - (markdown-highlight-wiki-link - highlight-beginning highlight-end 'markdown-missing-link-face))))))) - -(defun markdown-extend-changed-region (from to) - "Extend region given by FROM and TO so that we can fontify all links. -The region is extended to the first newline before and the first -newline after." - ;; start looking for the first new line before 'from - (goto-char from) - (re-search-backward "\n" nil t) - (let ((new-from (point-min)) - (new-to (point-max))) - (if (not (= (point) from)) - (setq new-from (point))) - ;; do the same thing for the first new line after 'to - (goto-char to) - (re-search-forward "\n" nil t) - (if (not (= (point) to)) - (setq new-to (point))) - (cl-values new-from new-to))) - -(defun markdown-check-change-for-wiki-link (from to) - "Check region between FROM and TO for wiki links and re-fontify as needed." - (interactive "*r") - (let* ((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - deactivate-mark - buffer-file-truename) - (unwind-protect - (save-excursion - (save-match-data - (save-restriction - ;; Extend the region to fontify so that it starts - ;; and ends at safe places. - (cl-multiple-value-bind (new-from new-to) - (markdown-extend-changed-region from to) - (goto-char new-from) - ;; Only refontify when the range contains text with a - ;; wiki link face or if the wiki link regexp matches. - (when (or (markdown-range-property-any - new-from new-to 'font-lock-face - '(markdown-link-face markdown-missing-link-face)) - (re-search-forward - markdown-regex-wiki-link new-to t)) - ;; Unfontify existing fontification (start from scratch) - (markdown-unfontify-region-wiki-links new-from new-to) - ;; Now do the fontification. - (markdown-fontify-region-wiki-links new-from new-to)))))) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) - -(defun markdown-check-change-for-wiki-link-after-change (from to _) - "Check region between FROM and TO for wiki links and re-fontify as needed. -Designed to be used with the `after-change-functions' hook." - (markdown-check-change-for-wiki-link from to)) - -(defun markdown-fontify-buffer-wiki-links () - "Refontify all wiki links in the buffer." - (interactive) - (markdown-check-change-for-wiki-link (point-min) (point-max))) - -(defun markdown-toggle-wiki-links (&optional arg) - "Toggle support for wiki links. -With a prefix argument ARG, enable wiki link support if ARG is positive, -and disable it otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-enable-wiki-links - (if (eq arg 'toggle) - (not markdown-enable-wiki-links) - (> (prefix-numeric-value arg) 0))) - (if markdown-enable-wiki-links - (message "markdown-mode wiki link support enabled") - (message "markdown-mode wiki link support disabled")) - (markdown-reload-extensions)) - -(defun markdown-setup-wiki-link-hooks () - "Add or remove hooks for fontifying wiki links. -These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." - ;; Anytime text changes make sure it gets fontified correctly - (if (and markdown-enable-wiki-links - markdown-wiki-link-fontify-missing) - (add-hook 'after-change-functions - 'markdown-check-change-for-wiki-link-after-change t t) - (remove-hook 'after-change-functions - 'markdown-check-change-for-wiki-link-after-change t)) - ;; If we left the buffer there is a really good chance we were - ;; creating one of the wiki link documents. Make sure we get - ;; refontified when we come back. - (if (and markdown-enable-wiki-links - markdown-wiki-link-fontify-missing) - (progn - (add-hook 'window-configuration-change-hook - 'markdown-fontify-buffer-wiki-links t t) - (markdown-fontify-buffer-wiki-links)) - (remove-hook 'window-configuration-change-hook - 'markdown-fontify-buffer-wiki-links t) - (markdown-unfontify-region-wiki-links (point-min) (point-max)))) - - -;;; Following & Doing ========================================================= - -(defun markdown-follow-thing-at-point (arg) - "Follow thing at point if possible, such as a reference link or wiki link. -Opens inline and reference links in a browser. Opens wiki links -to other files in the current window, or the another window if -ARG is non-nil. -See `markdown-follow-link-at-point' and -`markdown-follow-wiki-link-at-point'." - (interactive "P") - (cond ((markdown-link-p) - (markdown-follow-link-at-point)) - ((markdown-wiki-link-p) - (markdown-follow-wiki-link-at-point arg)) - (t - (user-error "Nothing to follow at point")))) - -(make-obsolete 'markdown-jump 'markdown-do "v2.3") - -(defun markdown-do () - "Do something sensible based on context at point. -Jumps between reference links and definitions; between footnote -markers and footnote text." - (interactive) - (cond - ;; Footnote definition - ((markdown-footnote-text-positions) - (markdown-footnote-return)) - ;; Footnote marker - ((markdown-footnote-marker-positions) - (markdown-footnote-goto-text)) - ;; Reference link - ((thing-at-point-looking-at markdown-regex-link-reference) - (markdown-reference-goto-definition)) - ;; Reference definition - ((thing-at-point-looking-at markdown-regex-reference-definition) - (markdown-reference-goto-link (match-string-no-properties 2))) - ;; GFM task list item - ((markdown-gfm-task-list-item-at-point) - (markdown-toggle-gfm-checkbox)) - ;; Align table - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-align)) - ;; Otherwise - (t - (markdown-insert-gfm-checkbox)))) - - -;;; Miscellaneous ============================================================= - -(defun markdown-compress-whitespace-string (str) - "Compress whitespace in STR and return result. -Leading and trailing whitespace is removed. Sequences of multiple -spaces, tabs, and newlines are replaced with single spaces." - (markdown-replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" - (markdown-replace-regexp-in-string "[ \t\n]+" " " str))) - -(defun markdown--substitute-command-keys (string) - "Like `substitute-command-keys' but, but prefers control characters. -First pass STRING to `substitute-command-keys' and then -substitute `C-i` for `TAB` and `C-m` for `RET`." - (replace-regexp-in-string - "\\<TAB\\>" "C-i" - (replace-regexp-in-string - "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) - -(defun markdown-line-number-at-pos (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location. -This is an exact copy of `line-number-at-pos' for use in emacs21." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point)))))) - -(defun markdown-inside-link-p () - "Return t if point is within a link." - (save-match-data - (thing-at-point-looking-at (markdown-make-regex-link-generic)))) - -(defun markdown-line-is-reference-definition-p () - "Return whether the current line is a (non-footnote) reference defition." - (save-excursion - (move-beginning-of-line 1) - (and (looking-at-p markdown-regex-reference-definition) - (not (looking-at-p "[ \t]*\\[^"))))) - -(defun markdown-adaptive-fill-function () - "Return prefix for filling paragraph or nil if not determined." - (cond - ;; List item inside blockquote - ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") - (markdown-replace-regexp-in-string - "[0-9\\.*+-]" " " (match-string-no-properties 0))) - ;; Blockquote - ((looking-at markdown-regex-blockquote) - (buffer-substring-no-properties (match-beginning 0) (match-end 2))) - ;; List items - ((looking-at markdown-regex-list) - (match-string-no-properties 0)) - ;; Footnote definition - ((looking-at-p markdown-regex-footnote-definition) - " ") ; four spaces - ;; No match - (t nil))) - -(defun markdown-fill-paragraph (&optional justify) - "Fill paragraph at or after point. -This function is like \\[fill-paragraph], but it skips Markdown -code blocks. If the point is in a code block, or just before one, -do not fill. Otherwise, call `fill-paragraph' as usual. If -JUSTIFY is non-nil, justify text as well. Since this function -handles filling itself, it always returns t so that -`fill-paragraph' doesn't run." - (interactive "P") - (unless (or (markdown-code-block-at-point-p) - (save-excursion - (back-to-indentation) - (skip-syntax-forward "-") - (markdown-code-block-at-point-p))) - (fill-paragraph justify)) - t) - -(make-obsolete 'markdown-fill-forward-paragraph-function - 'markdown-fill-forward-paragraph "v2.3") - -(defun markdown-fill-forward-paragraph (&optional arg) - "Function used by `fill-paragraph' to move over ARG paragraphs. -This is a `fill-forward-paragraph-function' for `markdown-mode'. -It is called with a single argument specifying the number of -paragraphs to move. Just like `forward-paragraph', it should -return the number of paragraphs left to move." - (or arg (setq arg 1)) - (if (> arg 0) - ;; With positive ARG, move across ARG non-code-block paragraphs, - ;; one at a time. When passing a code block, don't decrement ARG. - (while (and (not (eobp)) - (> arg 0) - (= (forward-paragraph 1) 0) - (or (markdown-code-block-at-pos (point-at-bol 0)) - (setq arg (1- arg))))) - ;; Move backward by one paragraph with negative ARG (always -1). - (let ((start (point))) - (setq arg (forward-paragraph arg)) - (while (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (looking-at-p paragraph-separate)) - (forward-line 1)) - (cond - ;; Move point past whitespace following list marker. - ((looking-at markdown-regex-list) - (goto-char (match-end 0))) - ;; Move point past whitespace following pipe at beginning of line - ;; to handle Pandoc line blocks. - ((looking-at "^|\\s-*") - (goto-char (match-end 0))) - ;; Return point if the paragraph passed was a code block. - ((markdown-code-block-at-pos (point-at-bol 2)) - (goto-char start))))) - arg) - -(defun markdown--inhibit-electric-quote () - "Function added to `electric-quote-inhibit-functions'. -Return non-nil if the quote has been inserted inside a code block -or span." - (let ((pos (1- (point)))) - (or (markdown-inline-code-at-pos pos) - (markdown-code-block-at-pos pos)))) - - -;;; Extension Framework ======================================================= - -(defun markdown-reload-extensions () - "Check settings, update font-lock keywords and hooks, and re-fontify buffer." - (interactive) - (when (member major-mode - '(markdown-mode markdown-view-mode gfm-mode gfm-view-mode)) - ;; Refontify buffer - (if (eval-when-compile (fboundp 'font-lock-flush)) - ;; Use font-lock-flush in Emacs >= 25.1 - (font-lock-flush) - ;; Backwards compatibility for Emacs 24.3-24.5 - (when (and font-lock-mode (fboundp 'font-lock-refresh-defaults)) - (font-lock-refresh-defaults))) - ;; Add or remove hooks related to extensions - (markdown-setup-wiki-link-hooks))) - -(defun markdown-handle-local-variables () - "Run in `hack-local-variables-hook' to update font lock rules. -Checks to see if there is actually a ‘markdown-mode’ file local variable -before regenerating font-lock rules for extensions." - (when (and (boundp 'file-local-variables-alist) - (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) - (assoc 'markdown-enable-math file-local-variables-alist))) - (when (assoc 'markdown-enable-math file-local-variables-alist) - (markdown-toggle-math markdown-enable-math)) - (markdown-reload-extensions))) - - -;;; Math Support ============================================================== - -(make-obsolete 'markdown-enable-math 'markdown-toggle-math "v2.1") - -(defconst markdown-mode-font-lock-keywords-math - (list - ;; Equation reference (eq:foo) - '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face))) - ;; Equation reference \eqref{foo} - '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face)))) - "Font lock keywords to add and remove when toggling math support.") - -(defun markdown-toggle-math (&optional arg) - "Toggle support for inline and display LaTeX math expressions. -With a prefix argument ARG, enable math mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-enable-math - (if (eq arg 'toggle) - (not markdown-enable-math) - (> (prefix-numeric-value arg) 0))) - (if markdown-enable-math - (progn - (font-lock-add-keywords - 'markdown-mode markdown-mode-font-lock-keywords-math) - (message "markdown-mode math support enabled")) - (font-lock-remove-keywords - 'markdown-mode markdown-mode-font-lock-keywords-math) - (message "markdown-mode math support disabled")) - (markdown-reload-extensions)) - - -;;; GFM Checkboxes ============================================================ - -(define-button-type 'markdown-gfm-checkbox-button - 'follow-link t - 'face 'markdown-gfm-checkbox-face - 'mouse-face 'markdown-highlight-face - 'action #'markdown-toggle-gfm-checkbox-button) - -(defun markdown-gfm-task-list-item-at-point (&optional bounds) - "Return non-nil if there is a GFM task list item at the point. -Optionally, the list item BOUNDS may be given if available, as -returned by `markdown-cur-list-item-bounds'. When a task list item -is found, the return value is the same value returned by -`markdown-cur-list-item-bounds'." - (unless bounds - (setq bounds (markdown-cur-list-item-bounds))) - (> (length (nth 5 bounds)) 0)) - -(defun markdown-insert-gfm-checkbox () - "Add GFM checkbox at point. -Returns t if added. -Returns nil if non-applicable." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (unless (cl-sixth bounds) - (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) - (markup "[ ] ")) - (if (< pos (point)) - (save-excursion - (goto-char pos) - (insert markup)) - (goto-char pos) - (insert markup)) - (syntax-propertize (+ (cl-second bounds) 4)) - t)) - (unless (save-excursion - (back-to-indentation) - (or (markdown-list-item-at-point-p) - (markdown-heading-at-point) - (markdown-in-comment-p) - (markdown-code-block-at-point-p))) - (let ((pos (save-excursion - (back-to-indentation) - (point))) - (markup (concat (or (save-excursion - (beginning-of-line 0) - (cl-fifth (markdown-cur-list-item-bounds))) - markdown-unordered-list-item-prefix) - "[ ] "))) - (if (< pos (point)) - (save-excursion - (goto-char pos) - (insert markup)) - (goto-char pos) - (insert markup)) - (syntax-propertize (point-at-eol)) - t))))) - -(defun markdown-toggle-gfm-checkbox () - "Toggle GFM checkbox at point. -Returns the resulting status as a string, either \"[x]\" or \"[ ]\". -Returns nil if there is no task list item at the point." - (interactive) - (save-match-data - (save-excursion - (let ((bounds (markdown-cur-list-item-bounds))) - (when bounds - ;; Move to beginning of task list item - (goto-char (cl-first bounds)) - ;; Advance to column of first non-whitespace after marker - (forward-char (cl-fourth bounds)) - (cond ((looking-at "\\[ \\]") - (replace-match - (if markdown-gfm-uppercase-checkbox "[X]" "[x]") - nil t) - (match-string-no-properties 0)) - ((looking-at "\\[[xX]\\]") - (replace-match "[ ]" nil t) - (match-string-no-properties 0)))))))) - -(defun markdown-toggle-gfm-checkbox-button (button) - "Toggle GFM checkbox BUTTON on click." - (save-match-data - (save-excursion - (goto-char (button-start button)) - (markdown-toggle-gfm-checkbox)))) - -(defun markdown-make-gfm-checkboxes-buttons (start end) - "Make GFM checkboxes buttons in region between START and END." - (save-excursion - (goto-char start) - (let ((case-fold-search t)) - (save-excursion - (while (re-search-forward markdown-regex-gfm-checkbox end t) - (make-button (match-beginning 1) (match-end 1) - :type 'markdown-gfm-checkbox-button)))))) - -;; Called when any modification is made to buffer text. -(defun markdown-gfm-checkbox-after-change-function (beg end _) - "Add to `after-change-functions' to setup GFM checkboxes as buttons. -BEG and END are the limits of scanned region." - (save-excursion - (save-match-data - ;; Rescan between start of line from `beg' and start of line after `end'. - (markdown-make-gfm-checkboxes-buttons - (progn (goto-char beg) (beginning-of-line) (point)) - (progn (goto-char end) (forward-line 1) (point)))))) - -(defun markdown-remove-gfm-checkbox-overlays () - "Remove all GFM checkbox overlays in buffer." - (save-excursion - (save-restriction - (widen) - (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) - - -;;; Display inline image ================================================= - -(defvar markdown-inline-image-overlays nil) -(make-variable-buffer-local 'markdown-inline-image-overlays) - -(defun markdown-remove-inline-images () - "Remove inline image overlays from image links in the buffer. -This can be toggled with `markdown-toggle-inline-images' -or \\[markdown-toggle-inline-images]." - (interactive) - (mapc #'delete-overlay markdown-inline-image-overlays) - (setq markdown-inline-image-overlays nil)) - -(defun markdown-display-inline-images () - "Add inline image overlays to image links in the buffer. -This can be toggled with `markdown-toggle-inline-images' -or \\[markdown-toggle-inline-images]." - (interactive) - (unless (display-images-p) - (error "Cannot show images")) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward markdown-regex-link-inline nil t) - (let ((start (match-beginning 0)) - (imagep (match-beginning 1)) - (end (match-end 0)) - (file (match-string-no-properties 6))) - (when (and imagep - (not (zerop (length file))) - (file-exists-p file)) - (let* ((abspath (if (file-name-absolute-p file) - file - (concat default-directory file))) - (image - (if (and markdown-max-image-size - (image-type-available-p 'imagemagick)) - (create-image - abspath 'imagemagick nil - :max-width (car markdown-max-image-size) - :max-height (cdr markdown-max-image-size)) - (create-image abspath)))) - (when image - (let ((ov (make-overlay start end))) - (overlay-put ov 'display image) - (overlay-put ov 'face 'default) - (push ov markdown-inline-image-overlays)))))))))) - -(defun markdown-toggle-inline-images () - "Toggle inline image overlays in the buffer." - (interactive) - (if markdown-inline-image-overlays - (markdown-remove-inline-images) - (markdown-display-inline-images))) - - -;;; GFM Code Block Fontification ============================================== - -(defcustom markdown-fontify-code-blocks-natively nil - "When non-nil, fontify code in code blocks using the native major mode. -This only works for fenced code blocks where the language is -specified where we can automatically determine the appropriate -mode to use. The language to mode mapping may be customized by -setting the variable `markdown-code-lang-modes'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-fontify-code-block-default-mode nil - "Default mode to use to fontify code blocks. -This mode is used when automatic detection fails, such as for GFM -code blocks with no language specified." - :group 'markdown - :type '(choice function (const :tag "None" nil)) - :package-version '(markdown-mode . "2.4")) - -(defun markdown-toggle-fontify-code-blocks-natively (&optional arg) - "Toggle the native fontification of code blocks. -With a prefix argument ARG, enable if ARG is positive, -and disable otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-fontify-code-blocks-natively - (if (eq arg 'toggle) - (not markdown-fontify-code-blocks-natively) - (> (prefix-numeric-value arg) 0))) - (if markdown-fontify-code-blocks-natively - (message "markdown-mode native code block fontification enabled") - (message "markdown-mode native code block fontification disabled")) - (markdown-reload-extensions)) - -;; This is based on `org-src-lang-modes' from org-src.el -(defcustom markdown-code-lang-modes - '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) - ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) - ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) - ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) - ("bash" . sh-mode)) - "Alist mapping languages to their major mode. -The key is the language name, the value is the major mode. For -many languages this is simple, but for language where this is not -the case, this variable provides a way to simplify things on the -user side. For example, there is no ocaml-mode in Emacs, but the -mode to use is `tuareg-mode'." - :group 'markdown - :type '(repeat - (cons - (string "Language name") - (symbol "Major mode"))) - :package-version '(markdown-mode . "2.3")) - -(defun markdown-get-lang-mode (lang) - "Return major mode that should be used for LANG. -LANG is a string, and the returned major mode is a symbol." - (cl-find-if - 'fboundp - (list (cdr (assoc lang markdown-code-lang-modes)) - (cdr (assoc (downcase lang) markdown-code-lang-modes)) - (intern (concat lang "-mode")) - (intern (concat (downcase lang) "-mode"))))) - -(defun markdown-fontify-code-blocks-generic (matcher last) - "Add text properties to next code block from point to LAST. -Use matching function MATCHER." - (when (funcall matcher last) - (save-excursion - (save-match-data - (let* ((start (match-beginning 0)) - (end (match-end 0)) - ;; Find positions outside opening and closing backquotes. - (bol-prev (progn (goto-char start) - (if (bolp) (point-at-bol 0) (point-at-bol)))) - (eol-next (progn (goto-char end) - (if (bolp) (point-at-bol 2) (point-at-bol 3)))) - lang) - (if (and markdown-fontify-code-blocks-natively - (or (setq lang (markdown-code-block-lang)) - markdown-fontify-code-block-default-mode)) - (markdown-fontify-code-block-natively lang start end) - (add-text-properties start end '(face markdown-pre-face))) - ;; Set background for block as well as opening and closing lines. - (font-lock-append-text-property - bol-prev eol-next 'face 'markdown-code-face) - ;; Set invisible property for lines before and after, including newline. - (add-text-properties bol-prev start '(invisible markdown-markup)) - (add-text-properties end eol-next '(invisible markdown-markup))))) - t)) - -(defun markdown-fontify-gfm-code-blocks (last) - "Add text properties to next GFM code block from point to LAST." - (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) - -(defun markdown-fontify-fenced-code-blocks (last) - "Add text properties to next tilde fenced code block from point to LAST." - (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) - -;; Based on `org-src-font-lock-fontify-block' from org-src.el. -(defun markdown-fontify-code-block-natively (lang start end) - "Fontify given GFM or fenced code block. -This function is called by Emacs for automatic fontification when -`markdown-fontify-code-blocks-natively' is non-nil. LANG is the -language used in the block. START and END specify the block -position." - (let ((lang-mode (if lang (markdown-get-lang-mode lang) - markdown-fontify-code-block-default-mode))) - (when (fboundp lang-mode) - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (markdown-buffer (current-buffer)) pos next) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (concat " markdown-code-fontification:" (symbol-name lang-mode))) - ;; Make sure that modification hooks are not inhibited in - ;; the org-src-fontification buffer in case we're called - ;; from `jit-lock-function' (Bug#25132). - (let ((inhibit-modification-hooks nil)) - (delete-region (point-min) (point-max)) - (insert string " ")) ;; so there's a final property change - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (markdown-font-lock-ensure) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (let ((val (get-text-property pos 'face))) - (when val - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face - val markdown-buffer))) - (setq pos next))) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) - -(require 'edit-indirect nil t) -(defvar edit-indirect-guess-mode-function) -(defvar edit-indirect-after-commit-functions) - -(defun markdown--edit-indirect-after-commit-function (_beg end) - "Ensure trailing newlines at the END of code blocks." - (goto-char end) - (unless (eq (char-before) ?\n) - (insert "\n"))) - -(defun markdown-edit-code-block () - "Edit Markdown code block in an indirect buffer." - (interactive) - (save-excursion - (if (fboundp 'edit-indirect-region) - (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) - (begin (and bounds (goto-char (nth 0 bounds)) (point-at-bol 2))) - (end (and bounds (goto-char (nth 1 bounds)) (point-at-bol 1)))) - (if (and begin end) - (let* ((lang (markdown-code-block-lang)) - (mode (or (and lang (markdown-get-lang-mode lang)) - markdown-edit-code-block-default-mode)) - (edit-indirect-guess-mode-function - (lambda (_parent-buffer _beg _end) - (funcall mode)))) - (edit-indirect-region begin end 'display-buffer)) - (user-error "Not inside a GFM or tilde fenced code block"))) - (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") - (progn (package-refresh-contents) - (package-install 'edit-indirect) - (markdown-edit-code-block)))))) - - -;;; Table Editing - -;; These functions were originally adapted from `org-table.el'. - -;; General helper functions - -(defmacro markdown--with-gensyms (symbols &rest body) - (declare (debug (sexp body)) (indent 1)) - `(let ,(mapcar (lambda (s) - `(,s (make-symbol (concat "--" (symbol-name ',s))))) - symbols) - ,@body)) - -(defun markdown--split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -SEPARATORS is a regular expression. If nil it defaults to -`split-string-default-separators'. This version returns no empty -strings if there are matches at the beginning and end of string." - (let ((start 0) notfirst list) - (while (and (string-match - (or separators split-string-default-separators) - string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (push (substring string start (match-beginning 0)) list)) - (setq start (match-end 0))) - (or (eq start (length string)) - (push (substring string start) list)) - (nreverse list))) - -(defun markdown--string-width (s) - "Return width of string S. -This version ignores characters with invisibility property -`markdown-markup'." - (let (b) - (when (or (eq t buffer-invisibility-spec) - (member 'markdown-markup buffer-invisibility-spec)) - (while (setq b (text-property-any - 0 (length s) - 'invisible 'markdown-markup s)) - (setq s (concat - (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s)))))))) - (string-width s)) - -(defun markdown--remove-invisible-markup (s) - "Remove Markdown markup from string S. -This version removes characters with invisibility property -`markdown-markup'." - (let (b) - (while (setq b (text-property-any - 0 (length s) - 'invisible 'markdown-markup s)) - (setq s (concat - (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s))))))) - s) - -;; Functions for maintaining tables - -(defvar markdown-table-at-point-p-function nil - "Function to decide if point is inside a table. - -The indirection serves to differentiate between standard markdown -tables and gfm tables which are less strict about the markup.") - -(defconst markdown-table-line-regexp "^[ \t]*|" - "Regexp matching any line inside a table.") - -(defconst markdown-table-hline-regexp "^[ \t]*|[-:]" - "Regexp matching hline inside a table.") - -(defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" - "Regexp matching dline inside a table.") - -(defun markdown-table-at-point-p () - "Return non-nil when point is inside a table." - (if (functionp markdown-table-at-point-p-function) - (funcall markdown-table-at-point-p-function) - (markdown--table-at-point-p))) - -(defun markdown--table-at-point-p () - "Return non-nil when point is inside a table." - (save-excursion - (beginning-of-line) - (and (looking-at-p markdown-table-line-regexp) - (not (markdown-code-block-at-point-p))))) - -(defconst gfm-table-line-regexp "^.?*|" - "Regexp matching any line inside a table.") - -(defconst gfm-table-hline-regexp "^-+\\(|-\\)+" - "Regexp matching hline inside a table.") - -;; GFM simplified tables syntax is as follows: -;; - A header line for the column names, this is any text -;; separated by `|'. -;; - Followed by a string -|-|- ..., the number of dashes is optional -;; but must be higher than 1. The number of separators should match -;; the number of columns. -;; - Followed by the rows of data, which has the same format as the -;; header line. -;; Example: -;; -;; foo | bar -;; ------|--------- -;; bar | baz -;; bar | baz -(defun gfm--table-at-point-p () - "Return non-nil when point is inside a gfm-compatible table." - (or (markdown--table-at-point-p) - (save-excursion - (beginning-of-line) - (when (looking-at-p gfm-table-line-regexp) - ;; we might be at the first line of the table, check if the - ;; line below is the hline - (or (save-excursion - (forward-line 1) - (looking-at-p gfm-table-hline-regexp)) - ;; go up to find the header - (catch 'done - (while (looking-at-p gfm-table-line-regexp) - (cond - ((looking-at-p gfm-table-hline-regexp) - (throw 'done t)) - ((bobp) - (throw 'done nil))) - (forward-line -1)) - nil)))))) - -(defun markdown-table-hline-at-point-p () - "Return non-nil when point is on a hline in a table. -This function assumes point is on a table." - (save-excursion - (beginning-of-line) - (looking-at-p markdown-table-hline-regexp))) - -(defun markdown-table-begin () - "Find the beginning of the table and return its position. -This function assumes point is on a table." - (save-excursion - (while (and (not (bobp)) - (markdown-table-at-point-p)) - (forward-line -1)) - (unless (eobp) - (forward-line 1)) - (point))) - -(defun markdown-table-end () - "Find the end of the table and return its position. -This function assumes point is on a table." - (save-excursion - (while (and (not (eobp)) - (markdown-table-at-point-p)) - (forward-line 1)) - (point))) - -(defun markdown-table-get-dline () - "Return index of the table data line at point. -This function assumes point is on a table." - (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) - (save-excursion - (goto-char (markdown-table-begin)) - (while (and (re-search-forward - markdown-table-dline-regexp end t) - (setq cnt (1+ cnt)) - (< (point-at-eol) pos)))) - cnt)) - -(defun markdown-table-get-column () - "Return table column at point. -This function assumes point is on a table." - (let ((pos (point)) (cnt 0)) - (save-excursion - (beginning-of-line) - (while (search-forward "|" pos t) (setq cnt (1+ cnt)))) - cnt)) - -(defun markdown-table-get-cell (&optional n) - "Return the content of the cell in column N of current row. -N defaults to column at point. This function assumes point is on -a table." - (and n (markdown-table-goto-column n)) - (skip-chars-backward "^|\n") (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (goto-char (min (point-at-eol) (+ 2 pos))) - ;; Trim whitespaces - (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) - val (replace-regexp-in-string "[ \t]+\\'" "" val))) - (forward-char 1) "")) - -(defun markdown-table-goto-dline (n) - "Go to the Nth data line in the table at point. -Return t when the line exists, nil otherwise. This function -assumes point is on a table." - (goto-char (markdown-table-begin)) - (let ((end (markdown-table-end)) (cnt 0)) - (while (and (re-search-forward - markdown-table-dline-regexp end t) - (< (setq cnt (1+ cnt)) n))) - (= cnt n))) - -(defun markdown-table-goto-column (n &optional on-delim) - "Go to the Nth column in the table line at point. -With optional argument ON-DELIM, stop with point before the left -delimiter of the cell. If there are less than N cells, just go -beyond the last delimiter. This function assumes point is on a -table." - (beginning-of-line 1) - (when (> n 0) - (while (and (> (setq n (1- n)) -1) - (search-forward "|" (point-at-eol) t))) - (if on-delim - (backward-char 1) - (when (looking-at " ") (forward-char 1))))) - -(defmacro markdown-table-save-cell (&rest body) - "Save cell at point, execute BODY and restore cell. -This function assumes point is on a table." - (declare (debug (body))) - (markdown--with-gensyms (line column) - `(let ((,line (copy-marker (line-beginning-position))) - (,column (markdown-table-get-column))) - (unwind-protect - (progn ,@body) - (goto-char ,line) - (markdown-table-goto-column ,column) - (set-marker ,line nil))))) - -(defun markdown-table-blank-line (s) - "Convert a table line S into a line with blank cells." - (if (string-match "^[ \t]*|-" s) - (setq s (mapconcat - (lambda (x) (if (member x '(?| ?+)) "|" " ")) - s "")) - (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) - (setq s (replace-match - (concat "|" (make-string (length (match-string 1 s)) ?\ ) "|") - t t s))) - s)) - -(defun markdown-table-colfmt (fmtspec) - "Process column alignment specifier FMTSPEC for tables." - (when (stringp fmtspec) - (mapcar (lambda (x) - (cond ((string-match-p "^:.*:$" x) 'c) - ((string-match-p "^:" x) 'l) - ((string-match-p ":$" x) 'r) - (t 'd))) - (markdown--split-string fmtspec "\\s-*|\\s-*")))) - -(defun markdown-table-align () - "Align table at point. -This function assumes point is on a table." - (interactive) - (let ((begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (let* (fmtspec - ;; Store table indent - (indent (progn (looking-at "[ \t]*") (match-string 0))) - ;; Split table in lines and save column format specifier - (lines (mapcar (lambda (l) - (if (string-match-p "\\`[ \t]*|[-:]" l) - (progn (setq fmtspec (or fmtspec l)) nil) l)) - (markdown--split-string (buffer-substring begin end) "\n"))) - ;; Split lines in cells - (cells (mapcar (lambda (l) (markdown--split-string l "\\s-*|\\s-*")) - (remq nil lines))) - ;; Calculate maximum number of cells in a line - (maxcells (if cells - (apply #'max (mapcar #'length cells)) - (user-error "Empty table"))) - ;; Empty cells to fill short lines - (emptycells (make-list maxcells "")) maxwidths) - ;; Calculate maximum width for each column - (dotimes (i maxcells) - (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) - (push (apply #'max 1 (mapcar #'markdown--string-width column)) - maxwidths))) - (setq maxwidths (nreverse maxwidths)) - ;; Process column format specifier - (setq fmtspec (markdown-table-colfmt fmtspec)) - ;; Compute formats needed for output of table lines - (let ((hfmt (concat indent "|")) - (rfmt (concat indent "|")) - hfmt1 rfmt1 fmt) - (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) - (setq fmt (pop fmtspec)) - (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) - ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) - ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) - (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) - (setq rfmt (concat rfmt (format rfmt1 width))) - (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) - ;; Replace modified lines only - (dolist (line lines) - (let ((line (if line - (apply #'format rfmt (append (pop cells) emptycells)) - hfmt)) - (previous (buffer-substring (point) (line-end-position)))) - (if (equal previous line) - (forward-line) - (insert line "\n") - (delete-region (point) (line-beginning-position 2)))))) - (set-marker end nil))))) - -(defun markdown-table-insert-row (&optional arg) - "Insert a new row above the row at point into the table. -With optional argument ARG, insert below the current row." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((line (buffer-substring - (line-beginning-position) (line-end-position))) - (new (markdown-table-blank-line line))) - (beginning-of-line (if arg 2 1)) - (unless (bolp) (insert "\n")) - (insert-before-markers new "\n") - (beginning-of-line 0) - (re-search-forward "| ?" (line-end-position) t))) - -(defun markdown-table-delete-row () - "Delete row or horizontal line at point from the table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let ((col (current-column))) - (kill-region (point-at-bol) - (min (1+ (point-at-eol)) (point-max))) - (unless (markdown-table-at-point-p) (beginning-of-line 0)) - (move-to-column col))) - -(defun markdown-table-move-row (&optional up) - "Move table line at point down. -With optional argument UP, move it up." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (current-column)) (pos (point)) - (tonew (if up 0 2)) txt) - (beginning-of-line tonew) - (unless (markdown-table-at-point-p) - (goto-char pos) (user-error "Cannot move row further")) - (goto-char pos) (beginning-of-line 1) (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (point-at-eol)))) - (delete-region (point) (1+ (point-at-eol))) - (beginning-of-line tonew) - (insert txt) (beginning-of-line 0) - (move-to-column col))) - -(defun markdown-table-move-row-up () - "Move table row at point up." - (interactive) - (markdown-table-move-row 'up)) - -(defun markdown-table-move-row-down () - "Move table row at point down." - (interactive) - (markdown-table-move-row nil)) - -(defun markdown-table-insert-column () - "Insert a new table column." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (max 1 (markdown-table-get-column))) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col t) - (if (markdown-table-hline-at-point-p) - (insert "|---") - (insert "| ")) - (forward-line))) - (set-marker end nil) - (markdown-table-align))) - -(defun markdown-table-delete-column () - "Delete column at point from table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let ((col (markdown-table-get-column)) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col t) - (and (looking-at "|[^|\n]+|") - (replace-match "|")) - (forward-line))) - (set-marker end nil) - (markdown-table-goto-column (max 1 (1- col))) - (markdown-table-align))) - -(defun markdown-table-move-column (&optional left) - "Move table column at point to the right. -With optional argument LEFT, move it to the left." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (markdown-table-get-column)) - (col1 (if left (1- col) col)) - (colpos (if left (1- col) (1+ col))) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (when (and left (= col 1)) - (user-error "Cannot move column further left")) - (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (user-error "Cannot move column further right")) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col1 t) - (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|")) - (forward-line))) - (set-marker end nil) - (markdown-table-goto-column colpos) - (markdown-table-align))) - -(defun markdown-table-move-column-left () - "Move table column at point to the left." - (interactive) - (markdown-table-move-column 'left)) - -(defun markdown-table-move-column-right () - "Move table column at point to the right." - (interactive) - (markdown-table-move-column nil)) - -(defun markdown-table-next-row () - "Go to the next row (same column) in the table. -Create new table lines if required." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (markdown-table-align) - (let ((col (markdown-table-get-column))) - (beginning-of-line 2) - (if (or (not (markdown-table-at-point-p)) - (markdown-table-hline-at-point-p)) - (progn - (beginning-of-line 0) - (markdown-table-insert-row 'below))) - (markdown-table-goto-column col) - (skip-chars-backward "^|\n\r") - (when (looking-at " ") (forward-char 1))))) - -(defun markdown-table-forward-cell () - "Go to the next cell in the table. -Create new table lines if required." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (markdown-table-align) - (let ((end (markdown-table-end))) - (when (markdown-table-hline-at-point-p) (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "|" end) - (if (looking-at "[ \t]*$") - (re-search-forward "|" end)) - (if (and (looking-at "[-:]") - (re-search-forward "^[ \t]*|\\([^-:]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "[-:]") - (progn - (beginning-of-line 0) - (markdown-table-insert-row 'below)) - (when (looking-at " ") (forward-char 1)))) - (error (markdown-table-insert-row 'below))))) - -(defun markdown-table-backward-cell () - "Go to the previous cell in the table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (markdown-table-align) - (when (markdown-table-hline-at-point-p) (end-of-line 1)) - (condition-case nil - (progn - (re-search-backward "|" (markdown-table-begin)) - (re-search-backward "|" (markdown-table-begin))) - (error (user-error "Cannot move to previous table cell"))) - (while (looking-at "|\\([-:]\\|[ \t]*$\\)") - (re-search-backward "|" (markdown-table-begin))) - (when (looking-at "| ?") (goto-char (match-end 0)))) - -(defun markdown-table-transpose () - "Transpose table at point. -Horizontal separator lines will be eliminated." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((table (buffer-substring-no-properties - (markdown-table-begin) (markdown-table-end))) - ;; Convert table to a Lisp structure - (table (delq nil - (mapcar - (lambda (x) - (unless (string-match-p - markdown-table-hline-regexp x) - (markdown--split-string x "\\s-*|\\s-*"))) - (markdown--split-string table "[ \t]*\n[ \t]*")))) - (dline_old (markdown-table-get-dline)) - (col_old (markdown-table-get-column)) - (contents (mapcar (lambda (_) - (let ((tp table)) - (mapcar - (lambda (_) - (prog1 - (pop (car tp)) - (setq tp (cdr tp)))) - table))) - (car table)))) - (goto-char (markdown-table-begin)) - (re-search-forward "|") (backward-char) - (delete-region (point) (markdown-table-end)) - (insert (mapconcat - (lambda(x) - (concat "| " (mapconcat 'identity x " | " ) " |\n")) - contents "")) - (markdown-table-goto-dline col_old) - (markdown-table-goto-column dline_old)) - (markdown-table-align)) - -(defun markdown-table-sort-lines (&optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, user will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically or numerically. Sorting in reverse order is also -possible. - -If SORTING-TYPE is specified when this function is called from a -Lisp program, no prompting will take place. SORTING-TYPE must be -a character, any of (?a ?A ?n ?N) where the capital letters -indicate that sorting should be done in reverse order." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - ;; Set sorting type and column used for sorting - (let ((column (let ((c (markdown-table-get-column))) - (cond ((> c 0) c) - ((called-interactively-p 'any) - (read-number "Use column N for sorting: ")) - (t 1)))) - (sorting-type - (or sorting-type - (read-char-exclusive - "Sort type: [a]lpha [n]umeric (A/N means reversed): ")))) - (save-restriction - ;; Narrow buffer to appropriate sorting area - (if (region-active-p) - (narrow-to-region - (save-excursion - (progn - (goto-char (region-beginning)) (line-beginning-position))) - (save-excursion - (progn - (goto-char (region-end)) (line-end-position)))) - (let ((start (markdown-table-begin)) - (end (markdown-table-end))) - (narrow-to-region - (save-excursion - (if (re-search-backward - markdown-table-hline-regexp start t) - (line-beginning-position 2) - start)) - (if (save-excursion (re-search-forward - markdown-table-hline-regexp end t)) - (match-beginning 0) - end)))) - ;; Determine arguments for `sort-subr' - (let* ((extract-key-from-cell - (cl-case sorting-type - ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) - ((?n ?N) #'string-to-number) - (t (user-error "Invalid sorting type: %c" sorting-type)))) - (predicate - (cl-case sorting-type - ((?n ?N) #'<) - ((?a ?A) #'string<)))) - ;; Sort selected area - (goto-char (point-min)) - (sort-subr (memq sorting-type '(?A ?N)) - (lambda () - (forward-line) - (while (and (not (eobp)) - (not (looking-at - markdown-table-dline-regexp))) - (forward-line))) - #'end-of-line - (lambda () - (funcall extract-key-from-cell - (markdown-table-get-cell column))) - nil - predicate) - (goto-char (point-min)))))) - -(defun markdown-table-convert-region (begin end &optional separator) - "Convert region from BEGIN to END to table with SEPARATOR. - -If every line contains at least one TAB character, the function -assumes that the material is tab separated (TSV). If every line -contains a comma, comma-separated values (CSV) are assumed. If -not, lines are split at whitespace into cells. - -You can use a prefix argument to force a specific separator: -\\[universal-argument] once forces CSV, \\[universal-argument] -twice forces TAB, and \\[universal-argument] three times will -prompt for a regular expression to match the separator, and a -numeric argument N indicates that at least N consecutive -spaces, or alternatively a TAB should be used as the separator." - - (interactive "r\nP") - (let* ((begin (min begin end)) (end (max begin end)) re) - (goto-char begin) (beginning-of-line 1) - (setq begin (point-marker)) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (point-marker)) - (when (equal separator '(64)) - (setq separator (read-regexp "Regexp for cell separator: "))) - (unless separator - ;; Get the right cell separator - (goto-char begin) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (goto-char begin) - (if (equal separator '(4)) - ;; Parse CSV - (while (< (point) end) - (cond - ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) - ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") - (replace-match "\\1") (if (looking-at "\"") (insert "\""))) - ((looking-at "[^,\n]+") (goto-char (match-end 0))) - ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) - (setq re - (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (if (< separator 1) - (user-error "Cell separator must contain one or more spaces") - (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) - ((stringp separator) (format "^ *\\|%s" separator)) - (t (error "Invalid cell separator")))) - (while (re-search-forward re end t) (replace-match "| " t t))) - (goto-char begin) - (markdown-table-align))) - - -;;; ElDoc Support - -(defun markdown-eldoc-function () - "Return a helpful string when appropriate based on context. -* Report URL when point is at a hidden URL. -* Report language name when point is a code block with hidden markup." - (cond - ;; Hidden URL or reference for inline link - ((and (or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference)) - (or markdown-hide-urls markdown-hide-markup)) - (let* ((imagep (string-equal (match-string 1) "!")) - (edit-keys (markdown--substitute-command-keys - (if imagep - "\\[markdown-insert-image]" - "\\[markdown-insert-link]"))) - (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) - (referencep (string-equal (match-string 5) "[")) - (object (if referencep "reference" "URL"))) - (format "Hidden %s (%s to edit): %s" object edit-str - (if referencep - (concat - (propertize "[" 'face 'markdown-markup-face) - (propertize (match-string-no-properties 6) - 'face 'markdown-reference-face) - (propertize "]" 'face 'markdown-markup-face)) - (propertize (match-string-no-properties 6) - 'face 'markdown-url-face))))) - ;; Hidden language name for fenced code blocks - ((and (markdown-code-block-at-point-p) - (not (get-text-property (point) 'markdown-pre)) - markdown-hide-markup) - (let ((lang (save-excursion (markdown-code-block-lang)))) - (unless lang (setq lang "[unspecified]")) - (format "Hidden code block language: %s (%s to toggle markup)" - (propertize lang 'face 'markdown-language-keyword-face) - (markdown--substitute-command-keys - "\\[markdown-toggle-markup-hiding]")))))) - - -;;; Mode Definition ========================================================== - -(defun markdown-show-version () - "Show the version number in the minibuffer." - (interactive) - (message "markdown-mode, version %s" markdown-mode-version)) - -(defun markdown-mode-info () - "Open the `markdown-mode' homepage." - (interactive) - (browse-url "https://jblevins.org/projects/markdown-mode/")) - -;;;###autoload -(define-derived-mode markdown-mode text-mode "Markdown" - "Major mode for editing Markdown files." - ;; Natural Markdown tab width - (setq tab-width 4) - ;; Comments - (setq-local comment-start "<!-- ") - (setq-local comment-end " -->") - (setq-local comment-start-skip "<!--[ \t]*") - (setq-local comment-column 0) - (setq-local comment-auto-fill-only-comments nil) - (setq-local comment-use-syntax t) - ;; Syntax - (add-hook 'syntax-propertize-extend-region-functions - #'markdown-syntax-propertize-extend-region) - (add-hook 'jit-lock-after-change-extend-region-functions - #'markdown-font-lock-extend-region-function t t) - (setq-local syntax-propertize-function #'markdown-syntax-propertize) - (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. - ;; Font lock. - (setq font-lock-defaults - '(markdown-mode-font-lock-keywords - nil nil nil nil - (font-lock-multiline . t) - (font-lock-syntactic-face-function . markdown-syntactic-face) - (font-lock-extra-managed-props - . (composition display invisible rear-nonsticky - keymap help-echo mouse-face)))) - (if markdown-hide-markup - (add-to-invisibility-spec 'markdown-markup) - (remove-from-invisibility-spec 'markdown-markup)) - ;; Wiki links - (markdown-setup-wiki-link-hooks) - ;; Math mode - (when markdown-enable-math (markdown-toggle-math t)) - ;; Add a buffer-local hook to reload after file-local variables are read - (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) - ;; For imenu support - (setq imenu-create-index-function - (if markdown-nested-imenu-heading-index - #'markdown-imenu-create-nested-index - #'markdown-imenu-create-flat-index)) - ;; For menu support in XEmacs - (easy-menu-add markdown-mode-menu markdown-mode-map) - ;; Defun movement - (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) - (setq-local end-of-defun-function #'markdown-end-of-defun) - ;; Paragraph filling - (setq-local fill-paragraph-function #'markdown-fill-paragraph) - (setq-local paragraph-start - ;; Should match start of lines that start or separate paragraphs - (mapconcat #'identity - '( - "\f" ; starts with a literal line-feed - "[ \t\f]*$" ; space-only line - "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote - "[ \t]*[*+-][ \t]+" ; unordered list item - "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item - "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def - "[ \t]*:[ \t]+" ; definition - "^|" ; table or Pandoc line block - ) - "\\|")) - (setq-local paragraph-separate - ;; Should match lines that separate paragraphs without being - ;; part of any paragraph: - (mapconcat #'identity - '("[ \t\f]*$" ; space-only line - "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote - ;; The following is not ideal, but the Fill customization - ;; options really only handle paragraph-starting prefixes, - ;; not paragraph-ending suffixes: - ".* $" ; line ending in two spaces - "^#+" - "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def - "\\|")) - (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") - (setq-local adaptive-fill-regexp "\\s-*") - (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) - (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) - ;; Outline mode - (setq-local outline-regexp markdown-regex-header) - (setq-local outline-level #'markdown-outline-level) - ;; Cause use of ellipses for invisible text. - (add-to-invisibility-spec '(outline . t)) - ;; ElDoc support - (if (eval-when-compile (fboundp 'add-function)) - (add-function :before-until (local 'eldoc-documentation-function) - #'markdown-eldoc-function) - (setq-local eldoc-documentation-function #'markdown-eldoc-function)) - ;; Inhibiting line-breaking: - ;; Separating out each condition into a separate function so that users can - ;; override if desired (with remove-hook) - (add-hook 'fill-nobreak-predicate - #'markdown-line-is-reference-definition-p nil t) - (add-hook 'fill-nobreak-predicate - #'markdown-pipe-at-bol-p nil t) - - ;; Indentation - (setq-local indent-line-function markdown-indent-function) - - ;; Flyspell - (setq-local flyspell-generic-check-word-predicate - #'markdown-flyspell-check-word-p) - - ;; Electric quoting - (add-hook 'electric-quote-inhibit-functions - #'markdown--inhibit-electric-quote nil :local) - - ;; Backwards compatibility with markdown-css-path - (when (boundp 'markdown-css-path) - (warn "markdown-css-path is deprecated, see markdown-css-paths.") - (add-to-list 'markdown-css-paths markdown-css-path)) - - ;; Prepare hooks for XEmacs compatibility - (when (featurep 'xemacs) - (make-local-hook 'after-change-functions) - (make-local-hook 'font-lock-extend-region-functions) - (make-local-hook 'window-configuration-change-hook)) - - ;; Make checkboxes buttons - (when markdown-make-gfm-checkboxes-buttons - (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) - (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) - (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) - - ;; edit-indirect - (add-hook 'edit-indirect-after-commit-functions - #'markdown--edit-indirect-after-commit-function - nil 'local) - - ;; Marginalized headings - (when markdown-marginalize-headers - (add-hook 'window-configuration-change-hook - #'markdown-marginalize-update-current nil t)) - - ;; add live preview export hook - (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) - (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t)) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.markdown\\'" . markdown-mode)) -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode)) - - -;;; GitHub Flavored Markdown Mode ============================================ - -(defvar gfm-mode-hook nil - "Hook run when entering GFM mode.") - -;;;###autoload -(define-derived-mode gfm-mode markdown-mode "GFM" - "Major mode for editing GitHub Flavored Markdown files." - (setq markdown-link-space-sub-char "-") - (setq markdown-wiki-link-search-subdirectories t) - (setq-local markdown-table-at-point-p-function 'gfm--table-at-point-p) - (markdown-gfm-parse-buffer-for-languages)) - -(define-obsolete-variable-alias - 'gfm-font-lock-keywords - 'markdown-mode-font-lock-keywords "v2.4") - - -;;; Viewing modes - -(defcustom markdown-hide-markup-in-view-modes t - "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defvar markdown-view-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "p") #'markdown-outline-previous) - (define-key map (kbd "n") #'markdown-outline-next) - (define-key map (kbd "f") #'markdown-outline-next-same-level) - (define-key map (kbd "b") #'markdown-outline-previous-same-level) - (define-key map (kbd "u") #'markdown-outline-up) - (define-key map (kbd "DEL") #'scroll-down-command) - (define-key map (kbd "SPC") #'scroll-up-command) - (define-key map (kbd ">") #'end-of-buffer) - (define-key map (kbd "<") #'beginning-of-buffer) - (define-key map (kbd "q") #'kill-this-buffer) - (define-key map (kbd "?") #'describe-mode) - map) - "Keymap for `markdown-view-mode'.") - -;;;###autoload -(define-derived-mode markdown-view-mode markdown-mode "Markdown-View" - "Major mode for viewing Markdown content." - (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) - (read-only-mode 1)) - -(defvar gfm-view-mode-map - markdown-view-mode-map - "Keymap for `gfm-view-mode'.") - -;;;###autoload -(define-derived-mode gfm-view-mode gfm-mode "GFM-View" - "Major mode for viewing GitHub Flavored Markdown content." - (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) - (read-only-mode 1)) - - -;;; Live Preview Mode ============================================ -;;;###autoload -(define-minor-mode markdown-live-preview-mode - "Toggle native previewing on save for a specific markdown file." - :lighter " MD-Preview" - (if markdown-live-preview-mode - (if (markdown-live-preview-get-filename) - (markdown-display-buffer-other-window (markdown-live-preview-export)) - (markdown-live-preview-mode -1) - (user-error "Buffer %s does not visit a file" (current-buffer))) - (markdown-live-preview-remove))) - - -(provide 'markdown-mode) - -;; Local Variables: -;; indent-tabs-mode: nil -;; coding: utf-8 -;; End: -;;; markdown-mode.el ends here |