From 44564ade7d119c879762857f9ca2ed86d7954ae9 Mon Sep 17 00:00:00 2001 From: Anna Wiggins Date: Thu, 5 Dec 2019 20:43:50 -0500 Subject: [PATCH] Clean up emacs config for a MELPA world. --- emacs/.emacs | 21 +- emacs/.emacs.d/lisp/haml-mode.el | 887 ---- emacs/.emacs.d/lisp/markdown-mode.el | 5978 -------------------------- emacs/.emacs.d/lisp/slim-mode.el | 463 -- emacs/.emacs.d/lisp/yaml-mode.el | 439 -- 5 files changed, 2 insertions(+), 7786 deletions(-) delete mode 100644 emacs/.emacs.d/lisp/haml-mode.el delete mode 100644 emacs/.emacs.d/lisp/markdown-mode.el delete mode 100644 emacs/.emacs.d/lisp/slim-mode.el delete mode 100644 emacs/.emacs.d/lisp/yaml-mode.el diff --git a/emacs/.emacs b/emacs/.emacs index 63f25f7..7e79ec2 100755 --- a/emacs/.emacs +++ b/emacs/.emacs @@ -39,7 +39,8 @@ (set-language-environment "UTF-8") ;; Kill GUI elements -(menu-bar-mode 0) +(menu-bar-mode -1) +(tool-bar-mode -1) ;; *** Programming (global-set-key (kbd "C-x g") 'goto-line) @@ -54,21 +55,3 @@ ;; Use the right mode for Arduino sketches (add-to-list 'auto-mode-alist '("\\.ino\\'" . c++-mode)) - -(add-to-list 'load-path "~/.emacs.d/lisp") -(require 'yaml-mode) -(require 'slim-mode) -(require 'haml-mode) - -;; Markdown support -(autoload 'markdown-mode "markdown-mode" - "Major mode for editing Markdown files" t) -(add-to-list 'auto-mode-alist '("\\.text\\'" . markdown-mode)) -(add-to-list 'auto-mode-alist '("\\.markdown\\'" . markdown-mode)) -(add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode)) - -(add-hook 'go-mode-hook - (lambda () - (add-hook 'before-save-hook 'gofmt-before-save) - (setq tab-width 2) - (setq indent-tabs-mode 0))) diff --git a/emacs/.emacs.d/lisp/haml-mode.el b/emacs/.emacs.d/lisp/haml-mode.el deleted file mode 100644 index 1df3a0d..0000000 --- a/emacs/.emacs.d/lisp/haml-mode.el +++ /dev/null @@ -1,887 +0,0 @@ -;;; haml-mode.el --- Major mode for editing Haml files - -;; Copyright (c) 2007, 2008 Natalie Weizenbaum - -;; Author: Natalie Weizenbaum -;; URL: http://github.com/nex3/haml/tree/master -;; Package-Requires: ((ruby-mode "1.0")) -;; Version: DEV -;; Created: 2007-03-08 -;; By: Natalie Weizenbaum -;; Keywords: markup, language, html - -;;; Commentary: - -;; Because Haml's indentation schema is similar -;; to that of YAML and Python, many indentation-related -;; functions are similar to those in yaml-mode and python-mode. - -;; To install, save this on your load path and add the following to -;; your .emacs file: -;; -;; (require 'haml-mode) - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ruby-mode) - -;; Additional (optional) libraries for fontification -(require 'css-mode nil t) -(require 'textile-mode nil t) -(require 'markdown-mode nil t) -(or - (require 'js nil t) - (require 'javascript-mode "javascript" t)) - - -;; User definable variables - -(defgroup haml nil - "Support for the Haml template language." - :group 'languages - :prefix "haml-") - -(defcustom haml-mode-hook nil - "Hook run when entering Haml mode." - :type 'hook - :group 'haml) - -(defcustom haml-indent-offset 2 - "Amount of offset per level of indentation." - :type 'integer - :group 'haml) - -(defcustom haml-backspace-backdents-nesting t - "Non-nil to have `haml-electric-backspace' re-indent blocks of code. -This means that all code nested beneath the backspaced line is -re-indented along with the line itself." - :type 'boolean - :group 'haml) - -(defvar haml-indent-function 'haml-indent-p - "A function for checking if nesting is allowed. -This function should look at the current line and return t -if the next line could be nested within this line. - -The function can also return a positive integer to indicate -a specific level to which the current line could be indented.") - -(defconst haml-tag-beg-re - "^[ \t]*\\([%\\.#][a-z0-9_:\\-]+\\)+\\(?:(.*)\\|{.*}\\|\\[.*\\]\\)*" - "A regexp matching the beginning of a Haml tag, through (), {}, and [].") - -(defvar haml-block-openers - `(,(concat haml-tag-beg-re "[><]*[ \t]*$") - "^[ \t]*[&!]?[-=~].*do[ \t]*\\(|.*|[ \t]*\\)?$" - ,(concat "^[ \t]*[&!]?[-=~][ \t]*\\(" - (regexp-opt '("if" "unless" "while" "until" "else" "for" - "begin" "elsif" "rescue" "ensure" "when")) - "\\)") - "^[ \t]*/\\(\\[.*\\]\\)?[ \t]*$" - "^[ \t]*-#" - "^[ \t]*:") - "A list of regexps that match lines of Haml that open blocks. -That is, a Haml line that can have text nested beneath it should -be matched by a regexp in this list.") - - -;; Font lock - -(defun haml-nested-regexp (re) - "Create a regexp to match a block starting with RE. -The line containing RE is matched, as well as all lines indented beneath it." - (concat "^\\([ \t]*\\)\\(" re "\\)\\([ \t]*\\(?:\n\\(?:\\1 +[^\n]*\\)?\\)*\n?\\)$")) - -(defconst haml-font-lock-keywords - `((haml-highlight-interpolation 1 font-lock-variable-name-face prepend) - (haml-highlight-ruby-tag 1 font-lock-preprocessor-face) - (haml-highlight-ruby-script 1 font-lock-preprocessor-face) - ;; TODO: distinguish between "/" comments, which can contain HAML - ;; output directives, and "-#", which are completely ignored - haml-highlight-comment - haml-highlight-filter - ("^!!!.*" 0 font-lock-constant-face) - ("\\s| *$" 0 font-lock-string-face))) - -(defconst haml-filter-re (haml-nested-regexp ":[[:alnum:]_\\-]+")) -(defconst haml-comment-re (haml-nested-regexp "\\(?:-\\#\\|/\\)[^\n]*")) - -(defun haml-highlight-comment (limit) - "Highlight any -# or / comment found up to LIMIT." - (when (re-search-forward haml-comment-re limit t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (put-text-property beg end 'face 'font-lock-comment-face) - (goto-char end)))) - -;; Fontifying sub-regions for other languages - -(defun haml-fontify-region - (beg end keywords syntax-table syntactic-keywords syntax-propertize-fn) - "Fontify a region between BEG and END using another mode's fontification. - -KEYWORDS, SYNTAX-TABLE, SYNTACTIC-KEYWORDS and -SYNTAX-PROPERTIZE-FN are the values of that mode's -`font-lock-keywords', `font-lock-syntax-table', -`font-lock-syntactic-keywords', and `syntax-propertize-function' -respectively." - (save-excursion - (save-match-data - (let ((font-lock-keywords keywords) - (font-lock-syntax-table syntax-table) - (font-lock-syntactic-keywords syntactic-keywords) - (syntax-propertize-function syntax-propertize-fn) - (font-lock-multiline 'undecided) - (font-lock-dont-widen t) - font-lock-keywords-only - font-lock-extend-region-functions - font-lock-keywords-case-fold-search) - (save-restriction - (narrow-to-region (1- beg) end) - ;; font-lock-fontify-region apparently isn't inclusive, - ;; so we have to move the beginning back one char - (font-lock-fontify-region (1- beg) end)))))) - -(defun haml-fontify-region-as-ruby (beg end) - "Use Ruby's font-lock variables to fontify the region between BEG and END." - (haml-fontify-region beg end ruby-font-lock-keywords - ruby-font-lock-syntax-table - (when (boundp 'ruby-font-lock-syntactic-keywords) - ruby-font-lock-syntactic-keywords) - (when (fboundp 'ruby-syntax-propertize-function) - #'ruby-syntax-propertize-function))) - -(defun haml-fontify-region-as-css (beg end) - "Fontify CSS code from BEG to END. - -This requires that `css-mode' is available. -`css-mode' is included with Emacs 23." - (when (boundp 'css-font-lock-keywords) - (haml-fontify-region beg end - css-font-lock-keywords - css-mode-syntax-table - nil - nil))) - -(defun haml-fontify-region-as-javascript (beg end) - "Fontify javascript code from BEG to END. - -This requires that Karl Landström's javascript mode be available, either as the -\"js.el\" bundled with Emacs >= 23, or as \"javascript.el\" found in ELPA and -elsewhere." - (let ((keywords (or (and (featurep 'js) js--font-lock-keywords-3) - (and (featurep 'javascript-mode) js-font-lock-keywords-3))) - (syntax-table (or (and (featurep 'js) js-mode-syntax-table) - (and (featurep 'javascript-mode) javascript-mode-syntax-table))) - (syntax-propertize (and (featurep 'js) 'js-syntax-propertize))) - (when keywords - (when (and (fboundp 'js--update-quick-match-re) (null js--quick-match-re-func)) - (js--update-quick-match-re)) - (haml-fontify-region beg end keywords syntax-table nil syntax-propertize)))) - -(defun haml-fontify-region-as-textile (beg end) - "Highlight textile from BEG to END. - -This requires that `textile-mode' be available. - -Note that the results are not perfect, since `textile-mode' expects -certain constructs such as \"h1.\" to be at the beginning of a line, -and indented Haml filters always have leading whitespace." - (if (boundp 'textile-font-lock-keywords) - (haml-fontify-region beg end textile-font-lock-keywords nil nil nil))) - -(defun haml-fontify-region-as-markdown (beg end) - "Highlight markdown from BEG to END. - -This requires that `markdown-mode' be available." - (if (boundp 'markdown-mode-font-lock-keywords) - (haml-fontify-region beg end - markdown-mode-font-lock-keywords - markdown-mode-syntax-table - nil - nil))) - -(defvar haml-fontify-filter-functions-alist - '(("ruby" . haml-fontify-region-as-ruby) - ("css" . haml-fontify-region-as-css) - ("javascript" . haml-fontify-region-as-javascript) - ("textile" . haml-fontify-region-as-textile) - ("markdown" . haml-fontify-region-as-markdown)) - "An alist of (FILTER-NAME . FUNCTION) used to fontify code regions. -FILTER-NAME is a string and FUNCTION is a function which will be -used to fontify the filter's indented code region. FUNCTION will -be passed the extents of that region in two arguments BEG and -END.") - -(defun haml-highlight-filter (limit) - "Highlight any :filter region found in the text up to LIMIT." - (when (re-search-forward haml-filter-re limit t) - ;; fontify the filter name - (put-text-property (match-beginning 2) (1+ (match-end 2)) - 'face font-lock-preprocessor-face) - (let ((filter-name (substring (match-string 2) 1)) - (code-start (1+ (match-beginning 3))) - (code-end (match-end 3))) - (save-match-data - (funcall (or (cdr (assoc filter-name haml-fontify-filter-functions-alist)) - #'(lambda (beg end) - (put-text-property beg end - 'face - 'font-lock-string-face))) - code-start code-end)) - (goto-char (match-end 0))))) - -(defconst haml-possibly-multiline-code-re - "\\(\\(?:.*?,[ \t]*\n\\)*.*\\)" - "Regexp to match trailing ruby code which may continue onto subsequent lines.") - -(defconst haml-ruby-script-re - (concat "^[ \t]*\\(-\\|[&!]?\\(?:=\\|~\\)\\)[^=]" haml-possibly-multiline-code-re) - "Regexp to match -, = or ~ blocks and any continued code lines.") - -(defun haml-highlight-ruby-script (limit) - "Highlight a Ruby script expression (-, =, or ~). -LIMIT works as it does in `re-search-forward'." - (when (re-search-forward haml-ruby-script-re limit t) - (haml-fontify-region-as-ruby (match-beginning 2) (match-end 2)))) - -(defun haml-move (re) - "Try matching and moving to the end of regular expression RE. -Returns non-nil if the expression was sucessfully matched." - (when (looking-at re) - (goto-char (match-end 0)) - t)) - -(defun haml-highlight-ruby-tag (limit) - "Highlight Ruby code within a Haml tag. -LIMIT works as it does in `re-search-forward'. - -This highlights the tag attributes and object refs of the tag, -as well as the script expression (-, =, or ~) following the tag. - -For example, this will highlight all of the following: - %p{:foo => 'bar'} - %p[@bar] - %p= 'baz' - %p{:foo => 'bar'}[@bar]= 'baz'" - (when (re-search-forward "^[ \t]*[%.#]" limit t) - (forward-char -1) - - ;; Highlight tag, classes, and ids - (while (haml-move "\\([.#%]\\)[a-z0-9_:\\-]*") - (put-text-property (match-beginning 0) (match-end 0) 'face - (case (char-after (match-beginning 1)) - (?% font-lock-keyword-face) - (?# font-lock-function-name-face) - (?. font-lock-variable-name-face)))) - - (block loop - (while t - (let ((eol (save-excursion (end-of-line) (point)))) - (case (char-after) - ;; Highlight obj refs - (?\[ - (forward-char 1) - (let ((beg (point))) - (haml-limited-forward-sexp eol) - (haml-fontify-region-as-ruby beg (point)))) - ;; Highlight new attr hashes - (?\( - (forward-char 1) - (while - (and (haml-parse-new-attr-hash - (lambda (type beg end) - (case type - (name (put-text-property beg end - 'face - font-lock-constant-face)) - (value (haml-fontify-region-as-ruby beg end))))) - (not (eobp))) - (forward-line 1) - (beginning-of-line))) - ;; Highlight old attr hashes - (?\{ - (let ((beg (point))) - (haml-limited-forward-sexp eol) - - ;; Check for multiline - (while (and (eolp) (eq (char-before) ?,) (not (eobp))) - (forward-line) - (let ((eol (save-excursion (end-of-line) (point)))) - ;; If no sexps are closed, - ;; we're still continuing a multiline hash - (if (>= (car (parse-partial-sexp (point) eol)) 0) - (end-of-line) - ;; If sexps have been closed, - ;; set the point at the end of the total sexp - (goto-char beg) - (haml-limited-forward-sexp eol)))) - - (haml-fontify-region-as-ruby (1+ beg) (point)))) - (t (return-from loop)))))) - - ;; Move past end chars - (haml-move "[<>&!]+") - ;; Highlight script - (if (looking-at (concat "\\([=~]\\) " haml-possibly-multiline-code-re)) - (haml-fontify-region-as-ruby (match-beginning 2) (match-end 2)) - ;; Give font-lock something to highlight - (forward-char -1) - (looking-at "\\(\\)")) - t)) - -(defun haml-highlight-interpolation (limit) - "Highlight Ruby interpolation (#{foo}). -LIMIT works as it does in `re-search-forward'." - (when (re-search-forward "\\(#{\\)" limit t) - (save-match-data - (forward-char -1) - (let ((beg (point))) - (haml-limited-forward-sexp limit) - (haml-fontify-region-as-ruby (1+ beg) (point))) - (when (eq (char-before) ?\}) - (put-text-property (1- (point)) (point) - 'face font-lock-variable-name-face)) - t))) - -(defun haml-limited-forward-sexp (limit &optional arg) - "Move forward using `forward-sexp' or to LIMIT, whichever comes first. -With ARG, do it that many times." - (let (forward-sexp-function) - (condition-case err - (save-restriction - (narrow-to-region (point) limit) - (forward-sexp arg)) - (scan-error - (unless (equal (nth 1 err) "Unbalanced parentheses") - (signal 'scan-error (cdr err))) - (goto-char limit))))) - -(defun haml-find-containing-block (re) - "If point is inside a block matching RE, return (start . end) for the block." - (save-excursion - (let ((pos (point)) - start end) - (beginning-of-line) - (when (and - (or (looking-at re) - (when (re-search-backward re nil t) - (looking-at re))) - (< pos (match-end 0))) - (setq start (match-beginning 0) - end (match-end 0))) - (when start - (cons start end))))) - -(defun haml-maybe-extend-region (extender) - "Maybe extend the font lock region using EXTENDER. -With point at the beginning of the font lock region, EXTENDER is called. -If it returns a (START . END) pair, those positions are used to possibly -extend the font lock region." - (let ((old-beg font-lock-beg) - (old-end font-lock-end)) - (save-excursion - (goto-char font-lock-beg) - (let ((new-bounds (funcall extender))) - (when new-bounds - (setq font-lock-beg (min font-lock-beg (car new-bounds)) - font-lock-end (max font-lock-end (cdr new-bounds)))))) - (or (/= old-beg font-lock-beg) - (/= old-end font-lock-end)))) - -(defun haml-extend-region-nested-below () - "Extend the font-lock region to any subsequent indented lines." - (haml-maybe-extend-region - (lambda () - (beginning-of-line) - (when (looking-at (haml-nested-regexp "[^ \t].*")) - (cons (match-beginning 0) (match-end 0)))))) - -(defun haml-extend-region-to-containing-block (re) - "Extend the font-lock region to the smallest containing block matching RE." - (haml-maybe-extend-region - (lambda () - (haml-find-containing-block re)))) - -(defun haml-extend-region-filter () - "Extend the font-lock region to an enclosing filter." - (haml-extend-region-to-containing-block haml-filter-re)) - -(defun haml-extend-region-comment () - "Extend the font-lock region to an enclosing comment." - (haml-extend-region-to-containing-block haml-comment-re)) - -(defun haml-extend-region-ruby-script () - "Extend the font-lock region to encompass any current -/=/~ line." - (haml-extend-region-to-containing-block haml-ruby-script-re)) - -(defun haml-extend-region-multiline-hashes () - "Extend the font-lock region to encompass multiline attribute hashes." - (haml-maybe-extend-region - (lambda () - (let ((attr-props (haml-parse-multiline-attr-hash)) - multiline-end - start) - (when attr-props - (setq start (cdr (assq 'point attr-props))) - - (end-of-line) - ;; Move through multiline attrs - (when (eq (char-before) ?,) - (save-excursion - (while (progn (end-of-line) - (and (eq (char-before) ?,) (not (eobp)))) - (forward-line)) - - (forward-line -1) - (end-of-line) - (setq multiline-end (point)))) - - (goto-char (+ (cdr (assq 'point attr-props)) - (cdr (assq 'hash-indent attr-props)) - -1)) - (haml-limited-forward-sexp - (or multiline-end - (save-excursion (end-of-line) (point)))) - (cons start (point))))))) - -(defun haml-extend-region-contextual () - "Extend the font lock region piecemeal. - -The result of calling this function repeatedly until it returns -nil is that (FONT-LOCK-BEG . FONT-LOCK-END) will be the smallest -possible region in which font-locking could be affected by -changes in the initial region." - (or - (haml-extend-region-filter) - (haml-extend-region-comment) - (haml-extend-region-ruby-script) - (haml-extend-region-multiline-hashes) - (haml-extend-region-nested-below) - (font-lock-extend-region-multiline))) - - -;; Mode setup - -(defvar haml-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?: "." table) - (modify-syntax-entry ?' "\"" table) - table) - "Syntax table in use in `haml-mode' buffers.") - -(defvar haml-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [backspace] 'haml-electric-backspace) - (define-key map "\C-?" 'haml-electric-backspace) - (define-key map "\C-c\C-f" 'haml-forward-sexp) - (define-key map "\C-c\C-b" 'haml-backward-sexp) - (define-key map "\C-c\C-u" 'haml-up-list) - (define-key map "\C-c\C-d" 'haml-down-list) - (define-key map "\C-c\C-k" 'haml-kill-line-and-indent) - (define-key map "\C-c\C-r" 'haml-output-region) - (define-key map "\C-c\C-l" 'haml-output-buffer) - map)) - -(defalias 'haml-parent-mode - (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) - -;;;###autoload -(define-derived-mode haml-mode haml-parent-mode "Haml" - "Major mode for editing Haml files. - -\\{haml-mode-map}" - (setq font-lock-extend-region-functions '(haml-extend-region-contextual)) - (set (make-local-variable 'jit-lock-contextually) t) - (set (make-local-variable 'font-lock-multiline) t) - (set (make-local-variable 'indent-line-function) 'haml-indent-line) - (set (make-local-variable 'indent-region-function) 'haml-indent-region) - (set (make-local-variable 'parse-sexp-lookup-properties) t) - (set (make-local-variable 'comment-start) "-#") - (setq font-lock-defaults '((haml-font-lock-keywords) t t)) - (when (boundp 'electric-indent-inhibit) - (setq electric-indent-inhibit t)) - (setq indent-tabs-mode nil)) - -;; Useful functions - -(defun haml-comment-block () - "Comment the current block of Haml code." - (interactive) - (save-excursion - (let ((indent (current-indentation))) - (back-to-indentation) - (insert "-#") - (newline) - (indent-to indent) - (beginning-of-line) - (haml-mark-sexp) - (haml-reindent-region-by haml-indent-offset)))) - -(defun haml-uncomment-block () - "Uncomment the current block of Haml code." - (interactive) - (save-excursion - (beginning-of-line) - (while (not (looking-at haml-comment-re)) - (haml-up-list) - (beginning-of-line)) - (haml-mark-sexp) - (kill-line 1) - (haml-reindent-region-by (- haml-indent-offset)))) - -(defun haml-replace-region (start end) - "Replace the current block of Haml code with the HTML equivalent. -Called from a program, START and END specify the region to indent." - (interactive "r") - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (let ((ci (current-indentation))) - (while (re-search-forward "^ +" end t) - (replace-match (make-string (- (current-indentation) ci) ? )))) - (shell-command-on-region start end "haml" "haml-output" t))) - -(defun haml-output-region (start end) - "Displays the HTML output for the current block of Haml code. -Called from a program, START and END specify the region to indent." - (interactive "r") - (kill-new (buffer-substring start end)) - (with-temp-buffer - (yank) - (haml-indent-region (point-min) (point-max)) - (shell-command-on-region (point-min) (point-max) "haml" "haml-output"))) - -(defun haml-output-buffer () - "Displays the HTML output for entire buffer." - (interactive) - (haml-output-region (point-min) (point-max))) - -;; Navigation - -(defun haml-forward-through-whitespace (&optional backward) - "Move the point forward through any whitespace. -The point will move forward at least one line, until it reaches -either the end of the buffer or a line with no whitespace. - -If BACKWARD is non-nil, move the point backward instead." - (let ((arg (if backward -1 1)) - (endp (if backward 'bobp 'eobp))) - (loop do (forward-line arg) - while (and (not (funcall endp)) - (looking-at "^[ \t]*$"))))) - -(defun haml-at-indent-p () - "Return non-nil if the point is before any text on the line." - (let ((opoint (point))) - (save-excursion - (back-to-indentation) - (>= (point) opoint)))) - -(defun haml-forward-sexp (&optional arg) - "Move forward across one nested expression. -With ARG, do it that many times. Negative arg -N means move -backward across N balanced expressions. - -A sexp in Haml is defined as a line of Haml code as well as any -lines nested beneath it." - (interactive "p") - (or arg (setq arg 1)) - (if (and (< arg 0) (not (haml-at-indent-p))) - (back-to-indentation) - (while (/= arg 0) - (let ((indent (current-indentation))) - (loop do (haml-forward-through-whitespace (< arg 0)) - while (and (not (eobp)) - (not (bobp)) - (> (current-indentation) indent))) - (unless (eobp) - (back-to-indentation)) - (setq arg (+ arg (if (> arg 0) -1 1))))))) - -(defun haml-backward-sexp (&optional arg) - "Move backward across one nested expression. -With ARG, do it that many times. Negative arg -N means move -forward across N balanced expressions. - -A sexp in Haml is defined as a line of Haml code as well as any -lines nested beneath it." - (interactive "p") - (haml-forward-sexp (if arg (- arg) -1))) - -(defun haml-up-list (&optional arg) - "Move out of one level of nesting. -With ARG, do this that many times." - (interactive "p") - (or arg (setq arg 1)) - (while (> arg 0) - (let ((indent (current-indentation))) - (loop do (haml-forward-through-whitespace t) - while (and (not (bobp)) - (>= (current-indentation) indent))) - (setq arg (1- arg)))) - (back-to-indentation)) - -(defun haml-down-list (&optional arg) - "Move down one level of nesting. -With ARG, do this that many times." - (interactive "p") - (or arg (setq arg 1)) - (while (> arg 0) - (let ((indent (current-indentation))) - (haml-forward-through-whitespace) - (when (<= (current-indentation) indent) - (haml-forward-through-whitespace t) - (back-to-indentation) - (error "Nothing is nested beneath this line")) - (setq arg (1- arg)))) - (back-to-indentation)) - -(defun haml-mark-sexp () - "Mark the next Haml block." - (let ((forward-sexp-function 'haml-forward-sexp)) - (mark-sexp))) - -(defun haml-mark-sexp-but-not-next-line () - "Mark the next Haml block, but not the next line. -Put the mark at the end of the last line of the sexp rather than -the first non-whitespace character of the next line." - (haml-mark-sexp) - (set-mark - (save-excursion - (goto-char (mark)) - (unless (eobp) - (forward-line -1) - (end-of-line)) - (point)))) - -;; Indentation and electric keys - -(defvar haml-empty-elements - '("area" "base" "br" "col" "command" "embed" "hr" "img" "input" - "keygen" "link" "meta" "param" "source" "track" "wbr") - "A list of html elements which may not contain content. - -See http://www.w3.org/TR/html-markup/syntax.html.") - -(defun haml-unnestable-tag-p () - "Return t if the current line is an empty element tag, or one with content." - (when (looking-at haml-tag-beg-re) - (save-excursion - (goto-char (match-end 0)) - (or (string-match-p (concat "%" (regexp-opt haml-empty-elements) "\\b") - (match-string 1)) - (progn - (when (looking-at "[{(]") - (ignore-errors (forward-sexp))) - (looking-at "\\(?:=\\|==\\| \\)[[:blank:]]*[^[:blank:]\r\n]+")))))) - -(defun haml-indent-p () - "Return t if the current line can have lines nested beneath it." - (let ((attr-props (haml-parse-multiline-attr-hash))) - (if attr-props - (if (haml-unclosed-attr-hash-p) - (cdr (assq 'hash-indent attr-props)) - (+ (cdr (assq 'indent attr-props)) haml-indent-offset)) - (unless (or (haml-unnestable-tag-p)) - (loop for opener in haml-block-openers - if (looking-at opener) return t - finally return nil))))) - -(defun* haml-parse-multiline-attr-hash () - "Parses a multiline attribute hash, and returns -an alist with the following keys: - -INDENT is the indentation of the line beginning the hash. - -HASH-INDENT is the indentation of the first character -within the attribute hash. - -POINT is the character position at the beginning of the line -beginning the hash." - (save-excursion - (while t - (beginning-of-line) - (if (looking-at (concat haml-tag-beg-re "\\([{(]\\)")) - (progn - (goto-char (1- (match-end 0))) - (haml-limited-forward-sexp (save-excursion (end-of-line) (point))) - (return-from haml-parse-multiline-attr-hash - (when (or (string-equal (match-string 1) "(") (eq (char-before) ?,)) - `((indent . ,(current-indentation)) - (hash-indent . ,(- (match-end 0) (match-beginning 0))) - (point . ,(match-beginning 0)))))) - (when (bobp) (return-from haml-parse-multiline-attr-hash)) - (forward-line -1) - (unless (haml-unclosed-attr-hash-p) - (return-from haml-parse-multiline-attr-hash)))))) - -(defun* haml-unclosed-attr-hash-p () - "Return t if this line has an unclosed attribute hash, new or old." - (save-excursion - (end-of-line) - (when (eq (char-before) ?,) (return-from haml-unclosed-attr-hash-p t)) - (re-search-backward "(\\|^") - (haml-move "(") - (haml-parse-new-attr-hash))) - -(defun* haml-parse-new-attr-hash (&optional (fn (lambda (type beg end) ()))) - "Parse a new-style attribute hash on this line, and returns -t if it's not finished on the current line. - -FN should take three parameters: TYPE, BEG, and END. -TYPE is the type of text parsed ('name or 'value) -and BEG and END delimit that text in the buffer." - (let ((eol (save-excursion (end-of-line) (point)))) - (while (not (haml-move ")")) - (haml-move "[ \t]*") - (unless (haml-move "[a-z0-9_:\\-]+") - (return-from haml-parse-new-attr-hash (haml-move "[ \t]*$"))) - (funcall fn 'name (match-beginning 0) (match-end 0)) - (haml-move "[ \t]*") - (when (haml-move "=") - (haml-move "[ \t]*") - (unless (looking-at "[\"'@a-z0-9]") (return-from haml-parse-new-attr-hash)) - (let ((beg (point))) - (haml-limited-forward-sexp eol) - (funcall fn 'value beg (point))) - (haml-move "[ \t]*"))) - nil)) - -(defun haml-compute-indentation () - "Calculate the maximum sensible indentation for the current line." - (save-excursion - (beginning-of-line) - (if (bobp) (list 0 nil) - (haml-forward-through-whitespace t) - (let ((indent (funcall haml-indent-function))) - (cond - ((consp indent) indent) - ((integerp indent) (list indent t)) - (indent (list (+ (current-indentation) haml-indent-offset) nil)) - (t (list (current-indentation) nil))))))) - -(defun haml-indent-region (start end) - "Indent each nonblank line in the region. -This is done by indenting the first line based on -`haml-compute-indentation' and preserving the relative -indentation of the rest of the region. START and END specify the -region to indent. - -If this command is used multiple times in a row, it will cycle -between possible indentations." - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (let (this-line-column current-column - (next-line-column - (if (and (equal last-command this-command) (/= (current-indentation) 0)) - (* (/ (1- (current-indentation)) haml-indent-offset) haml-indent-offset) - (car (haml-compute-indentation))))) - (while (< (point) end) - (setq this-line-column next-line-column - current-column (current-indentation)) - ;; Delete whitespace chars at beginning of line - (delete-horizontal-space) - (unless (eolp) - (setq next-line-column (save-excursion - (loop do (forward-line 1) - while (and (not (eobp)) (looking-at "^[ \t]*$"))) - (+ this-line-column - (- (current-indentation) current-column)))) - ;; Don't indent an empty line - (unless (eolp) (indent-to this-line-column))) - (forward-line 1))) - (move-marker end nil))) - -(defun haml-indent-line () - "Indent the current line. -The first time this command is used, the line will be indented to the -maximum sensible indentation. Each immediately subsequent usage will -back-dent the line by `haml-indent-offset' spaces. On reaching column -0, it will cycle back to the maximum sensible indentation." - (interactive "*") - (let ((ci (current-indentation)) - (cc (current-column))) - (destructuring-bind (need strict) (haml-compute-indentation) - (save-excursion - (beginning-of-line) - (delete-horizontal-space) - (if (and (not strict) (equal last-command this-command) (/= ci 0)) - (indent-to (* (/ (1- ci) haml-indent-offset) haml-indent-offset)) - (indent-to need)))) - (when (< (current-column) (current-indentation)) - (forward-to-indentation 0)))) - -(defun haml-reindent-region-by (n) - "Add N spaces to the beginning of each line in the region. -If N is negative, will remove the spaces instead. Assumes all -lines in the region have indentation >= that of the first line." - (let* ((ci (current-indentation)) - (indent-rx - (concat "^" - (if indent-tabs-mode - (concat (make-string (/ ci tab-width) ?\t) - (make-string (mod ci tab-width) ?\t)) - (make-string ci ?\s))))) - (save-excursion - (while (re-search-forward indent-rx (mark) t) - (let ((ci (current-indentation))) - (delete-horizontal-space) - (beginning-of-line) - (indent-to (max 0 (+ ci n)))))))) - -(defun haml-electric-backspace (arg) - "Delete characters or back-dent the current line. -If invoked following only whitespace on a line, will back-dent -the line and all nested lines to the immediately previous -multiple of `haml-indent-offset' spaces. With ARG, do it that -many times. - -Set `haml-backspace-backdents-nesting' to nil to just back-dent -the current line." - (interactive "*p") - (if (or (/= (current-indentation) (current-column)) - (bolp) - (save-excursion - (beginning-of-line) - (looking-at "^[ \t]+$"))) - (backward-delete-char arg) - (save-excursion - (beginning-of-line) - (unwind-protect - (progn - (if haml-backspace-backdents-nesting - (haml-mark-sexp-but-not-next-line) - (set-mark (save-excursion (end-of-line) (point)))) - (haml-reindent-region-by (* (- arg) haml-indent-offset))) - (pop-mark))) - (back-to-indentation))) - -(defun haml-kill-line-and-indent () - "Kill the current line, and re-indent all lines nested beneath it." - (interactive) - (beginning-of-line) - (haml-mark-sexp-but-not-next-line) - (kill-line 1) - (haml-reindent-region-by (* -1 haml-indent-offset))) - -(defun haml-indent-string () - "Return the indentation string for `haml-indent-offset'." - (mapconcat 'identity (make-list haml-indent-offset " ") "")) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.haml\\'" . haml-mode)) - - -;; Local Variables: -;; coding: utf-8 -;; byte-compile-warnings: (not cl-functions) -;; eval: (checkdoc-minor-mode 1) -;; End: - -(provide 'haml-mode) -;;; haml-mode.el ends here diff --git a/emacs/.emacs.d/lisp/markdown-mode.el b/emacs/.emacs.d/lisp/markdown-mode.el deleted file mode 100644 index fcef2db..0000000 --- a/emacs/.emacs.d/lisp/markdown-mode.el +++ /dev/null @@ -1,5978 +0,0 @@ -;;; markdown-mode.el --- Emacs Major mode for Markdown-formatted text files - -;; Copyright (C) 2007-2016 Jason R. Blevins -;; Copyright (C) 2007, 2009 Edward O'Connor -;; Copyright (C) 2007 Conal Elliott -;; Copyright (C) 2008 Greg Bognar -;; Copyright (C) 2008 Dmitry Dzhus -;; Copyright (C) 2008 Bryan Kyle -;; Copyright (C) 2008 Ben Voui -;; Copyright (C) 2009 Ankit Solanki -;; Copyright (C) 2009 Hilko Bengen -;; Copyright (C) 2009 Peter Williams -;; Copyright (C) 2010 George Ogata -;; Copyright (C) 2011 Eric Merritt -;; Copyright (C) 2011 Philippe Ivaldi -;; Copyright (C) 2011 Jeremiah Dodds -;; Copyright (C) 2011 Christopher J. Madsen -;; Copyright (C) 2011 Shigeru Fukaya -;; Copyright (C) 2011 Joost Kremers -;; Copyright (C) 2011-2012 Donald Ephraim Curtis -;; Copyright (C) 2012 Akinori Musha -;; Copyright (C) 2012 Zhenlei Jia -;; Copyright (C) 2012 Peter Jones -;; Copyright (C) 2013 Matus Goljer -;; Copyright (C) 2015 Google, Inc. (Contributor: Samuel Freilich ) -;; Copyright (C) 2015 Antonis Kanouras -;; Copyright (C) 2015 Howard Melman -;; Copyright (C) 2015-2016 Danny McClanahan - -;; Author: Jason R. Blevins -;; Maintainer: Jason R. Blevins -;; Created: May 24, 2007 -;; Version: 2.1 -;; Package-Requires: ((cl-lib "0.5")) -;; Keywords: Markdown, GitHub Flavored Markdown, itex -;; URL: http://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 2, 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, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; markdown-mode is a major mode for editing [Markdown][]-formatted -;; text files in GNU Emacs. markdown-mode is free software, licensed -;; under the GNU GPL. -;; -;; [Markdown]: http://daringfireball.net/projects/markdown/ -;; -;; The latest stable version is markdown-mode 2.1, released on January 9, 2016: -;; -;; * [markdown-mode.el][] -;; * [Screenshot][][^theme] -;; * [Release notes][] -;; -;; [markdown-mode.el]: http://jblevins.org/projects/markdown-mode/markdown-mode.el -;; [Screenshot]: http://jblevins.org/projects/markdown-mode/screenshots/20160108-001.png -;; [Release notes]: http://jblevins.org/projects/markdown-mode/rev-2-1 -;; -;; [^theme]: The theme used in the screenshot is -;; [color-theme-twilight](https://github.com/crafterm/twilight-emacs). -;; -;; The latest development version can be obtained from the Git -;; repository at or from -;; [GitHub][]: -;; -;; git clone git://jblevins.org/git/markdown-mode.git -;; git clone https://github.com/jrblevin/markdown-mode.git -;; -;; [![Build Status][status]][travis] -;; -;; [devel.el]: http://jblevins.org/git/markdown-mode.git/plain/markdown-mode.el -;; [GitHub]: https://github.com/jrblevin/markdown-mode/ -;; [travis]: https://travis-ci.org/jrblevin/markdown-mode -;; [status]: https://travis-ci.org/jrblevin/markdown-mode.svg?branch=master -;; -;; markdown-mode is also available in several package managers, including: -;; -;; * Debian Linux: [elpa-markdown-mode][] and [emacs-goodies-el][] -;; * Ubuntu Linux: [elpa-markdown-mode][elpa-ubuntu] and [emacs-goodies-el][emacs-goodies-el-ubuntu] -;; * RedHat and Fedora Linux: [emacs-goodies][] -;; * NetBSD: [textproc/markdown-mode][] -;; * Arch Linux (AUR): [emacs-markdown-mode-git][] -;; * MacPorts: [markdown-mode.el][macports-package] ([pending][macports-ticket]) -;; * FreeBSD: [textproc/markdown-mode.el][freebsd-port] -;; -;; [elpa-markdown-mode]: https://packages.debian.org/sid/lisp/elpa-markdown-mode -;; [elpa-ubuntu]: http://packages.ubuntu.com/search?keywords=elpa-markdown-mode -;; [emacs-goodies-el]: http://packages.debian.org/emacs-goodies-el -;; [emacs-goodies-el-ubuntu]: http://packages.ubuntu.com/search?keywords=emacs-goodies-el -;; [emacs-goodies]: https://apps.fedoraproject.org/packages/emacs-goodies -;; [textproc/markdown-mode]: http://pkgsrc.se/textproc/markdown-mode -;; [emacs-markdown-mode-git]: https://aur.archlinux.org/packages/emacs-goodies-el/ -;; [macports-package]: https://trac.macports.org/browser/trunk/dports/editors/markdown-mode.el/Portfile -;; [macports-ticket]: http://trac.macports.org/ticket/35716 -;; [freebsd-port]: http://svnweb.freebsd.org/ports/head/textproc/markdown-mode.el - -;;; Installation: - -;; Make sure to place `markdown-mode.el` somewhere in the load-path and add -;; the following lines to your `.emacs` file to associate markdown-mode -;; with `.text`, `.markdown`, and `.md` files: -;; -;; (autoload 'markdown-mode "markdown-mode" -;; "Major mode for editing Markdown files" t) -;; (add-to-list 'auto-mode-alist '("\\.text\\'" . markdown-mode)) -;; (add-to-list 'auto-mode-alist '("\\.markdown\\'" . markdown-mode)) -;; (add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode)) -;; -;; There is no official Markdown file extension, nor is there even a -;; _de facto_ standard, so you can easily add, change, or remove any -;; of the file extensions above as needed. -;; -;; `markdown-mode' depends on `cl-lib', which has been bundled with -;; GNU Emacs since 24.3. Users of GNU Emacs 24.1 and 24.2 can install -;; `cl-lib' with `package.el'. - -;;; Usage: - -;; Keybindings are grouped by prefixes based on their function. For -;; example, the commands for inserting links are grouped under `C-c -;; C-a`, where the `C-a` is a mnemonic for the HTML `` tag. In -;; other cases, the connection to HTML is not direct. For example, -;; commands dealing with headings begin with `C-c C-t` (mnemonic: -;; titling). The primary commands in each group will are described -;; below. You can obtain a list of all keybindings by pressing `C-c -;; C-h`. Movement and shifting commands tend to be associated with -;; paired delimiters such as `M-{` and `M-}` or `C-c <` and `C-c >`. -;; Outline navigation keybindings the same as in `org-mode'. Finally, -;; commands for running Markdown or doing maintenance on an open file -;; are grouped under the `C-c C-c` prefix. The most commonly used -;; commands are described below. You can obtain a list of all -;; keybindings by pressing `C-c C-h`. -;; -;; * Hyperlinks: `C-c C-a` -;; -;; In this group, `C-c C-a l` inserts an inline link of the form -;; `[text](url)`. The link text is determined as follows. First, -;; if there is an active region (i.e., when transient mark mode is -;; on and the mark is active), use it as the link text. Second, -;; if the point is at a word, use that word as the link text. In -;; these two cases, the original text will be replaced with the -;; link and point will be left at the position for inserting a -;; URL. Otherwise, insert empty link markup and place the point -;; for inserting the link text. -;; -;; `C-c C-a L` inserts a reference link of the form `[text][label]` -;; and, optionally, a corresponding reference label definition. -;; The link text is determined in the same way as with an inline -;; link (using the region, when active, or the word at the point), -;; but instead of inserting empty markup as a last resort, the -;; link text will be read from the minibuffer. The reference -;; label will be read from the minibuffer in both cases, with -;; completion from the set of currently defined references. To -;; create an implicit reference link, press `RET` to accept the -;; default, an empty label. If the entered referenced label is -;; not defined, additionally prompt for the URL and (optional) -;; title. If a URL is provided, a reference definition will be -;; inserted in accordance with `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. -;; -;; `C-c C-a u` inserts a bare url, delimited by angle brackets. When -;; there is an active region, the text in the region is used as the -;; URL. If the point is at a URL, that url is used. Otherwise, -;; insert angle brackets and position the point in between them -;; for inserting the URL. -;; -;; `C-c C-a f` inserts a footnote marker at the point, inserts a -;; footnote definition below, and positions the point for -;; inserting the footnote text. Note that footnotes are an -;; extension to Markdown and are not supported by all processors. -;; -;; `C-c C-a w` behaves much like the inline link insertion command -;; and inserts 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. Note that wiki links are an extension to Markdown -;; and are not supported by all processors. -;; -;; * Images: `C-c C-i` -;; -;; `C-c C-i i` inserts markup for an inline image, using the -;; active region or the word at point, if any, as the alt text. -;; `C-c C-i I` behaves similarly and inserts a reference-style -;; image. -;; -;; * Styles: `C-c C-s` -;; -;; `C-c C-s e` inserts markup to make a region or word italic (`e` -;; for `` or emphasis). 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 cursor in between them. Similarly, -;; use `C-c C-s s` for bold (``) and `C-c C-s c` for -;; inline code (``). -;; -;; `C-c C-s b` inserts a blockquote using the active region, if any, -;; or starts a new blockquote. `C-c C-s C-b` is a variation which -;; always operates on the region, regardless of whether it is -;; active or not. The appropriate amount of indentation, if any, -;; is calculated automatically given the surrounding context, but -;; may be adjusted later using the region indentation commands. -;; -;; `C-c C-s p` behaves similarly for inserting preformatted code -;; blocks, with `C-c C-s C-p` being the region-only counterpart. -;; -;; * Headings: `C-c C-t` -;; -;; All heading insertion commands use the text in the active -;; region, if any, as the heading text. Otherwise, if the current -;; line is not blank, they use the text on the current line. -;; Finally, the setext commands will prompt for heading text if -;; there is no active region and the current line is blank. -;; -;; `C-c C-t h` inserts a heading with automatically chosen type and -;; level (both determined by the previous heading). `C-c C-t H` -;; behaves similarly, but uses setext (underlined) headings when -;; possible, still calculating the level automatically. -;; In cases where the automatically-determined level is not what -;; you intended, the level can be quickly promoted or demoted -;; (as described below). Alternatively, a `C-u` prefix can be -;; given to insert a heading promoted by one level or a `C-u C-u` -;; prefix can be given to insert a heading demoted by one level. -;; -;; To insert a heading of a specific level and type, use `C-c C-t 1` -;; through `C-c C-t 6` for atx (hash mark) headings and `C-c C-t !` or -;; `C-c C-t @` for setext headings of level one or two, respectively. -;; Note that `!` is `S-1` and `@` is `S-2`. -;; -;; If the point is at a heading, these commands will replace the -;; existing markup in order to update the level and/or type of the -;; heading. To remove the markup of the heading at the point, -;; press `C-c C-k` to kill the heading and press `C-y` to yank the -;; heading text back into the buffer. -;; -;; * Horizontal Rules: `C-c -` -;; -;; `C-c -` inserts a horizontal rule. By default, insert the -;; first string in the list `markdown-hr-strings' (the most -;; prominent rule). With a `C-u` prefix, insert the last string. -;; With a numeric prefix `N`, insert the string in position `N` -;; (counting from 1). -;; -;; * Markdown and Maintenance Commands: `C-c C-c` -;; -;; *Compile:* `C-c C-c m` will run Markdown on the current buffer -;; and show the output in another buffer. *Preview*: `C-c C-c p` -;; runs Markdown on the current buffer and previews, stores the -;; output in a temporary file, and displays the file in a browser. -;; *Export:* `C-c C-c e` will run Markdown on the current buffer -;; and save the result in the file `basename.html`, where -;; `basename` is the name of the Markdown file with the extension -;; removed. *Export and View:* press `C-c C-c v` to export the -;; file and view it in a browser. *Open:* `C-c C-c o` will open -;; the Markdown source file directly using `markdown-open-command'. -;; *Live Export*: Press `C-c C-c l` to turn on -;; `markdown-live-preview-mode' to view the exported output -;; side-by-side with the source Markdown. **For all export commands, -;; the output file will be overwritten without notice.** -;; `markdown-live-preview-window-function' can be customized to open -;; in a browser other than `eww'. -;; -;; To summarize: -;; -;; - `C-c C-c m`: `markdown-command' > `*markdown-output*` buffer. -;; - `C-c C-c p`: `markdown-command' > temporary file > browser. -;; - `C-c C-c e`: `markdown-command' > `basename.html`. -;; - `C-c C-c v`: `markdown-command' > `basename.html` > browser. -;; - `C-c C-c w`: `markdown-command' > kill ring. -;; - `C-c C-c o`: `markdown-open-command'. -;; - `C-c C-c l`: `markdown-live-preview-mode' > `*eww*` buffer. -;; -;; `C-c C-c c` will check for undefined references. If there are -;; any, a small buffer will open with a list of undefined -;; references and the line numbers on which they appear. In Emacs -;; 22 and greater, selecting a reference from this list and -;; pressing `RET` will insert an empty reference definition at the -;; end of the buffer. Similarly, selecting the line number will -;; jump to the corresponding line. -;; -;; `C-c C-c n` renumbers any ordered lists in the buffer that are -;; out of sequence. -;; -;; `C-c C-c ]` completes all headings and normalizes all horizontal -;; rules in the buffer. -;; -;; * Following Links: `C-c C-o` -;; -;; Press `C-c C-o` when the point is on an inline or reference -;; link to open the URL in a browser. When the point is at a -;; wiki link, open it in another buffer (in the current window, -;; or in the other window with the `C-u` prefix). Use `M-p` and -;; `M-n` to quickly jump to the previous or next link of any type. -;; -;; * Jumping: `C-c C-j` -;; -;; Use `C-c C-j` to jump from the object at point to its counterpart -;; elsewhere in the text, when possible. Jumps between reference -;; links and definitions; between footnote markers and footnote -;; text. If more than one link uses the same reference name, a -;; new buffer will be created containing clickable buttons for jumping -;; to each link. You may press `TAB` or `S-TAB` to jump between -;; buttons in this window. -;; -;; * Promotion and Demotion: `C-c C--` and `C-c C-=` -;; -;; Headings, horizontal rules, and list items can be promoted and -;; demoted, as well as bold and italic text. For headings, -;; "promotion" means *decreasing* the level (i.e., moving from -;; `

` to `

`) while "demotion" means *increasing* the -;; level. For horizontal rules, promotion and demotion means -;; moving backward or forward through the list of rule strings in -;; `markdown-hr-strings'. For bold and italic text, promotion and -;; demotion means changing the markup from underscores to asterisks. -;; Press `C-c C--` or `M-LEFT` to promote the element at the point -;; if possible. -;; -;; To remember these commands, note that `-` is for decreasing the -;; level (promoting), and `=` (on the same key as `+`) is for -;; increasing the level (demoting). Similarly, the left and right -;; arrow keys indicate the direction that the atx heading markup -;; is moving in when promoting or demoting. -;; -;; * Completion: `C-c C-]` -;; -;; Complete markup is in normalized form, which means, for -;; example, that the underline portion of a setext header is the -;; same length as the heading text, or that the number of leading -;; and trailing hash marks of an atx header are equal and that -;; there is no extra whitespace in the header text. `C-c C-]` -;; completes the markup at the point, if it is determined to be -;; incomplete. -;; -;; * Editing Lists: `M-RET`, `M-UP`, `M-DOWN`, `M-LEFT`, and `M-RIGHT` -;; -;; New list items can be inserted with `M-RET`. This command -;; determines the appropriate marker (one of the possible -;; unordered list markers or the next number in sequence for an -;; ordered list) and indentation level by examining nearby list -;; items. If there is no list before or after the point, start a -;; new list. Prefix this command by `C-u` to decrease the -;; indentation by one level. Prefix this command by `C-u C-u` to -;; increase the indentation by one level. -;; -;; Existing list items can be moved up or down with `M-UP` or -;; `M-DOWN` and indented or exdented with `M-RIGHT` or `M-LEFT`. -;; -;; * Editing Subtrees: `M-S-UP`, `M-S-DOWN`, `M-S-LEFT`, and `M-S-RIGHT` -;; -;; Entire subtrees of ATX headings can be promoted and demoted -;; with `M-S-LEFT` and `M-S-RIGHT`, which mirror the bindings -;; for promotion and demotion of list items. Similarly, subtrees -;; can be moved up and down with `M-S-UP` and `M-S-DOWN`. -;; -;; Please note the following "boundary" behavior for promotion and -;; demotion. Any level-six headings will not be demoted further -;; (i.e., they remain at level six, since Markdown and HTML define -;; only six levels) and any level-one headings will promoted away -;; entirely (i.e., heading markup will be removed, since a -;; level-zero heading is not defined). -;; -;; * Shifting the Region: `C-c <` and `C-c >` -;; -;; Text in the region can be indented or exdented as a group using -;; `C-c >` to indent to the next indentation point (calculated in -;; the current context), and `C-c <` to exdent to the previous -;; indentation point. These keybindings are the same as those for -;; similar commands in `python-mode'. -;; -;; * Killing Elements: `C-c C-k` -;; -;; Press `C-c C-k` to kill the thing at point and add important -;; text, without markup, to the kill ring. Possible things to -;; kill include (roughly in order of precedece): inline code, -;; headings, horizonal rules, links (add link text to kill ring), -;; images (add alt text to kill ring), angle URIs, email -;; addresses, bold, italics, reference definitions (add URI to -;; kill ring), footnote markers and text (kill both marker and -;; text, add text to kill ring), and list items. -;; -;; * Outline Navigation: `C-c C-n`, `C-c C-p`, `C-c C-f`, `C-c C-b`, and `C-c C-u` -;; -;; Navigation between headings is possible using `outline-mode'. -;; Use `C-c C-n` and `C-c C-p` to move between the next and previous -;; visible headings. Similarly, `C-c C-f` and `C-c C-b` move to the -;; next and previous visible headings at the same level as the one -;; at the point. Finally, `C-c C-u` will move up to a lower-level -;; (higher precedence) visible heading. -;; -;; * Movement by Paragraph or Block: `M-{` and `M-}` -;; -;; The definition of a "paragraph" is slightly different in -;; markdown-mode than, say, text-mode, because markdown-mode -;; supports filling for list items and respects hard line breaks, -;; both of which break paragraphs. So, markdown-mode overrides -;; the usual paragraph navigation commands `M-{` and `M-}` so that -;; with a `C-u` prefix, these commands jump to the beginning or -;; end of an entire block of text, respectively, where "blocks" -;; are separated by one or more lines. -;; -;; * Movement by Defun: `C-M-a`, `C-M-e`, and `C-M-h` -;; -;; The usual Emacs commands can be used to move by defuns -;; (top-level major definitions). In markdown-mode, a defun is a -;; section. As usual, `C-M-a` will move the point to the -;; beginning of the current or preceding defun, `C-M-e` will move -;; to the end of the current or following defun, and `C-M-h` will -;; put the region around the entire defun. -;; -;; As noted, many of the commands above behave differently depending -;; on whether Transient Mark mode is enabled or not. When it makes -;; sense, if Transient Mark mode is on and the region is active, the -;; command applies to the text in the region (e.g., `C-c C-s s` makes the -;; region bold). For users who prefer to work outside of Transient -;; Mark mode, since Emacs 22 it can be enabled temporarily by pressing -;; `C-SPC C-SPC`. When this is not the case, many commands then -;; proceed to look work with the word or line at the point. -;; -;; When applicable, commands that specifically act on the region even -;; outside of Transient Mark mode have the same keybinding as their -;; standard counterpart, but the letter is uppercase. For example, -;; `markdown-insert-blockquote' is bound to `C-c C-s b` and only acts on -;; the region in Transient Mark mode while `markdown-blockquote-region' -;; is bound to `C-c C-s B` and always applies to the region (when nonempty). -;; -;; Note that these region-specific functions are useful in many -;; cases where it may not be obvious. For example, yanking text from -;; the kill ring sets the mark at the beginning of the yanked text -;; and moves the point to the end. Therefore, the (inactive) region -;; contains the yanked text. So, `C-y` followed by `C-c C-s C-b` will -;; yank text and turn it into a blockquote. -;; -;; markdown-mode attempts to be flexible in how it handles -;; indentation. When you press `TAB` repeatedly, the point will cycle -;; through several possible indentation levels corresponding to things -;; you might have in mind when you press `RET` at the end of a line or -;; `TAB`. For example, you may want to start a new list item, -;; continue a list item with hanging indentation, indent for a nested -;; pre block, and so on. Exdention is handled similarly when backspace -;; is pressed at the beginning of the non-whitespace portion of a line. -;; -;; markdown-mode supports outline-minor-mode as well as org-mode-style -;; visibility cycling for atx- or hash-style headings. There are two -;; types of visibility cycling: Pressing `S-TAB` cycles globally between -;; the table of contents view (headings only), outline view (top-level -;; headings only), and the full document view. Pressing `TAB` while the -;; point is at a heading will cycle through levels of visibility for the -;; subtree: completely folded, visible children, and fully visible. -;; Note that mixing hash and underline style headings will give undesired -;; results. - -;;; Customization: - -;; Although no configuration is *necessary* there are a few things -;; that can be customized. The `M-x customize-mode` command -;; provides an interface to all of the possible customizations: -;; -;; * `markdown-command' - the command used to run Markdown (default: -;; `markdown`). This variable may be customized to pass -;; command-line options to your Markdown processor of choice. -;; -;; * `markdown-command-needs-filename' - set to `t' if -;; `markdown-command' does not accept standard input (default: -;; `nil'). When `nil', `markdown-mode' will pass the Markdown -;; content to `markdown-command' using standard input (`stdin`). -;; When set to `t', `markdown-mode' will pass the name of the file -;; as the final command-line argument to `markdown-command'. Note -;; that in the latter case, you will only be able to run -;; `markdown-command' from buffers which are visiting a file. -;; -;; * `markdown-open-command' - the command used for calling a standalone -;; Markdown previewer which is capable of opening Markdown source files -;; directly (default: `nil'). This command will be called -;; with a single argument, the filename of the current buffer. -;; A representative program is the Mac app [Marked 2][], a -;; live-updating Markdown previewer which can be [called from a -;; simple shell script](http://jblevins.org/log/marked-2-command). -;; -;; * `markdown-hr-strings' - list of strings to use when inserting -;; horizontal rules. Different strings will not be distinguished -;; when converted to HTML--they will all be converted to -;; `
`--but they may add visual distinction and style to plain -;; text documents. To maintain some notion of promotion and -;; demotion, keep these sorted from largest to smallest. -;; -;; * `markdown-bold-underscore' - set to a non-nil value to use two -;; underscores for bold instead of two asterisks (default: `nil'). -;; -;; * `markdown-italic-underscore' - set to a non-nil value to use -;; underscores for italic instead of asterisks (default: `nil'). -;; -;; * `markdown-asymmetric-header' - set to a non-nil value to use -;; asymmetric header styling, placing header characters only on -;; the left of headers (default: `nil'). -;; -;; * `markdown-list-indent-width' - depth of indentation for lists -;; when inserting, promoting, and demoting list items (default: 4). -;; -;; * `markdown-indent-function' - the function to use for automatic -;; indentation (default: `markdown-indent-line'). -;; -;; * `markdown-indent-on-enter' - set to a non-nil value to -;; automatically indent new lines when the enter key is pressed -;; (default: `t') -;; -;; * `markdown-wiki-link-alias-first' - set to a non-nil value to -;; treat aliased wiki links like `[[link text|PageName]]` -;; (default: `t'). When set to nil, they will be treated as -;; `[[PageName|link text]]'. -;; -;; * `markdown-uri-types' - a list of protocol schemes (e.g., "http") -;; for URIs that `markdown-mode' should highlight. -;; -;; * `markdown-enable-math' - syntax highlighting for LaTeX -;; fragments (default: `nil'). Set this to `t' to turn on math -;; support by default. Math support can be toggled later using -;; the function `markdown-enable-math'." -;; -;; * `markdown-css-paths' - CSS files to link to in XHTML output -;; (default: `nil`). -;; -;; * `markdown-content-type' - when set to a nonempty string, an -;; `http-equiv` attribute will be included in the XHTML `` -;; block (default: `""`). If needed, the suggested values are -;; `application/xhtml+xml` or `text/html`. See also: -;; `markdown-coding-system'. -;; -;; * `markdown-coding-system' - used for specifying the character -;; set identifier in the `http-equiv` attribute when included -;; (default: `nil'). See `markdown-content-type', which must -;; be set before this variable has any effect. When set to `nil', -;; `buffer-file-coding-system' will be used to automatically -;; determine the coding system string (falling back to -;; `iso-8859-1' when unavailable). Common settings are `utf-8' -;; and `iso-latin-1'. -;; -;; * `markdown-xhtml-header-content' - additional content to include -;; in the XHTML `` block (default: `""`). -;; -;; * `markdown-xhtml-standalone-regexp' - a regular expression which -;; `markdown-mode' uses to determine whether the output of -;; `markdown-command' is a standalone XHTML document or an XHTML -;; fragment (default: `"^\\(<\\?xml\\|`. -;; -;; * **Task lists:** GFM task lists will be rendered as checkboxes -;; (Emacs buttons) in both `markdown-mode' and `gfm-mode' when -;; `markdown-make-gfm-checkboxes-buttons' is set to a non-nil value -;; (and it is set to t by default). These checkboxes can be -;; toggled by clicking `mouse-1` or pressing `RET` over the button. -;; -;; * **Wiki links:** Generic wiki links are supported in -;; `markdown-mode', but in `gfm-mode' specifically they will be -;; treated as they are on GitHub: spaces will be replaced by hyphens -;; in filenames and the first letter of the filename will be -;; capitalized. For example, `[[wiki link]]' will map to a file -;; named `Wiki-link` with the same extension as the current file. -;; -;; * **Newlines:** Neither `markdown-mode' nor `gfm-mode' do anything -;; specifically with respect to newline behavior. If you use -;; `gfm-mode' mostly to write text for comments or issues on the -;; GitHub site--where newlines are significant and correspond to -;; hard line breaks--then you may want to enable `visual-line-mode' -;; for line wrapping in buffers. You can do this with a -;; `gfm-mode-hook' as follows: -;; -;; ;; Use visual-line-mode in gfm-mode -;; (defun my-gfm-mode-hook () -;; (visual-line-mode 1)) -;; (add-hook 'gfm-mode-hook 'my-gfm-mode-hook) -;; -;; * **Preview:** GFM-specific preview can be powered by setting -;; `markdown-command' to use [Docter][]. This may also be -;; configured to work with [Marked 2][] for `markdown-open-command'. -;; -;; [GFM]: http://github.github.com/github-flavored-markdown/ -;; [GFM comments]: https://help.github.com/articles/writing-on-github/ -;; [since 2014]: https://github.com/blog/1825-task-lists-in-all-markdown-documents -;; [Docter]: https://github.com/alampros/Docter - -;;; Acknowledgments: - -;; markdown-mode has benefited greatly from the efforts of the -;; following people: -;; -;; * Cyril Brulebois for Debian packaging. -;; * Conal Elliott for a font-lock regexp patch. -;; * Edward O'Connor for a font-lock regexp fix and -;; GitHub Flavored Markdown mode (`gfm-mode'). -;; * Greg Bognar for menus and running -;; `markdown' with an active region. -;; * Daniel Burrows for filing Debian bug #456592. -;; * Peter S. Galbraith for maintaining `emacs-goodies-el`. -;; * Dmitry Dzhus for undefined reference checking. -;; * Carsten Dominik for `org-mode', from which the -;; visibility cycling functionality was derived, and for a bug fix -;; related to `orgtbl-mode'. -;; * Bryan Kyle for indentation code. -;; * Ben Voui for font-lock face customizations. -;; * Ankit Solanki for `longlines.el` -;; compatibility and custom CSS. -;; * Hilko Bengen for proper XHTML output. -;; * Jose A. Ortega Ruiz for Emacs 23 fixes. -;; * Nelson Minar for `html-helper-mode', from which -;; comment matching functions were derived. -;; * Alec Resnick for bug reports. -;; * Joost Kremers for footnote-handling -;; functions, bug reports regarding indentation, and -;; fixes for byte-compilation warnings. -;; * Peter Williams for `fill-paragraph' -;; enhancements. -;; * George Ogata for fixing several -;; byte-compilation warnings. -;; * Eric Merritt for wiki link features. -;; * Philippe Ivaldi for XHTML preview -;; customizations and XHTML export. -;; * Jeremiah Dodds for supporting -;; Markdown processors which do not accept input from stdin. -;; * Werner Dittmann for bug reports -;; regarding the `cl` dependency and `auto-fill-mode' and indentation. -;; * Scott Pfister for generalizing the space -;; substitution character for mapping wiki links to filenames. -;; * Marcin Kasperski for a patch to -;; escape shell commands. -;; * Christopher J. Madsen for patches to fix a match -;; data bug and to prefer `visual-line-mode' in `gfm-mode'. -;; * Shigeru Fukaya for better adherence to -;; Emacs Lisp coding conventions. -;; * Donald Ephraim Curtis for fixing the `fill-paragraph' -;; regexp, refactoring the compilation and preview functions, -;; heading font-lock generalizations, list renumbering, -;; and kill ring save. -;; * Kevin Porter for wiki link handling in `gfm-mode'. -;; * Max Penet and Peter Eisentraut -;; for an autoload token for `gfm-mode'. -;; * Ian Yang for improving the reference definition regex. -;; * Akinori Musha for an imenu index function. -;; * Michael Sperber for XEmacs fixes. -;; * Francois Gannaz for suggesting charset -;; declaration in XHTML output. -;; * Zhenlei Jia for smart exdention function. -;; * Matus Goljer for improved wiki link following -;; and GFM code block insertion. -;; * Peter Jones for link following functions. -;; * Bryan Fink for a bug report regarding -;; externally modified files. -;; * Vegard Vesterheim for a bug fix -;; related to `orgtbl-mode'. -;; * Makoto Motohashi for before- and after- -;; export hooks, unit test improvements, and updates to support -;; wide characters. -;; * Michael Dwyer for `gfm-mode' underscore regexp. -;; * Chris Lott for suggesting reference label -;; completion. -;; * Gunnar Franke for a completion bug report. -;; * David Glasser for a `paragraph-separate' fix. -;; * Daniel Brotsky for better auto-fill defaults. -;; * Samuel Freilich for improved filling -;; behavior regarding list items, footnotes, and reference -;; definitions, improved killing of footnotes, and numerous other -;; tests and bug fixes. -;; * Antonis Kanouras for strikethrough support. -;; * Tim Visher for multiple CSS files and other -;; general improvements. -;; * Matt McClure for a patch to prevent -;; overwriting source files with .html extensions upon export. -;; * Roger Bolsius for ordered list improvements. -;; * Google's Open Source Programs Office for recognizing the project with -;; a monetary contribution in June 2015. -;; * Howard Melman for supporting GFM checkboxes -;; as buttons. -;; * Danny McClanahan for live preview mode, -;; completion of GFM programming language names, and `cl-lib' updates. -;; * Syohei Yoshida for better heading detection -;; and movement functions. - -;;; Bugs: - -;; markdown-mode is developed and tested primarily for compatibility -;; with GNU Emacs 24.3 and later. If you find any bugs in -;; markdown-mode, please construct a test case or a patch and open a -;; ticket on the [GitHub issue tracker][issues]. -;; -;; [issues]: https://github.com/jrblevin/markdown-mode/issues - -;;; History: - -;; markdown-mode was written and is maintained by Jason Blevins. The -;; first version was released on May 24, 2007. -;; -;; * 2007-05-24: Version 1.1 -;; * 2007-05-25: Version 1.2 -;; * 2007-06-05: [Version 1.3][] -;; * 2007-06-29: Version 1.4 -;; * 2007-10-11: [Version 1.5][] -;; * 2008-06-04: [Version 1.6][] -;; * 2009-10-01: [Version 1.7][] -;; * 2011-08-12: [Version 1.8][] -;; * 2011-08-15: [Version 1.8.1][] -;; * 2013-01-25: [Version 1.9][] -;; * 2013-03-24: [Version 2.0][] -;; * 2016-01-09: [Version 2.1][] -;; -;; [Version 1.3]: http://jblevins.org/projects/markdown-mode/rev-1-3 -;; [Version 1.5]: http://jblevins.org/projects/markdown-mode/rev-1-5 -;; [Version 1.6]: http://jblevins.org/projects/markdown-mode/rev-1-6 -;; [Version 1.7]: http://jblevins.org/projects/markdown-mode/rev-1-7 -;; [Version 1.8]: http://jblevins.org/projects/markdown-mode/rev-1-8 -;; [Version 1.8.1]: http://jblevins.org/projects/markdown-mode/rev-1-8-1 -;; [Version 1.9]: http://jblevins.org/projects/markdown-mode/rev-1-9 -;; [Version 2.0]: http://jblevins.org/projects/markdown-mode/rev-2-0 -;; [Version 2.1]: http://jblevins.org/projects/markdown-mode/rev-2-1 - - -;;; Code: - -(require 'easymenu) -(require 'outline) -(require 'thingatpt) -(require 'cl-lib) - -(declare-function eww-open-file "eww") - - -;;; Constants ================================================================= - -(defconst markdown-mode-version "2.1" - "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 `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 'wp - :link '(url-link "http://jblevins.org/projects/markdown-mode/")) - -(defcustom markdown-command "markdown" - "Command to run markdown." - :group 'markdown - :type 'string) - -(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." - :group 'markdown - :type 'string) - -(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 'list) - -(defcustom markdown-bold-underscore nil - "Use two underscores for bold instead of two asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-italic-underscore nil - "Use underscores for italic instead of asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-asymmetric-header nil - "Determines if header style will be asymmetric. -Set to non-nil to only have header characters to the left of the title. -The default will ensure header characters are placed to the left and right -of the 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 - "Automatically indent new lines when enter key is pressed. -When this variable is set to t, pressing RET will call -`newline-and-indent'. When set to nil, define RET to call -`newline' as usual. In the latter case, you can still use -auto-indentation by pressing \\[newline-and-indent]." - :group 'markdown - :type 'boolean) - -(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-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) - -(defcustom markdown-uri-types - '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" - "imap" "ldap" "mailto" "mid" "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 'list) - -(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 toggled later using `markdown-enable-math' -or \\[markdown-enable-math]." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-css-paths nil - "URL of CSS file to link to in the output XHTML." - :group 'markdown - :type 'list) - -(defcustom markdown-content-type "" - "Content type string for the http-equiv header in XHTML output. -When set to a non-empty string, insert the http-equiv attribute. -Otherwise, this attribute is omitted." - :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 -`iso-8859-1' when not available). Common settings are `utf-8' -and `iso-latin-1'. Use `list-coding-systems' for more choices." - :group 'markdown - :type 'coding-system) - -(defcustom markdown-xhtml-header-content "" - "Additional content to include in the XHTML block." - :group 'markdown - :type 'string) - -(defcustom markdown-xhtml-standalone-regexp - "^\\(<\\?xml\\|" - "Regular expression matches HTML comment closing.") - -(defconst markdown-regex-link-inline - "\\(!\\)?\\(\\[\\)\\([^]^][^]]*\\|\\)\\(\\]\\)\\((\\)\\([^)]*?\\)\\(?:\\s-+\\(\"[^\"]*\"\\)\\)?\\()\\)" - "Regular expression for a [text](file) or an image link ![text](file). -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 - "^\\(?:\\(.+\\)\n\\(=+\\)\\|\\(.+\\)\n\\(-+\\)\\|\\(#+\\)\\s-*\\(.*?\\)\\s-*?\\(#*\\)\\)$" - "Regexp identifying Markdown headers.") - -(defconst markdown-regex-header-1-atx - "^\\(#\\)[ \t]*\\([^\\.].*?\\)[ \t]*\\(#*\\)$" - "Regular expression for level 1 atx-style (hash mark) headers.") - -(defconst markdown-regex-header-2-atx - "^\\(##\\)[ \t]*\\(.+?\\)[ \t]*\\(#*\\)$" - "Regular expression for level 2 atx-style (hash mark) headers.") - -(defconst markdown-regex-header-3-atx - "^\\(###\\)[ \t]*\\(.+?\\)[ \t]*\\(#*\\)$" - "Regular expression for level 3 atx-style (hash mark) headers.") - -(defconst markdown-regex-header-4-atx - "^\\(####\\)[ \t]*\\(.+?\\)[ \t]*\\(#*\\)$" - "Regular expression for level 4 atx-style (hash mark) headers.") - -(defconst markdown-regex-header-5-atx - "^\\(#####\\)[ \t]*\\(.+?\\)[ \t]*\\(#*\\)$" - "Regular expression for level 5 atx-style (hash mark) headers.") - -(defconst markdown-regex-header-6-atx - "^\\(######\\)[ \t]*\\(.+?\\)[ \t]*\\(#*\\)$" - "Regular expression for level 6 atx-style (hash mark) headers.") - -(defconst markdown-regex-header-1-setext - "^\\(.*\\)\n\\(=+\\)$" - "Regular expression for level 1 setext-style (underline) headers.") - -(defconst markdown-regex-header-2-setext - "^\\(.*\\)\n\\(-+\\)$" - "Regular expression for level 2 setext-style (underline) headers.") - -(defconst markdown-regex-header-setext - "^\\(.+\\)\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 - "^\\(\\*[ ]?\\*[ ]?\\*[ ]?[\\* ]*\\|-[ ]?-[ ]?-[--- ]*\\)$" - "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 backticks. -Group 2 matches the opening backticks. -Group 3 matches the code fragment itself, without backticks. -Group 4 matches the closing backticks. - -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 - "\\(\\)\\(\\(?:.\\|\n[^\n]\\)*?\\)\\(\\)" - "Regular expression for matching tags. -Groups 1 and 3 match the opening and closing tags. -Group 2 matches the key sequence.") - -(defconst markdown-regex-gfm-code-block - (concat - "^\\s *\\(```\\)[ ]*\\([^[:space:]]+\\|{[^}]*}\\)?" - "[[:space:]]*?\n" - "\\(\\(?:.\\|\n\\)*?\\)?" - "\n?\\s *?\\(```\\)\\s *?$") - "Regular expression matching opening of GFM code blocks. -Group 1 matches the opening three backticks. -Group 2 matches the language identifier (optional). -Group 3 matches the closing three backticks.") - -(defconst markdown-regex-pre - "^\\( \\|\t\\).*$" - "Regular expression for matching preformatted text sections.") - -(defconst markdown-regex-list - "^\\([ \t]*\\)\\([0-9#]+\\.\\|[\\*\\+-]\\)\\([ \t]+\\)" - "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]*\\(>\\)\\(.*\\)$" - "Regular expression for matching blockquote lines. -Group 1 matches the leading angle bracket. -Group 2 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.") - -(defconst markdown-regex-link-generic - (concat "\\(?:" markdown-regex-wiki-link - "\\|" markdown-regex-link-inline - "\\|" markdown-regex-link-reference - "\\|" markdown-regex-angle-uri "\\)") - "Regular expression for matching any recognized link.") - -(defconst markdown-regex-gfm-checkbox - " \\(\\[[ xX]\\]\\) " - "Regular expression for matching GFM checkboxes. -Group 1 matches the text to become a button.") - -(defconst markdown-regex-block-separator - "\\(\\`\\|\\(\n[ \t]*\n\\)[^\n \t]\\)" - "Regular expression for matching block boundaries.") - -(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 3 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 3 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-display - "^\\(\\\\\\[\\)\\(\\(?:.\\|\n\\)*\\)?\\(\\\\\\]\\)$" - "Regular expression for itex \[..\] display mode expressions. -Groups 1 and 3 matche the opening and closing delimiters. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-multimarkdown-metadata - "^\\([[:alpha:]][[:alpha:] _-]*?\\)\\(:[ \t]*\\)\\(.*\\)$" - "Regular expression for matching MultiMarkdown metadata.") - -(defconst markdown-regex-pandoc-metadata - "^\\(%\\)\\([ \t]*\\)\\(.*\\)$" - "Regular expression for matching Pandoc metadata.") - - -;;; Syntax ==================================================================== - -(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-excursion - (goto-char start) - (unless (or (bobp) (looking-back "\n\n" nil)) - (let (new-start new-end) - (setq new-start (if (re-search-backward "\n\n" nil t) - (match-end 0) - (point-min))) - (goto-char end) - (setq new-end (if (re-search-forward "\n\n" nil t) - (match-beginning 0) - (point-max))) - (unless (and (eq new-start start) (eq new-end end)) - (cons new-start new-end)))))) - -(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 stop) - (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-p) (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 (looking-at pre-regexp) - (markdown-prev-line-blank-p)) - (setq open (match-beginning 0)) - (while (and (or (looking-at 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) (markdown-cur-line-indent) levels)) - (markdown-end-of-block-element)) - ;; 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 close-regexp)) - (setq levels (markdown-update-list-levels - nil (markdown-cur-line-indent) levels)) - (markdown-end-of-block-element)) - (t (markdown-end-of-block-element)))) - - (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))))) - -(defun markdown-syntax-propertize-fenced-code-blocks (start end) - "Match tilde-fenced code text blocks from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward "^\\([~]\\{3,\\}\\)" end t) - (let ((beg (match-beginning 1))) - (when (re-search-forward - (concat "^" (match-string 1) "~*") end t) - (put-text-property beg (match-end 0) 'markdown-fenced-code - (list beg (point)))))))) - -(defun markdown-syntax-propertize-gfm-code-blocks (start end) - "Match GFM code blocks from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward markdown-regex-gfm-code-block end t) - (let ((open (list (match-beginning 1) (match-end 1))) - (lang (list (match-beginning 2) (match-end 2))) - (body (list (match-beginning 3) (match-end 3))) - (close (list (match-beginning 4) (match-end 4))) - (all (list (match-beginning 1) (match-end 4)))) - (put-text-property (cl-first open) (cl-second close) 'markdown-gfm-code - (append all open lang body close)))))) - -(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-headings-generic (symbol regex start end) - "Match headings of type SYMBOL with REGEX from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward regex end t) - (unless (or (markdown-code-block-at-pos (match-beginning 0)) - (get-text-property (match-beginning 0) 'markdown-heading)) - (put-text-property (match-beginning 0) (match-end 0) - 'markdown-heading t) - (put-text-property (match-beginning 0) (match-end 0) - symbol (match-data t)))))) - -(defun markdown-syntax-propertize-comments (start end) - "Match HTML comments from the START to END." - (let* ((state (syntax-ppss)) (in-comment (nth 4 state))) - (goto-char start) - (cond - ;; Comment start - ((and (not in-comment) - (re-search-forward markdown-regex-comment-start end t) - (save-match-data (not (markdown-code-at-point-p))) - (save-match-data (not (markdown-code-block-at-point)))) - (let ((open-beg (match-beginning 0))) - (put-text-property open-beg (1+ open-beg) - 'syntax-table (string-to-syntax "<")) - (markdown-syntax-propertize-comments (1+ open-beg) end))) - ;; Comment end - ((and in-comment - (re-search-forward markdown-regex-comment-end end t)) - (put-text-property (1- (match-end 0)) (match-end 0) - 'syntax-table (string-to-syntax ">")) - (markdown-syntax-propertize-comments (match-end 0) end)) - ;; Nothing found - (t nil)))) - -(defun markdown-syntax-propertize (start end) - "See `syntax-propertize-function'." - (remove-text-properties start end '(markdown-gfm-code)) - (remove-text-properties start end '(markdown-fenced-code)) - (remove-text-properties start end '(markdown-pre)) - (remove-text-properties start end '(markdown-blockquote)) - (remove-text-properties start end '(markdown-heading)) - (remove-text-properties start end '(markdown-heading-1-setext)) - (remove-text-properties start end '(markdown-heading-2-setext)) - (remove-text-properties start end '(markdown-heading-1-atx)) - (remove-text-properties start end '(markdown-heading-2-atx)) - (remove-text-properties start end '(markdown-heading-3-atx)) - (remove-text-properties start end '(markdown-heading-4-atx)) - (remove-text-properties start end '(markdown-heading-5-atx)) - (remove-text-properties start end '(markdown-heading-6-atx)) - (markdown-syntax-propertize-gfm-code-blocks start end) - (markdown-syntax-propertize-fenced-code-blocks start end) - (markdown-syntax-propertize-pre-blocks start end) - (markdown-syntax-propertize-blockquotes start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-1-setext markdown-regex-header-1-setext start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-2-setext markdown-regex-header-2-setext start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-6-atx markdown-regex-header-6-atx start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-5-atx markdown-regex-header-5-atx start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-4-atx markdown-regex-header-4-atx start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-3-atx markdown-regex-header-3-atx start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-2-atx markdown-regex-header-2-atx start end) - (markdown-syntax-propertize-headings-generic - 'markdown-heading-1-atx markdown-regex-header-1-atx start end) - (markdown-syntax-propertize-comments start end)) - - -;;; 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-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-face 'markdown-footnote-face - "Face name to use for footnote identifiers.") - -(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.") - -(defgroup markdown-faces nil - "Faces used in Markdown Mode" - :group 'markdown - :group 'faces) - -(defface markdown-italic-face - '((t (:inherit font-lock-variable-name-face :slant italic :weight normal))) - "Face for italic text." - :group 'markdown-faces) - -(defface markdown-bold-face - '((t (:inherit font-lock-variable-name-face :weight bold :slant normal))) - "Face for bold text." - :group 'markdown-faces) - -(defface markdown-strike-through-face - '((t (:inherit font-lock-variable-name-face :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-header-face - '((t (:inherit font-lock-function-name-face :weight bold))) - "Base face for headers." - :group 'markdown-faces) - -(defface markdown-header-face-1 - '((t (:inherit markdown-header-face))) - "Face for level-1 headers." - :group 'markdown-faces) - -(defface markdown-header-face-2 - '((t (:inherit markdown-header-face))) - "Face for level-2 headers." - :group 'markdown-faces) - -(defface markdown-header-face-3 - '((t (:inherit markdown-header-face))) - "Face for level-3 headers." - :group 'markdown-faces) - -(defface markdown-header-face-4 - '((t (:inherit markdown-header-face))) - "Face for level-4 headers." - :group 'markdown-faces) - -(defface markdown-header-face-5 - '((t (:inherit markdown-header-face))) - "Face for level-5 headers." - :group 'markdown-faces) - -(defface markdown-header-face-6 - '((t (:inherit markdown-header-face))) - "Face for level-6 headers." - :group 'markdown-faces) - -(defface markdown-inline-code-face - '((t (:inherit font-lock-constant-face))) - "Face for inline code." - :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-pre-face - '((t (:inherit font-lock-constant-face))) - "Face for preformatted text." - :group 'markdown-faces) - -(defface markdown-language-keyword-face - '((t (:inherit font-lock-type-face))) - "Face for programming language identifiers." - :group 'markdown-faces) - -(defface markdown-link-face - '((t (:inherit font-lock-keyword-face))) - "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) - -(defface markdown-footnote-face - '((t (:inherit markdown-markup-face))) - "Face for footnote markers." - :group 'markdown-faces) - -(defface markdown-url-face - '((t (:inherit font-lock-string-face))) - "Face for URLs." - :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) - -(defun markdown-syntactic-face (state) - "Returns a 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)))) - -(defvar markdown-mode-font-lock-keywords-basic - (list - (cons 'markdown-match-gfm-code-blocks '((1 markdown-markup-face) - (2 markdown-language-keyword-face nil t) - (3 markdown-pre-face) - (4 markdown-markup-face))) - (cons 'markdown-match-fenced-code-blocks '((0 markdown-pre-face))) - (cons 'markdown-match-pre-blocks '((0 markdown-pre-face))) - (cons 'markdown-match-blockquotes '((1 markdown-markup-face) - (2 markdown-blockquote-face))) - (cons 'markdown-match-heading-1-setext '((1 markdown-header-face-1) - (2 markdown-header-rule-face))) - (cons 'markdown-match-heading-2-setext '((1 markdown-header-face-2) - (2 markdown-header-rule-face))) - (cons 'markdown-match-heading-6-atx '((1 markdown-header-delimiter-face) - (2 markdown-header-face-6) - (3 markdown-header-delimiter-face))) - (cons 'markdown-match-heading-5-atx '((1 markdown-header-delimiter-face) - (2 markdown-header-face-5) - (3 markdown-header-delimiter-face))) - (cons 'markdown-match-heading-4-atx '((1 markdown-header-delimiter-face) - (2 markdown-header-face-4) - (3 markdown-header-delimiter-face))) - (cons 'markdown-match-heading-3-atx '((1 markdown-header-delimiter-face) - (2 markdown-header-face-3) - (3 markdown-header-delimiter-face))) - (cons 'markdown-match-heading-2-atx '((1 markdown-header-delimiter-face) - (2 markdown-header-face-2) - (3 markdown-header-delimiter-face))) - (cons 'markdown-match-heading-1-atx '((1 markdown-header-delimiter-face) - (2 markdown-header-face-1) - (3 markdown-header-delimiter-face))) - (cons 'markdown-match-multimarkdown-metadata '((1 markdown-metadata-key-face) - (2 markdown-markup-face) - (3 markdown-metadata-value-face))) - (cons 'markdown-match-pandoc-metadata '((1 markdown-markup-face) - (2 markdown-markup-face) - (3 markdown-metadata-value-face))) - (cons 'markdown-match-hr 'markdown-header-delimiter-face) - (cons 'markdown-match-code '((1 markdown-markup-face) - (2 markdown-inline-code-face) - (3 markdown-markup-face))) - (cons markdown-regex-kbd '((1 markdown-markup-face) - (2 markdown-inline-code-face) - (3 markdown-markup-face))) - (cons markdown-regex-angle-uri '((1 markdown-markup-face) - (2 markdown-link-face) - (3 markdown-markup-face))) - (cons markdown-regex-list '(2 markdown-list-face)) - (cons markdown-regex-footnote '((1 markdown-markup-face) ; [^ - (2 markdown-footnote-face) ; label - (3 markdown-markup-face))) ; ] - (cons markdown-regex-link-inline '((1 markdown-markup-face nil t) ; ! (optional) - (2 markdown-markup-face) ; [ - (3 markdown-link-face) ; text - (4 markdown-markup-face) ; ] - (5 markdown-markup-face) ; ( - (6 markdown-url-face) ; url - (7 markdown-link-title-face nil t) ; "title" (optional) - (8 markdown-markup-face))) ; ) - (cons markdown-regex-link-reference '((1 markdown-markup-face nil t) ; ! (optional) - (2 markdown-markup-face) ; [ - (3 markdown-link-face) ; text - (4 markdown-markup-face) ; ] - (5 markdown-markup-face) ; [ - (6 markdown-reference-face) ; label - (7 markdown-markup-face))) ; ] - (cons 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) - ;; Math mode $..$ - (cons 'markdown-match-math-single '((1 markdown-markup-face prepend) - (2 markdown-math-face append) - (3 markdown-markup-face prepend))) - ;; Math mode $$..$$ - (cons 'markdown-match-math-double '((1 markdown-markup-face prepend) - (2 markdown-math-face append) - (3 markdown-markup-face prepend))) - (cons 'markdown-match-bold '((1 markdown-markup-face prepend) - (2 markdown-bold-face append) - (3 markdown-markup-face prepend))) - (cons 'markdown-match-italic '((1 markdown-markup-face prepend) - (2 markdown-italic-face append) - (3 markdown-markup-face prepend))) - (cons markdown-regex-uri 'markdown-link-face) - (cons markdown-regex-email 'markdown-link-face) - (cons markdown-regex-line-break '(1 markdown-line-break-face prepend)) - ) - "Syntax highlighting for Markdown files.") - -(defconst markdown-mode-font-lock-keywords-math - (list - ;; Display mode equations with brackets: \[ \] - (cons markdown-regex-math-display '((1 markdown-markup-face prepend) - (2 markdown-math-face append) - (3 markdown-markup-face prepend))) - ;; Equation reference (eq:foo) - (cons "\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" '((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face))) - ;; Equation reference \eqref{foo} - (cons "\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" '((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face)))) - "Syntax highlighting for LaTeX and itex fragments.") - -(defvar markdown-mode-font-lock-keywords nil - "Default highlighting expressions for Markdown mode. -This variable is defined as a buffer-local variable for dynamic -extension support.") - -;; Footnotes -(defvar markdown-footnote-counter 0 - "Counter for footnote numbers.") -(make-variable-buffer-local 'markdown-footnote-counter) - -(defconst markdown-footnote-chars - "[[:alnum:]-]" - "Regular expression maching any character that is allowed in a footnote identifier.") - -(defconst markdown-regex-footnote-definition - (concat "^\\[\\(\\^" 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 23 and newer - ((fboundp 'use-region-p) - (defalias 'markdown-use-region-p 'use-region-p)) - ;; Older Emacsen - ((and (boundp 'transient-mark-mode) (boundp 'mark-active)) - (defun markdown-use-region-p () - "Compatibility wrapper to provide `use-region-p'." - (and transient-mark-mode mark-active))) - ;; XEmacs - ((fboundp 'region-active-p) - (defalias 'markdown-use-region-p 'region-active-p)))) - -(defun markdown-use-buttons-p () - "Determine whether this Emacs supports buttons." - (or (featurep 'button) (locate-library "button"))) - -;; 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-entry - (if (fboundp 'outline-show-entry) - 'outline-show-entry - 'show-entry)) - (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))) - - -;;; Markdown Parsing Functions ================================================ - -(defun markdown-cur-line-blank-p () - "Return t if the current line is blank and nil otherwise." - (save-match-data - (save-excursion - (beginning-of-line) - (re-search-forward "^\\s *$" (line-end-position) t)))) - -(defun markdown-prev-line-blank-p () - "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) - (markdown-cur-line-blank-p)))) - -(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-p () - "Return t if the previous line is indented and nil otherwise." - (save-excursion - (if (= (line-beginning-position) (point-min)) - nil - (forward-line -1) - (goto-char (line-beginning-position)) - (if (re-search-forward "^\\s " (line-end-position) t) t)))) - -(defun markdown-cur-line-indent () - "Return the number of leading whitespace characters in the current line." - (save-match-data - (save-excursion - (goto-char (line-beginning-position)) - (re-search-forward "^[ \t]+" (line-end-position) t) - (current-column)))) - -(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) - (markdown-cur-line-indent)))) - -(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) - (markdown-cur-line-indent)))) - -(defun markdown-cur-non-list-indent () - "Return beginning position of list item text (not including the list marker). -Return nil if the current line is not the beginning of a list item." - (save-match-data - (save-excursion - (beginning-of-line) - (when (re-search-forward markdown-regex-list (line-end-position) t) - (current-column))))) - -(defun markdown-prev-non-list-indent () - "Return position of the first non-list-marker on the previous line." - (save-excursion - (forward-line -1) - (markdown-cur-non-list-indent))) - -(defun markdown-new-baseline-p () - "Determine if the current line begins a new baseline level." - (save-excursion - (beginning-of-line) - (save-match-data - (or (looking-at markdown-regex-header) - (looking-at markdown-regex-hr) - (and (null (markdown-cur-non-list-indent)) - (= (markdown-cur-line-indent) 0) - (markdown-prev-line-blank-p)))))) - -(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 nil t) - (when (match-end 2) - (goto-char (match-end 2)) - (cond - ((markdown-new-baseline-p) - (setq stop t)) - ((looking-at 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-p) (setq levels nil)) - ;; Make sure this is not a line from a pre block - ((looking-at pre-regexp)) - ;; If not, then update levels - (t - (setq indent (markdown-cur-line-indent)) - (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 (markdown-cur-line-indent)) - (while - (cond - ;; List item - ((and (looking-at markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Stop and return point at item of lesser or equal indentation - ((<= (nth 3 bounds) level) - (setq prev (point)) - 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 markdown-regex-header) (setq prev nil)) - ;; Stop at a horizontal rule - ((looking-at markdown-regex-hr) (setq prev nil)) - ;; Otherwise, continue. - (t t)) - (forward-line -1) - (setq indent (markdown-cur-line-indent))) - 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 prev next) - (setq next (point)) - (forward-line) - (setq indent (markdown-cur-line-indent)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) (setq prev nil)) - ;; Continue if the current line is blank - ((markdown-cur-line-blank-p) t) - ;; List item - ((and (looking-at 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 markdown-regex-header) (setq next nil)) - ;; Stop at a horizontal rule - ((looking-at markdown-regex-hr) (setq next nil)) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (markdown-cur-line-indent))) - next)) - -(defun markdown-cur-list-item-end (level) - "Move to the end of the current list item with nonlist indentation LEVEL. -If the point is not in a list item, do nothing." - (let (indent) - (forward-line) - (setq indent (markdown-cur-line-indent)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue if the 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 previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank-p)) - nil) - ;; Stop at a new list item of the same or lesser indentation - ((looking-at markdown-regex-list) nil) - ;; Stop at a header - ((looking-at markdown-regex-header) nil) - ;; Stop at a horizontal rule - ((looking-at markdown-regex-hr) nil) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (markdown-cur-line-indent))) - ;; Don't skip over whitespace for empty list items (marker and - ;; whitespace only), just move to end of whitespace. - (if (looking-back (concat markdown-regex-list "\\s-*") nil) - (goto-char (match-end 3)) - (skip-syntax-backward "-")))) - -(defun markdown-cur-list-item-bounds () - "Return bounds and indentation of the current list item. -Return a list of the form (begin end indent nonlist-indent marker). -If the point is not inside a list item, return nil. -Leave match data intact for `markdown-regex-list'." - (let (cur prev-begin prev-end indent nonlist-indent marker) - ;; Store current location - (setq cur (point)) - ;; Verify that cur is between beginning and end of item - (save-excursion - (end-of-line) - (when (re-search-backward markdown-regex-list nil t) - (setq prev-begin (match-beginning 0)) - (setq indent (length (match-string 1))) - (setq nonlist-indent (length (match-string 0))) - (setq marker (concat (match-string 2) (match-string 3))) - (save-match-data - (markdown-cur-list-item-end nonlist-indent) - (setq prev-end (point))) - (when (and (>= cur prev-begin) - (<= cur prev-end) - nonlist-indent) - (list prev-begin prev-end indent nonlist-indent marker)))))) - -(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 a list of all defined reference labels (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))) - (add-to-list 'refs target t))) - refs))) - -(defun markdown-code-at-point-p () - "Return non-nil if the point is at an inline code fragment. -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 backticks. -Group 2 matches the code fragment itself, without backticks. -Group 3 matches the closing backticks." - (interactive) - (save-excursion - (let ((old-point (point)) - (end-of-block (progn (markdown-end-of-block) (point))) - found) - (markdown-beginning-of-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-code-block-at-pos (pos) - "Return match data list if there is a code block at POS. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. Return nil otherwise." - (or (get-text-property pos 'markdown-pre) - (get-text-property pos 'markdown-gfm-code) - (get-text-property pos 'markdown-fenced-code))) - -(defun markdown-code-block-at-point () - "Return match data if the point is inside a code block. -This includes pre blocks, tilde-fenced code blocks, and -GFM quoted code blocks. Calls `markdown-code-block-at-pos'." - (markdown-code-block-at-pos (point))) - - -;;; Markdown Font Lock Matching Functions ===================================== - -(defun markdown-range-property-any (begin end prop values) - "Return t if PROP from BEGIN to END is equal to one of the given VALUES. -Also returns t if PROP is a list containing one of the VALUES. -Return nil otherwise." - (let (loc props val) - (catch 'found - (dolist (loc (number-sequence begin end)) - (when (setq props (get-char-property loc prop)) - (cond ((listp props) - ;; props is a list, check for membership - (dolist (val values) - (when (memq val props) (throw 'found loc)))) - (t - ;; props is a scalar, check for equality - (dolist (val values) - (when (eq val props) (throw 'found loc)))))))))) - -(defun markdown-match-inline-generic (regex last) - "Match inline REGEX from the point to LAST." - (when (re-search-forward regex last t) - (let ((bounds (markdown-code-block-at-pos (match-beginning 0)))) - (if (null bounds) - ;; Not in a code block: keep match data and return t when in bounds - (<= (match-end 0) last) - ;; In code block: move past it and recursively search again - (when (< (goto-char (nth 1 bounds)) last) - (markdown-match-inline-generic regex last)))))) - -(defun markdown-match-code (last) - "Match inline code fragments from point to LAST." - (unless (bobp) - (backward-char 1)) - (when (markdown-match-inline-generic markdown-regex-code 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))) - (goto-char (1+ (match-end 0))))) - -(defun markdown-match-bold (last) - "Match inline bold from the point to LAST." - (when (markdown-match-inline-generic markdown-regex-bold 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))) - (goto-char (1+ (match-end 0))))) - -(defun markdown-match-italic (last) - "Match inline italics from the point to LAST." - (let ((regex (if (eq major-mode 'gfm-mode) - markdown-regex-gfm-italic markdown-regex-italic))) - (when (markdown-match-inline-generic regex last) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (cond - ((markdown-range-property-any - begin end 'face (list markdown-inline-code-face - markdown-bold-face - markdown-math-face)) - (goto-char (1+ (match-end 0))) - (markdown-match-italic 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 (1+ (match-end 0))))))))) - -(defun markdown-match-math-generic (regex last) - "Match quoted $..$ or $$..$$ math from point to LAST." - (when (and markdown-enable-math - (markdown-match-inline-generic regex last)) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (prog1 - (if (markdown-range-property-any - begin end 'face (list markdown-inline-code-face - markdown-bold-face)) - (markdown-match-math-generic regex last) - t) - (goto-char (1+ (match-end 0))))))) - -(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-propertized-text (property last) - "Match text with PROPERTY from point to LAST. -Restore match data previously stored in PROPERTY." - (let (saved pos) - (unless (setq saved (get-text-property (point) property)) - (setq pos (next-single-char-property-change (point) property nil last)) - (setq saved (get-text-property pos property))) - (when saved - (set-match-data saved) - (goto-char (min (1+ (match-end 0)) (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-fenced-code-blocks (last) - "Match fenced code blocks from the point to LAST." - (markdown-match-propertized-text 'markdown-fenced-code 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-heading-1-setext (last) - "Match level 1 setext headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-1-setext last)) - -(defun markdown-match-heading-2-setext (last) - "Match level 2 setext headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-2-setext last)) - -(defun markdown-match-heading-1-atx (last) - "Match level 1 ATX headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-1-atx last)) - -(defun markdown-match-heading-2-atx (last) - "Match level 2 ATX headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-2-atx last)) - -(defun markdown-match-heading-3-atx (last) - "Match level 3 ATX headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-3-atx last)) - -(defun markdown-match-heading-4-atx (last) - "Match level 4 ATX headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-4-atx last)) - -(defun markdown-match-heading-5-atx (last) - "Match level 5 ATX headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-5-atx last)) - -(defun markdown-match-heading-6-atx (last) - "Match level 6 ATX headings from point to LAST." - (markdown-match-propertized-text 'markdown-heading-6-atx last)) - -(defun markdown-match-hr (last) - "Match horizontal rules comments from the point to LAST." - (while (and (re-search-forward markdown-regex-hr last t) - (or (markdown-on-heading-p) - (markdown-code-block-at-point)) - (< (match-end 0) last)) - (forward-line)) - (beginning-of-line) - (cond ((looking-at markdown-regex-hr) - (forward-line) - t) - (t nil))) - -(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-metadata (regexp last) - "Match generic metadata specified by REGEXP from the point to LAST." - (let ((header-end (save-excursion - (goto-char (point-min)) - (if (re-search-forward "\n\n" (point-max) t) - (match-beginning 0) - (point-max))))) - (cond ((>= (point) header-end) - ;; Don't match anything outside of the header. - nil) - ((re-search-forward regexp (min last header-end) t) - ;; If a metadata item is found, it may span several lines. - (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))) - (while (and (not (looking-at regexp)) - (not (> (point) (min last header-end))) - (not (eobp))) - (forward-line)) - (unless (eobp) - (forward-line -1) - (end-of-line)) - (set-match-data (list key-beginning (point) ; complete metadata - key-beginning key-end ; key - markup-begin markup-end ; markup - value-beginning (point))) ; value - t)) - (t nil)))) - -(defun markdown-match-multimarkdown-metadata (last) - "Match MultiMarkdown metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-multimarkdown-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)) - - -;;; 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 "\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 cursor 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 cursor 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 cursor 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 cursor 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 cursor 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-code-at-point-p) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "`" "`" 'word nil nil)))) - -(defun markdown-insert-link () - "Insert an inline link, using region or word as link text if possible. -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. In these cases, the -point will be left at the position for inserting a URL. If there is no -active region and the point is not at word, simply insert link markup and -place the point in the position to enter link text." - (interactive) - (let ((bounds (markdown-wrap-or-insert "[" "]()"))) - (when bounds - (goto-char (- (cdr bounds) 1))))) - -(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 - (let ((end (point)) - (label (if (> (length label) 0) label text))) - (cond - ((eq markdown-reference-location 'end) (goto-char (point-max))) - ((eq markdown-reference-location 'immediately) (markdown-end-of-block)) - ((eq markdown-reference-location 'header) (markdown-end-of-defun))) - (unless (markdown-cur-line-blank-p) (insert "\n")) - (insert "\n[" label "]: " url) - (unless (> (length url) 0) - (setq end (point))) - (when (> (length title) 0) - (insert " \"" title "\"")) - (insert "\n") - (unless (or (eobp) (looking-at "\n")) - (insert "\n")) - (goto-char end) - (when (> (length url) 0) - (message - (substitute-command-keys - "Defined reference [%s], press \\[markdown-jump] to jump there") - (or label text)))))) - -(defun markdown-insert-reference-link-dwim () - "Insert a reference link of the form [text][label] at point. -If there is an active region, the text in the region will be used -as the link text. If the point is at an inline link, it will be -converted to a reference link. If the point is at a word, it will -be used as the link text. Otherwise, the link text will be read from -the minibuffer. The link label will be read from the minibuffer in -both cases, with completion from the set of currently defined -references. To create an implicit reference link, press RET to -accept the default, an empty label. If the entered referenced -label is not defined, additionally prompt for the URL -and (optional) title. The reference definition is placed at the -location determined by `markdown-reference-location'." - (interactive) - (let* ((defined-labels (mapcar (lambda (x) (substring x 1 -1)) - (markdown-get-defined-references))) - (switch (thing-at-point-looking-at markdown-regex-link-inline)) - (bounds (cond ((markdown-use-region-p) - (cons (region-beginning) (region-end))) - (switch - (cons (match-beginning 0) (match-end 0))) - (t - (markdown-bounds-of-thing-at-point 'word)))) - (text (cond (switch (match-string 3)) - (bounds (buffer-substring (car bounds) (cdr bounds))) - (t (read-string "Link Text: ")))) - (label (completing-read - "Link Label (default: none): " defined-labels - nil nil nil 'markdown-reference-label-history nil)) - (ref (save-match-data - (markdown-reference-definition - (if (> (length label) 0) label text)))) - (url (cond (ref nil) - (switch (match-string 6)) - (t (read-string "Link URL: ")))) - (title (cond - ((= (length url) 0) nil) - (switch (if (> (length (match-string 7)) 2) - (substring (match-string 7) 1 -1) - nil)) - (t (read-string "Link Title (optional): "))))) - (when bounds (delete-region (car bounds) (cdr bounds))) - (markdown-insert-reference-link text label url title))) - -(defun markdown-insert-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, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-angle-uri) - (markdown-unwrap-thing-at-point nil 0 2) - (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-insert-image (&optional arg) - "Insert image markup using region or word as alt text if possible. -If there is an active region, use the region as the alt text. If the -point is at a word, use the word as the alt text. In these cases, the -point will be left at the position for inserting a URL. If there is no -active region and the point is not at word, simply insert image markup and -place the point in the position to enter alt text. If ARG is nil, insert -inline image markup. Otherwise, insert reference image markup." - (interactive "*P") - (let ((bounds (if arg - (markdown-wrap-or-insert "![" "][]") - (markdown-wrap-or-insert "![" "]()")))) - (when bounds - (goto-char (- (cdr bounds) 1))))) - -(defun markdown-insert-reference-image () - "Insert reference-style image markup using region or word as alt text. -Calls `markdown-insert-image' with prefix argument." - (interactive) - (markdown-insert-image t)) - -(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 cursor 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 "^[ \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 - (if setext - (backward-char (1+ (string-width text))) - (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 (re-search-backward markdown-regex-header nil t) - ;; level of previous header - (setq level (markdown-outline-level)) - ;; match groups 1 and 2 indicate setext headers - (setq setext (or setext (match-end 1) (match-end 3))))) - ;; check prefix argument - (cond - ((and (equal arg '(4)) (> level 1)) ;; C-u - (cl-decf level)) - ((and (equal arg '(16)) (< 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 (count 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))) - ;; 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))) - (insert 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 (count (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. - '("ABAP" "AMPL" "ANTLR" "APL" "ASP" "ATS" "ActionScript" "Ada" "Agda" "Alloy" - "ApacheConf" "Apex" "AppleScript" "Arc" "Arduino" "AsciiDoc" "AspectJ" - "Assembly" "Augeas" "AutoHotkey" "AutoIt" "Awk" "Batchfile" "Befunge" - "Bison" "BitBake" "BlitzBasic" "BlitzMax" "Bluespec" "Boo" "Brainfuck" - "Brightscript" "Bro" "C" "C++" "C-ObjDump" "CLIPS" "CMake" "COBOL" "CSS" - "CartoCSS" "Ceylon" "Chapel" "Charity" "ChucK" "Cirru" "Clarion" "Clean" - "Click" "Clojure" "CoffeeScript" "ColdFusion" "Cool" "Coq" "Cpp-ObjDump" - "Creole" "Crystal" "Cucumber" "Cuda" "Cycript" "Cython" "D" "D-ObjDump" "DM" - "DTrace" "Dart" "Diff" "Dockerfile" "Dogescript" "Dylan" "E" "ECL" "ECLiPSe" - "Eagle" "Eiffel" "Elixir" "Elm" "EmberScript" "Erlang" "FLUX" "FORTRAN" - "Factor" "Fancy" "Fantom" "Filterscript" "Formatted" "Forth" "FreeMarker" - "Frege" "G-code" "GAMS" "GAP" "GAS" "GDScript" "GLSL" "Genshi" "Glyph" - "Gnuplot" "Go" "Golo" "Gosu" "Grace" "Gradle" "Groff" "Groovy" "HCL" "HTML" - "HTML+Django" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTTP" "Hack" "Haml" - "Handlebars" "Harbour" "Haskell" "Haxe" "Hy" "HyPhy" "IDL" "INI" "Idris" - "Io" "Ioke" "Isabelle" "J" "JFlex" "JSON" "JSON5" "JSONLD" "JSONiq" "JSX" - "Jade" "Jasmin" "Java" "JavaScript" "Julia" "KRL" "KiCad" "Kit" "Kotlin" - "LFE" "LLVM" "LOLCODE" "LSL" "LabVIEW" "Lasso" "Latte" "Lean" "Less" "Lex" - "LilyPond" "Limbo" "Liquid" "LiveScript" "Logos" "Logtalk" "LookML" - "LoomScript" "Lua" "M" "MAXScript" "MTML" "MUF" "Makefile" "Mako" "Markdown" - "Mask" "Mathematica" "Matlab" "Max" "MediaWiki" "Mercury" "Metal" "MiniD" - "Mirah" "Modelica" "Modula-2" "Monkey" "Moocode" "MoonScript" "Myghty" "NCL" - "NL" "NSIS" "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nginx" - "Nimrod" "Ninja" "Nit" "Nix" "Nu" "NumPy" "OCaml" "ObjDump" "Objective-C" - "Objective-C++" "Objective-J" "Omgrofl" "Opa" "Opal" "OpenCL" "OpenSCAD" - "Org" "Ox" "Oxygene" "Oz" "PAWN" "PHP" "PLSQL" "PLpgSQL" "Pan" "Papyrus" - "Parrot" "Pascal" "Perl" "Perl6" "Pickle" "PicoLisp" "PigLatin" "Pike" "Pod" - "PogoScript" "Pony" "PostScript" "PowerShell" "Processing" "Prolog" "Puppet" - "PureBasic" "PureScript" "Python" "QML" "QMake" "R" "RAML" "RDoc" - "REALbasic" "RHTML" "RMarkdown" "Racket" "Rebol" "Red" "Redcode" "Ren'Py" - "RenderScript" "RobotFramework" "Rouge" "Ruby" "Rust" "SAS" "SCSS" "SMT" - "SPARQL" "SQF" "SQL" "SQLPL" "STON" "SVG" "Sage" "SaltStack" "Sass" "Scala" - "Scaml" "Scheme" "Scilab" "Self" "Shell" "ShellSession" "Shen" "Slash" - "Slim" "Smali" "Smalltalk" "Smarty" "SourcePawn" "Squirrel" "Stan" "Stata" - "Stylus" "SuperCollider" "Swift" "SystemVerilog" "TOML" "TXL" "Tcl" "Tcsh" - "TeX" "Tea" "Text" "Textile" "Thrift" "Turing" "Turtle" "Twig" "TypeScript" - "UnrealScript" "UrWeb" "VCL" "VHDL" "Vala" "Verilog" "VimL" "Volt" "Vue" - "WebIDL" "X10" "XC" "XML" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" - "Xtend" "YAML" "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 - "Languages used in the current buffer in GFM code blocks, which are not -already in `markdown-gfm-recognized-languages' or -`markdown-gfm-additional-languages'.") -(make-variable-buffer-local 'markdown-gfm-used-languages) -(defvar markdown-gfm-last-used-language nil - "Last language used in the current buffer in GFM code blocks.") -(make-variable-buffer-local 'markdown-gfm-last-used-language) - -(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." - (append markdown-gfm-used-languages - markdown-gfm-additional-languages - markdown-gfm-recognized-languages)) - -(defun markdown-add-language-if-new (lang) - (let* ((cleaned-lang (markdown-clean-language-string lang)) - (find-result - (cl-find cleaned-lang (markdown-gfm-get-corpus) - :test #'equal))) - (setq markdown-gfm-last-used-language cleaned-lang) - (unless find-result (push cleaned-lang markdown-gfm-used-languages)))) - -(defun markdown-insert-gfm-code-block (&optional lang) - "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." - (interactive - (list (let ((completion-ignore-case nil)) - (condition-case _err - (markdown-clean-language-string - (completing-read - (format "Programming language [%s]: " - (or markdown-gfm-last-used-language "none")) - (markdown-gfm-get-corpus) - nil 'confirm nil - 'markdown-gfm-language-history - (or markdown-gfm-last-used-language - (car markdown-gfm-additional-languages)))) - (quit ""))))) - (unless (string= lang "") (markdown-add-language-if-new lang)) - (when (> (length lang) 0) (setq lang (concat " " lang))) - (if (markdown-use-region-p) - (let ((b (region-beginning)) (e (region-end))) - (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)) - (insert "```") - (markdown-ensure-blank-line-after) - (goto-char b) - ;; if we're on a blank line, insert the quotes here, otherwise - ;; add a new line first - (unless (looking-at "\n") - (newline) - (forward-line -1)) - (markdown-ensure-blank-line-before) - (insert "```" lang)) - (markdown-ensure-blank-line-before) - (insert "```" lang) - (newline 2) - (insert "```") - (markdown-ensure-blank-line-after) - (forward-line -1))) - -(defun markdown-gfm-parse-buffer-for-languages (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward markdown-regex-gfm-code-block nil t) - (let ((lang (match-string-no-properties 2))) - (when lang (markdown-add-language-if-new lang))))))) - - -;;; 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 cursor 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-block)) - ((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 - (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 - (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 "^\\[" 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 (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) - (save-excursion - ;; move point between [ and ^: - (if (looking-at "\\[") - (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) - (>= (markdown-cur-line-indent) 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))))))) - - -;;; 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 tmp) - (cond - ;; Inline code - ((markdown-code-at-point-p) - (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) - ((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 - (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)) - -(defun markdown-exdent-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)) - (cur-pos (current-column))) - (if (not (equal this-command 'markdown-cycle)) - (indent-line-to (car positions)) - (setq positions (sort (delete-dups positions) '<)) - (indent-line-to - (markdown-indent-find-next-position cur-pos positions))))) - -(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 (markdown-prev-non-list-indent)) - (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 according to to the value of `markdown-indent-on-enter'." - (interactive) - (newline) - (when markdown-indent-on-enter - (markdown-indent-line))) - -(defun markdown-exdent-or-delete (arg) - "Handle BACKSPACE by cycling through indentation points. -When BACKSPACE is pressed, if there is only whitespace -before the current point, then exdent the line one level. -Otherwise, do normal delete by repeating -`backward-delete-char-untabify' ARG times." - (interactive "*p") - (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-exdent-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 "[ \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, exdent 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-exdent-find-next-position leftmostcol positions) - (markdown-indent-find-next-position leftmostcol positions)))) - (indent-rigidly beg end (- next-pos leftmostcol)) - (setq deactivate-mark nil))) - -(defun markdown-exdent-region (beg end) - "Call `markdown-indent-region' on region from BEG to END with prefix." - (interactive "*r") - (markdown-indent-region (region-beginning) (region-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." - (save-match-data - (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 "[ \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." - (save-match-data - (or (not (= (length (match-string 1)) (length (match-string 2)))) - (string-match "[ \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 (error "Markup at point is complete")) - (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)))))) - (add-to-list 'previous regexp))))) - -(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)) - (text (match-string 1))) - (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 ==================================================================== - -(defvar markdown-mode-map - (let ((map (make-keymap))) - ;; Element insertion - (define-key map "\C-c\C-al" 'markdown-insert-link) - (define-key map "\C-c\C-aL" 'markdown-insert-reference-link-dwim) - (define-key map "\C-c\C-au" 'markdown-insert-uri) - (define-key map "\C-c\C-af" 'markdown-insert-footnote) - (define-key map "\C-c\C-aw" 'markdown-insert-wiki-link) - (define-key map "\C-c\C-ii" 'markdown-insert-image) - (define-key map "\C-c\C-iI" 'markdown-insert-reference-image) - (define-key map "\C-c\C-th" 'markdown-insert-header-dwim) - (define-key map "\C-c\C-tH" 'markdown-insert-header-setext-dwim) - (define-key map "\C-c\C-t1" 'markdown-insert-header-atx-1) - (define-key map "\C-c\C-t2" 'markdown-insert-header-atx-2) - (define-key map "\C-c\C-t3" 'markdown-insert-header-atx-3) - (define-key map "\C-c\C-t4" 'markdown-insert-header-atx-4) - (define-key map "\C-c\C-t5" 'markdown-insert-header-atx-5) - (define-key map "\C-c\C-t6" 'markdown-insert-header-atx-6) - (define-key map "\C-c\C-t!" 'markdown-insert-header-setext-1) - (define-key map "\C-c\C-t@" 'markdown-insert-header-setext-2) - (define-key map "\C-c\C-ss" 'markdown-insert-bold) - (define-key map "\C-c\C-se" 'markdown-insert-italic) - (define-key map "\C-c\C-sc" 'markdown-insert-code) - (define-key map "\C-c\C-sb" 'markdown-insert-blockquote) - (define-key map "\C-c\C-s\C-b" 'markdown-blockquote-region) - (define-key map "\C-c\C-sp" 'markdown-insert-pre) - (define-key map "\C-c\C-s\C-p" 'markdown-pre-region) - (define-key map "\C-c\C-sP" 'markdown-insert-gfm-code-block) - (define-key map "\C-c-" 'markdown-insert-hr) - ;; Element insertion (deprecated) - (define-key map "\C-c\C-ar" 'markdown-insert-reference-link-dwim) - (define-key map "\C-c\C-tt" 'markdown-insert-header-setext-1) - (define-key map "\C-c\C-ts" 'markdown-insert-header-setext-2) - ;; Element removal - (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) - ;; Promotion, Demotion, Completion, 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 Jumping - (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) - (define-key map (kbd "C-c C-j") 'markdown-jump) - ;; Indentation - (define-key map (kbd "C-m") 'markdown-enter-key) - (define-key map (kbd "DEL") 'markdown-exdent-or-delete) - (define-key map (kbd "C-c >") 'markdown-indent-region) - (define-key map (kbd "C-c <") 'markdown-exdent-region) - ;; Visibility cycling - (define-key map (kbd "TAB") 'markdown-cycle) - (define-key map (kbd "") 'markdown-shifttab) - (define-key map (kbd "") 'markdown-shifttab) - (define-key map (kbd "") 'markdown-shifttab) - ;; Header navigation - (define-key map (kbd "C-c C-n") 'markdown-next-visible-heading) - (define-key map (kbd "C-c C-p") 'markdown-previous-visible-heading) - (define-key map (kbd "C-c C-f") 'markdown-forward-same-level) - (define-key map (kbd "C-c C-b") 'markdown-backward-same-level) - (define-key map (kbd "C-c C-u") 'markdown-up-heading) - ;; Buffer-wide commands - (define-key map (kbd "C-c C-c m") 'markdown-other-window) - (define-key map (kbd "C-c C-c p") 'markdown-preview) - (define-key map (kbd "C-c C-c e") 'markdown-export) - (define-key map (kbd "C-c C-c v") 'markdown-export-and-preview) - (define-key map (kbd "C-c C-c o") 'markdown-open) - (define-key map (kbd "C-c C-c l") 'markdown-live-preview-mode) - (define-key map (kbd "C-c C-c w") 'markdown-kill-ring-save) - (define-key map (kbd "C-c C-c c") 'markdown-check-refs) - (define-key map (kbd "C-c C-c n") 'markdown-cleanup-list-numbers) - (define-key map (kbd "C-c C-c ]") 'markdown-complete-buffer) - ;; List editing - (define-key map (kbd "M-") 'markdown-move-up) - (define-key map (kbd "M-") 'markdown-move-down) - (define-key map (kbd "M-") 'markdown-promote) - (define-key map (kbd "M-") 'markdown-demote) - (define-key map (kbd "M-") 'markdown-insert-list-item) - ;; Subtree editing - (define-key map (kbd "M-S-") 'markdown-move-subtree-up) - (define-key map (kbd "M-S-") 'markdown-move-subtree-down) - (define-key map (kbd "M-S-") 'markdown-promote-subtree) - (define-key map (kbd "M-S-") 'markdown-demote-subtree) - ;; Movement - (define-key map (kbd "M-{") 'markdown-backward-paragraph) - (define-key map (kbd "M-}") 'markdown-forward-paragraph) - (define-key map (kbd "M-n") 'markdown-next-link) - (define-key map (kbd "M-p") 'markdown-previous-link) - ;; 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) - (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) - map) - "Keymap for Markdown major mode.") - -(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" - ("Show/Hide" - ["Cycle visibility" markdown-cycle (markdown-on-heading-p)] - ["Cycle global visibility" markdown-shifttab]) - "---" - ["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 toggle :selected markdown-live-preview-mode] - ["Kill ring save" markdown-kill-ring-save] - "---" - ("Headings" - ["Automatic" markdown-insert-header-dwim] - ["Automatic (prefer setext)" markdown-insert-header-setext-dwim] - "---" - ["First level setext" markdown-insert-header-setext-1] - ["Second level setext" markdown-insert-header-setext-2] - "---" - ["First level atx" markdown-insert-header-atx-1] - ["Second level atx" markdown-insert-header-atx-2] - ["Third level atx" markdown-insert-header-atx-3] - ["Fourth level atx" markdown-insert-header-atx-4] - ["Fifth level atx" markdown-insert-header-atx-5] - ["Sixth level atx" markdown-insert-header-atx-6]) - "---" - ["Bold" markdown-insert-bold] - ["Italic" markdown-insert-italic] - ["Strikethrough" markdown-insert-strike-through] - ["Blockquote" markdown-insert-blockquote] - ["Preformatted" markdown-insert-pre] - ["Code" markdown-insert-code] - "---" - ["Insert inline link" markdown-insert-link] - ["Insert reference link" markdown-insert-reference-link-dwim] - ["Insert URL" markdown-insert-uri] - ["Insert inline image" markdown-insert-image] - ["Insert reference image" markdown-insert-reference-image] - ["Insert list item" markdown-insert-list-item] - ["Insert horizontal rule" markdown-insert-hr] - ["Insert footnote" markdown-insert-footnote] - ["Kill element" markdown-kill-thing-at-point] - "---" - ["Jump" markdown-jump] - ["Follow link" markdown-follow-thing-at-point] - ("Outline" - ["Next visible heading" markdown-next-visible-heading] - ["Previous visible heading" markdown-previous-visible-heading] - ["Forward same level" markdown-forward-same-level] - ["Backward same level" markdown-backward-same-level] - ["Up to parent heading" markdown-up-heading]) - "---" - ("Completion and Cycling" - ["Complete" markdown-complete] - ["Promote" markdown-promote] - ["Demote" markdown-demote]) - ("List editing" - ["Indent list item" markdown-demote] - ["Exdent list item" markdown-promote]) - ("Region shifting" - ["Indent region" markdown-indent-region] - ["Exdent region" markdown-exdent-region]) - "---" - ["Check references" markdown-check-refs] - ["Clean up list numbering" markdown-cleanup-list-numbers] - ["Complete markup" markdown-complete-buffer] - "---" - ["Version" markdown-show-version] - )) - - -;;; imenu ===================================================================== - -(defun markdown-imenu-create-index () - "Create and return an 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 - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (unless (markdown-code-block-at-point) - (cond - ((setq heading (match-string-no-properties 1)) - (setq pos (match-beginning 1) - level 1)) - ((setq heading (match-string-no-properties 3)) - (setq pos (match-beginning 3) - level 2)) - ((setq hashes (match-string-no-properties 5)) - (setq heading (match-string-no-properties 6) - pos (match-beginning 5) - 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 (i (- 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 (i (1- level)) - (setq sibling-alist (last (cdar sibling-alist)))) - (setcdr sibling-alist alist) - (setq cur-alist alist)) - (setq cur-level level)))))) - (cdr root)))) - - -;;; References ================================================================ - -(defun markdown-insert-reference-definition (ref &optional buffer) - "Add blank REF definition to the end of BUFFER. -REF is a Markdown reference without the square brackets." - (or buffer (setq buffer (current-buffer))) - (with-current-buffer buffer - (goto-char (point-max)) - (indent-new-comment-line) - (insert (concat "[" ref "]: ")))) - -(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 (markdown-reference-definition target)))) - (if loc - (goto-char loc) - (markdown-insert-reference-definition target (current-buffer)))))) - -(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))) - (add-to-list 'links (list text start line))))) - links)) - -(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)))." - (let ((missing)) - (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)))) - (unless (markdown-reference-definition target) - (let ((entry (assoc target missing))) - (if (not entry) - (add-to-list 'missing (cons target - (list (cons text (markdown-line-number-at-pos)))) t) - (setcdr entry - (append (cdr entry) (list (cons text (markdown-line-number-at-pos)))))))))) - missing))) - -(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-reference-check-buffer (&optional buffer-name) - "Name and return buffer for reference checking. -BUFFER-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 - markdown-reference-check-buffer)))) - (with-current-buffer refbuf - (when view-mode - (View-exit-and-edit)) - (use-local-map button-buffer-map) - (erase-buffer)) - refbuf)) - -(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-reference-links-buffer (&optional buffer-name) - "Name, setup, and return a buffer for listing links. -BUFFER-NAME is the name of the main buffer being visited." - (or buffer-name (setq buffer-name (buffer-name))) - (let ((linkbuf (get-buffer-create (markdown-replace-regexp-in-string - "%buffer%" buffer-name - markdown-reference-links-buffer)))) - (with-current-buffer linkbuf - (when view-mode - (View-exit-and-edit)) - (use-local-map button-buffer-map) - (erase-buffer)) - linkbuf)) - -(when (markdown-use-buttons-p) - ;; Add an empty Markdown reference definition to the end of 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))) - (markdown-insert-reference-definition (button-label b) buffer) - (switch-to-buffer-other-window buffer) - (goto-char (point-max)) - (markdown-check-refs t)))) - - ;; Jump to line in buffer specified by 'target-buffer property. - ;; Line number is button's '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) - (message (button-get b 'buffer)) - (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)))) - - ;; Jumps to a particular link at location given by 'target-char - ;; property in buffer given by 'target-buffer property. - (define-button-type 'markdown-link-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 by `markdown-get-undefined-refs'." - (let ((label (car reference))) - (if (markdown-use-buttons-p) - ;; Create a reference button in Emacs 22 - (insert-button label - :type 'markdown-undefined-reference-button - 'target-buffer oldbuf) - ;; Insert reference as text in Emacs < 22 - (insert label)) - (insert " (") - (dolist (occurrence (cdr reference)) - (let ((line (cdr occurrence))) - (if (markdown-use-buttons-p) - ;; Create a line number button in Emacs 22 - (insert-button (number-to-string line) - :type 'markdown-goto-line-button - 'target-buffer oldbuf - 'target-line line) - ;; Insert line number as text in Emacs < 22 - (insert (number-to-string line))) - (insert " "))) - (delete-char -1) - (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))) - (if (markdown-use-buttons-p) - ;; Create a reference button in Emacs 22 - (insert-button label - :type 'markdown-link-button - 'target-buffer oldbuf - 'target-char char) - ;; Insert reference as text in Emacs < 22 - (insert label)) - (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)) - (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))))) - -(defun markdown-check-refs (&optional silent) - "Show all undefined Markdown references in current `markdown-mode' buffer. -If SILENT is non-nil, do not message anything when no undefined -references found. -Links which have empty reference definitions are considered to be -defined." - (interactive "P") - (when (not (eq major-mode 'markdown-mode)) - (error "Not available in current mode")) - (let ((oldbuf (current-buffer)) - (refs (markdown-get-undefined-refs)) - (refbuf (markdown-reference-check-buffer))) - (if (null refs) - (progn - (when (not silent) - (message "No undefined references found")) - (kill-buffer refbuf)) - (with-current-buffer refbuf - (insert "The following references are undefined:\n\n") - (dolist (ref refs) - (markdown-insert-undefined-reference-button ref oldbuf)) - (view-buffer-other-window refbuf) - (goto-char (point-min)) - (forward-line 2))))) - - -;;; 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 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)) - (cond - ;; Dedent: decrement indentation, find previous marker. - ((= arg 4) - (setq indent (max (- cur-indent 4) 0)) - (let ((prev-bounds - (save-excursion - (when (markdown-prev-list-item (- (nth 3 bounds) 1)) - (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 "[0-9]" marker) - (if (= arg 16) ;; starting a new column indented one more level - (insert (concat new-indent "1. ")) - ;; 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 "\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 - ((string-match "[\\*\\+-]" marker) - (insert new-indent marker))))))) - -(defun markdown-move-list-item-up () - "Move the current list item up in the list when possible." - (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." - (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." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (save-match-data - (let ((end-marker (set-marker (make-marker) (nth 1 bounds)))) - (goto-char (nth 0 bounds)) - (while (< (point) end-marker) - (unless (markdown-cur-line-blank-p) - (insert (make-string markdown-list-indent-width ? ))) - (forward-line))))))) - -(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." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (save-match-data - (let ((end-marker (set-marker (make-marker) (nth 1 bounds))) - num regexp) - (goto-char (nth 0 bounds)) - (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) end-marker) - (re-search-forward regexp end-marker t)) - (replace-match "" nil nil) - (forward-line)))))))) - -(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) - (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. -Move backward to the beginning of the current or previous section. -When ARG is non-nil, repeat that many times. When ARG is negative, -move forward to the ARG-th following section." - (interactive "P") - (or arg (setq arg 1)) - (forward-char 1) - (or (re-search-backward markdown-regex-header nil t arg) - (goto-char (point-min)))) - -(defun markdown-end-of-defun (&optional arg) - "`end-of-defun-function' for Markdown. -Move forward to the end of the current or following section. -When ARG is non-nil, repeat that many times. When ARG is negative, -move back to the ARG-th preceding section." - (interactive "P") - (or arg (setq arg 1)) - (when (looking-at markdown-regex-header) - (goto-char (match-beginning 0)) - (forward-char 1)) - (if (re-search-forward markdown-regex-header nil t arg) - (goto-char (match-beginning 0)) - (goto-char (point-max))) - (skip-syntax-backward "-")) - -(defun markdown-beginning-of-block () - "Move the point to the start of the previous text block." - (interactive) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (or (match-end 2) (match-end 0))) - (goto-char (point-min)))) - -(defun markdown-end-of-block () - "Move the point to the start of the next text block." - (interactive) - (beginning-of-line) - (skip-syntax-forward "-") - (when (= (point) (point-min)) - (forward-char)) - (if (re-search-forward markdown-regex-block-separator nil t) - (goto-char (or (match-end 2) (match-end 0))) - (goto-char (point-max))) - (skip-syntax-backward "-") - (forward-line)) - -(defun markdown-forward-paragraph (arg) - "Move forward one or more paragraphs or by one block. -When ARG is nil or a numeric prefix, call `forward-paragraph' -with ARG. When called with \\[universal-argument], call -`markdown-end-of-block' instead." - (interactive "P") - (or arg (setq arg 1)) - (cond ((integerp arg) - (forward-paragraph arg)) - ((equal arg '(4)) - (markdown-end-of-block)))) - -(defun markdown-backward-paragraph (arg) - "Move backward one or more paragraphs or by one block. -When ARG is nil or a numeric prefix, call `backward-paragraph' -with ARG. When called with \\[universal-argument], call -`markdown-beginning-of-block' instead." - (interactive "P") - (or arg (setq arg 1)) - (cond ((integerp arg) - (backward-paragraph arg)) - ((equal arg '(4)) - (markdown-beginning-of-block)))) - -(defun markdown-end-of-block-element () - "Move the point to the start of the next block unit. -Stops at blank lines, list items, headers, and horizontal rules." - (interactive) - (forward-line) - (while (and (or (not (markdown-prev-line-blank-p)) - (markdown-cur-line-blank-p)) - (not (or (looking-at markdown-regex-list) - (looking-at markdown-regex-header) - (looking-at markdown-regex-hr))) - (not (eobp))) - (forward-line))) - -(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-regex-link-generic nil t) - (markdown-code-block-at-point) - (< (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-regex-link-generic nil t) - (markdown-code-block-at-point) - (> (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))) - -(defun markdown-next-heading () - "Move to the next heading line of any level. -With argument, repeats or can move backward if negative." - (let ((pos (outline-next-heading))) - (while (markdown-code-block-at-point) - (setq pos (outline-next-heading))) - pos)) - -(defun markdown-previous-heading () - "Move to the previous heading line of any level. -With argument, repeats or can move backward if negative." - (let ((pos (outline-previous-heading))) - (while (markdown-code-block-at-point) - (setq pos (outline-previous-heading))) - pos)) - - -;;; Outline =================================================================== - -(defun markdown-move-heading-common (move-fn &optional arg) - "Wrapper for `outline-mode' functions to skip false positives. -For example, headings inside preformatted code blocks may match -`outline-regexp' but should not be considered as headings." - (funcall move-fn arg) - (while (markdown-code-block-at-point) - (funcall move-fn arg))) - -(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." - (interactive "p") - (markdown-move-heading-common 'outline-next-visible-heading arg)) - -(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." - (interactive "p") - (markdown-move-heading-common 'outline-previous-visible-heading arg)) - -(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-move-heading-common 'outline-forward-same-level arg)) - -(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-move-heading-common 'outline-backward-same-level arg)) - -(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") - (markdown-move-heading-common 'outline-up-heading arg)) - -(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 t if point is on a (visible) heading line." - (get-text-property (point) '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 (funcall outline-level))) - (while (and (not (eobp)) - (or first (> (funcall 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." - (save-excursion - (goto-char (point-min)) - (unless (outline-on-heading-p) - (outline-next-visible-heading 1)) - (while (< (point) (point-max)) - (when (markdown-code-block-at-point) - (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-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, insert a tab using `indent-relative'. -Derived from `org-cycle'." - (interactive "P") - (cond - ((eq arg t) ;; Global cycling - (cond - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 2)) - ;; Move from overview to contents - (markdown-hide-sublevels 1) - (message "CONTENTS") - (setq markdown-cycle-global-status 3) - (markdown-outline-fix-visibility)) - - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 3)) - ;; Move from contents to all - (markdown-show-all) - (message "SHOW ALL") - (setq markdown-cycle-global-status 1)) - - (t - ;; Defaults to overview - (markdown-hide-body) - (message "OVERVIEW") - (setq markdown-cycle-global-status 2) - (markdown-outline-fix-visibility)))) - - ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) - ;; At a heading: rotate between three different views - (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 - ((= eos eoh) - ;; Nothing is hidden behind this heading - (message "EMPTY ENTRY") - (setq markdown-cycle-subtree-status nil)) - ((>= eol eos) - ;; Entire subtree is hidden in one line: open it - (markdown-show-entry) - (markdown-show-children) - (message "CHILDREN") - (setq markdown-cycle-subtree-status 'children)) - ((and (eq last-command this-command) - (eq markdown-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - (markdown-show-subtree) - (message "SUBTREE") - (setq markdown-cycle-subtree-status 'subtree)) - (t - ;; Default action: hide the subtree. - (markdown-hide-subtree) - (message "FOLDED") - (setq markdown-cycle-subtree-status 'folded))))) - - (t - (indent-for-tab-command)))) - -(defun markdown-shifttab () - "Global visibility cycling. -Calls `markdown-cycle' with argument t." - (interactive) - (markdown-cycle t)) - -(defun markdown-outline-level () - "Return the depth to which a statement is nested in the outline." - (cond - ((markdown-code-block-at-point) 7) - ((match-end 1) 1) - ((match-end 3) 2) - ((- (match-end 5) (match-beginning 5))))) - -(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." - (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))) - (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 (markdown-next-heading) - ;; 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)) - - -;;; Generic Structure Editing, Completion, and Cycling Commands =============== - -(defun markdown-move-up () - "Move list item up. -Calls `markdown-move-list-item-up'." - (interactive) - (markdown-move-list-item-up)) - -(defun markdown-move-down () - "Move list item down. -Calls `markdown-move-list-item-down'." - (interactive) - (markdown-move-list-item-down)) - -(defun markdown-promote () - "Either promote header or list item at point or cycle markup. -See `markdown-cycle-atx', `markdown-cycle-setext', and -`markdown-promote-list-item'." - (interactive) - (let (bounds) - (cond - ;; Promote atx header - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-cycle-atx -1)) - ;; Promote setext header - ((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)) - ;; 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 - (error "Nothing to promote at point"))))) - -(defun markdown-demote () - "Either demote header or list item at point or cycle or remove markup. -See `markdown-cycle-atx', `markdown-cycle-setext', and -`markdown-demote-list-item'." - (interactive) - (let (bounds) - (cond - ;; Demote atx header - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-cycle-atx 1)) - ;; Demote setext header - ((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)) - ;; 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 - (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)) - (cond - ;; Handle case when `markdown-command' does not read from stdin - (markdown-command-needs-filename - (if (not buffer-file-name) - (error "Must be visiting a file") - (shell-command (concat markdown-command " " - (shell-quote-argument buffer-file-name)) - output-buffer-name))) - ;; Pass region to `markdown-command' via stdin - (t - (shell-command-on-region begin-region end-region markdown-command - output-buffer-name)))) - 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)) - (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 "")) - -(defun markdown-add-xhtml-header-and-footer (title) - "Wrap XHTML header and footer with given TITLE around current buffer." - (goto-char (point-min)) - (insert "\n" - "\n\n" - "\n\n" - "\n") - (insert title) - (insert "\n") - (when (> (length markdown-content-type) 0) - (insert - (format - "\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)) - "iso-8859-1")))) - (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\n\n" - "\n\n") - (goto-char (point-max)) - (insert "\n" - "\n" - "\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 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)) - ;; 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 - "Buffer with markdown source generating the source of the current -buffer. 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) - "A `markdown-live-preview-window-function' for previewing with eww." - (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-live-preview-window-serialize (buf) - "Get window point and scroll data for all windows displaying BUF if BUF is -non-nil." - (when buf - (mapcar (lambda (win) (list win (window-point win) (window-start win))) - (get-buffer-window-list buf)))) - -(defun markdown-live-preview-window-deserialize (window-posns) - "Apply window point and scroll data from WINDOW-POSNS, given by -`markdown-live-preview-window-serialize'." - (cl-destructuring-bind (win pt start) window-posns - (when (window-live-p win) - (set-window-buffer win markdown-live-preview-buffer) - (set-window-point win pt) - (set-window-start win start)))) - -(defun markdown-live-preview-export () - "Export to XHTML using `markdown-export' and browse the resulting file within -Emacs using `markdown-live-preview-window-function' Return the buffer displaying -the rendered output." - (interactive) - (let* ((markdown-live-preview-currently-exporting t) - (cur-buf (current-buffer)) - (export-file (markdown-export (markdown-live-preview-get-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 (file-exists-p outfile-name) - (delete-file outfile-name))))) - -(defun markdown-display-buffer-other-window (buf) - (let ((cur-buf (current-buffer))) - (switch-to-buffer-other-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 () - (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 () - (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) - (if (not markdown-open-command) - (error "Variable `markdown-open-command' must be set") - (if (not buffer-file-name) - (error "Must be visiting a file") - (call-process markdown-open-command - nil nil nil buffer-file-name)))) - -(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)) - (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))))) - -(defun markdown-link-link () - "Return the link part of the regular (non-wiki) link at point. -Works with both inline and reference style links. If point is -not at a link or the link reference is not defined returns nil." - (cond - ((thing-at-point-looking-at markdown-regex-link-inline) - (match-string-no-properties 6)) - ((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)))) - (car (markdown-reference-definition target)))) - ((thing-at-point-looking-at markdown-regex-uri) - (match-string-no-properties 0)) - ((thing-at-point-looking-at markdown-regex-angle-uri) - (match-string-no-properties 2)) - (t nil))) - -(defun markdown-follow-link-at-point () - "Open the current non-wiki link in a browser." - (interactive) - (if (markdown-link-p) (browse-url (markdown-link-link)) - (error "Point is not at a Markdown link or URI"))) - - -;;; WikiLink Following/Markup ================================================= - -(defun markdown-wiki-link-p () - "Return non-nil when `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'." - (let ((case-fold-search nil)) - (and (thing-at-point-looking-at markdown-regex-wiki-link) - (not (markdown-code-block-at-point)) - (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." - (let ((basename (markdown-replace-regexp-in-string - "[[:space:]\n]" markdown-link-space-sub-char name))) - (when (eq major-mode 'gfm-mode) - (setq basename (concat (upcase (substring basename 0 1)) - (downcase (substring basename 1 nil))))) - (let* ((default - (concat basename - (if (and (buffer-file-name) - (file-name-extension (buffer-file-name))) - (concat "." - (file-name-extension (buffer-file-name)))))) - (current default)) - (catch 'done - (condition-case nil - (cl-loop - (if (or (not markdown-wiki-link-search-parent-directories) - (file-exists-p current)) - (throw 'done current)) - (if (string-equal (expand-file-name current) - (concat "/" default)) - (throw 'done default)) - (setq current (concat "../" current))) - (error 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 (file-name-directory buffer-file-name))) - (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) - (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") - (remove-text-properties from to '(font-lock-face markdown-link-face)) - (remove-text-properties from to '(font-lock-face markdown-missing-link-face))) - -(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)) - (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 - (list 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))) - - -;;; Following and Jumping ===================================================== - -(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 - (error "Nothing to follow at point")))) - -(defun markdown-jump () - "Jump to another location based on context at point. -Jumps between reference links and definitions; between footnote -markers and footnote text." - (interactive) - (cond ((markdown-footnote-text-positions) - (markdown-footnote-return)) - ((markdown-footnote-marker-positions) - (markdown-footnote-goto-text)) - ((thing-at-point-looking-at markdown-regex-link-reference) - (markdown-reference-goto-definition)) - ((thing-at-point-looking-at markdown-regex-reference-definition) - (markdown-reference-goto-link (match-string-no-properties 2))) - (t - (error "Nothing to jump to from context at point")))) - - -;;; 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-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-text-p () - "Return nil if not currently within link anchor text." - (looking-back "\\[[^]]*" nil)) - -(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 "^[ \t]*>[ \t]*") - (match-string-no-properties 0)) - ;; List items - ((looking-at markdown-regex-list) - (match-string-no-properties 0)) - ((looking-at markdown-regex-footnote-definition) - " ") ; four spaces - ;; No match - (t nil))) - -(defun markdown-fill-forward-paragraph-function (&optional arg) - (let* ((arg (or arg 1)) - (paragraphs-remaining (forward-paragraph arg)) - (start (point))) - (when (< arg 0) - (while (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (looking-at paragraph-separate)) - (forward-line 1)) - (if (looking-at markdown-regex-list) - (forward-char (length (match-string 0))) - (goto-char start))) - paragraphs-remaining)) - - -;;; Extensions ================================================================ - -(defun markdown-reload-extensions () - "Check settings, update font-lock keywords, and re-fontify buffer." - (interactive) - (when (eq major-mode 'markdown-mode) - (setq markdown-mode-font-lock-keywords - (append - markdown-mode-font-lock-keywords-basic - (when markdown-enable-math - markdown-mode-font-lock-keywords-math))) - (setq font-lock-defaults - '(markdown-mode-font-lock-keywords - nil nil nil nil - (font-lock-syntactic-face-function . markdown-syntactic-face))) - (when (fboundp 'font-lock-refresh-defaults) (font-lock-refresh-defaults)))) - -(defun markdown-enable-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 - (message "markdown-mode math support enabled") - (message "markdown-mode math support disabled")) - (markdown-reload-extensions)) - -(defun markdown-handle-local-variables () - "Runs as a `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) - (assoc 'markdown-enable-math file-local-variables-alist)) - (markdown-reload-extensions))) - - -;;; GFM Checkboxes as Buttons ================================================= - -(require 'button) - -(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) - -(defun markdown-toggle-gfm-checkbox (button) - "Toggle a GFM checkbox clicked on." - (save-match-data - (save-excursion - (goto-char (button-start button)) - (cond ((looking-at "\\[ \\]") - (replace-match "[x]" nil t)) - ((looking-at "\\[[xX]\\]") - (replace-match "[ ]" nil t)))))) - -(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 old-len) - "Add to `after-change-functions' to setup GFM checkboxes as buttons." - (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)))))) - - -;;; Mode Definition ========================================================== - -(defun markdown-show-version () - "Show the version number in the minibuffer." - (interactive) - (message "markdown-mode, version %s" markdown-mode-version)) - -;;;###autoload -(define-derived-mode markdown-mode text-mode "Markdown" - "Major mode for editing Markdown files." - ;; Natural Markdown tab width - (setq tab-width 4) - ;; Comments - (make-local-variable 'comment-start) - (setq comment-start "") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "