Change the target language function to be called in the markdown-mode code block

extensions/lisp-mode/lisp-mode.lisp

@@ -246,7 +246,9 @@
 (defun buffer-package (buffer &optional default)
   (let ((package-name (buffer-value buffer "package" default)))
     (typecase package-name
-      (null default)
+      (null (alexandria:if-let (package-name (scan-current-package (buffer-point buffer)))
+              (string-upcase package-name)
+              default))
       ((or symbol string)
        (string-upcase package-name))
       ((cons (or symbol string))

extensions/markdown-mode/markdown-mode.lisp

@@ -31,6 +31,10 @@
           (column (point-column point)))
       (+ column (- tab-width (rem column tab-width))))))
 
+(defmethod execute :around ((mode markdown-mode) command argument)
+  (with-major-mode (current-major-mode-at-point (current-point))
+    (call-next-method)))
+
 (define-command markdown-insert-link () ()
   (let ((url (prompt-for-string "URL: "
                                 :history-symbol 'mh-markdown-url))

extensions/markdown-mode/syntax-parser.lisp

@@ -1,7 +1,9 @@
 (defpackage :lem-markdown-mode/syntax-parser
   (:use :cl :lem)
   (:export :make-syntax-parser
-           :scan-buffer))
+           :scan-buffer
+           :search-backward-code-block-start
+           :search-forward-code-block-end))
 (in-package :lem-markdown-mode/syntax-parser)
 
 (defclass syntax-parser () ())
@@ -19,20 +21,33 @@
     (line-end end)
     (put-text-property start end :attribute attribute)))
 
+(defun start-code-block-line-p (point)
+  (ppcre:scan "^```" (line-string point)))
+
+(defun end-code-block-line-p (point)
+  (ppcre:scan "^```$" (line-string point)))
+
 (defun scan-code-block (point end)
   (let* ((groups (nth-value 1 (looking-at point "^```(.*)")))
          (language-name (and groups (elt groups 0)))
-         (syntax-table (get-syntax-table-by-mode-name language-name)))
+         (mode (find-mode language-name))
+         (syntax-table (when mode (mode-syntax-table mode))))
     (line-offset point 1)
     (with-point ((start point))
       (loop :while (point< point end)
-            :until (looking-at point "^```")
+            :until (end-code-block-line-p point)
             :while (line-offset point 1))
-      (if syntax-table
-          (syntax-scan-region start point :syntax-table syntax-table :recursive-check nil)
-          (put-text-property start point :attribute 'syntax-string-attribute)))))
+      (cond (syntax-table
+             (set-region-major-mode start point mode)
+             (syntax-scan-region start
+                                 point
+                                 :syntax-table syntax-table
+                                 :recursive-check nil))
+            (t
+             (put-text-property start point :attribute 'syntax-string-attribute))))))
 
 (defun scan-region (start end)
+  (clear-region-major-mode start end)
   (with-point ((point start))
     (loop :while (point< point end)
           :do (cond ((looking-at point "^#")
@@ -52,6 +67,20 @@
                        (skip-chars-forward end #'digit-char-p)
                        (character-offset end 1)
                        (put-text-property start end :attribute 'syntax-keyword-attribute)))
-                    ((looking-at point "^```")
+                    ((start-code-block-line-p point)
                      (scan-code-block point end)))
           :while (line-offset point 1))))
+
+(defun search-backward-code-block-start (point)
+  (with-point ((point point))
+    (loop
+      :do (when (start-code-block-line-p point)
+            (return point))
+      :while (line-offset point -1))))
+
+(defun search-forward-code-block-end (point)
+  (with-point ((point point))
+    (loop
+      :do (when (end-code-block-line-p point)
+            (return point))
+      :while (line-offset point 1))))

src/internal-packages.lisp

@@ -403,7 +403,12 @@
    :enable-minor-mode
    :disable-minor-mode
    :current-global-mode
-   :get-syntax-table-by-mode-name)
+   :get-syntax-table-by-mode-name
+   :set-region-major-mode
+   :clear-region-major-mode
+   :major-mode-at-point
+   :current-major-mode-at-point
+   :with-major-mode)
   ;; keymap.lisp
   (:export
    :*keymaps*

src/keymap.lisp

@@ -169,6 +169,9 @@ Example: (define-key *global-keymap* \"C-'\" 'list-modes)"
   (let* ((keymaps (compute-keymaps (current-global-mode)))
          (keymaps
            (append keymaps
+                   (alexandria:when-let* ((mode (major-mode-at-point (current-point)))
+                                          (keymap (mode-keymap mode)))
+                     (list keymap))
                    (loop :for mode :in (all-active-modes (current-buffer))
                          :when (mode-keymap mode)
                          :collect :it))))

src/mode.lisp

@@ -305,3 +305,29 @@
   (alexandria:when-let* ((mode (find-mode mode-name))
                          (syntax-table (mode-syntax-table mode)))
     syntax-table))
+
+;;;
+(defun clear-region-major-mode (start end)
+  (remove-text-property start end :mode))
+
+(defun set-region-major-mode (start end mode)
+  (put-text-property start end :mode mode))
+
+(defun major-mode-at-point (point)
+  (text-property-at point :mode))
+
+(defun current-major-mode-at-point (point)
+  (or (major-mode-at-point point)
+      (buffer-major-mode (point-buffer point))))
+
+(defun call-with-major-mode (buffer mode function)
+  (let ((previous-mode (buffer-major-mode buffer)))
+    (cond ((eq previous-mode mode)
+           (funcall function))
+          (t
+           (change-buffer-mode buffer mode)
+           (unwind-protect (funcall function)
+             (change-buffer-mode buffer previous-mode))))))
+
+(defmacro with-major-mode (mode &body body)
+  `(call-with-major-mode (current-buffer) ,mode (lambda () ,@body)))