emacs_config/elpa/ein-0.16.2.3/ein-multilang.el

;;; ein-multilang.el --- Notebook mode with multiple language fontification

;; Copyright (C) 2012 Takafumi Arakaki

;; Author: Takafumi Arakaki <aka.tkf at gmail.com>

;; This file is NOT part of GNU Emacs.

;; ein-multilang.el is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; ein-multilang.el 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 ein-multilang.el.
;; If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(eval-when-compile (defvar markdown-mode-map))

(require 'ein-worksheet)
(require 'ein-multilang-fontify)
(require 'python)
(require 'ess-r-mode nil t)
(require 'ess-custom nil t)
(require 'clojure-mode nil t)
(require 'julia-mode nil t)
(require 'haskell-mode nil t)
(require 'hy-mode nil t)
(require 'cc-mode)

(declare-function ess-indent-line "ess")
(declare-function ess-r-eldoc-function "ess-r-completion")
(declare-function ess-setq-vars-local "ess-utils")
(declare-function haskell-indentation-indent-line "haskell-indentation")

(defun ein:ml-fontify (limit)
  "Fontify next input area comes after the current point then
return `t' or `nil' if not found.
See info node `(elisp) Search-based Fontification'."
  (ein:log-ignore-errors
    (ein:ml-fontify-1 limit)))

(defun ein:ml-current-or-next-input-cell (ewoc-node)
  "Almost identical to `ein:worksheet-next-input-cell' but return
the current cell if EWOC-NODE is the input area node."
  (let* ((ewoc-data (ewoc-data ewoc-node))
         (cell (ein:$node-data ewoc-data))
         (path (ein:$node-path ewoc-data))
         (element (nth 1 path)))
    (if (memql element '(prompt input))
        cell
      (ein:cell-next cell))))

(defun ein:ml-fontify-1 (limit)
  "Actual implementation of `ein:ml-fontify'.
This function may raise an error."
  (ein:and-let* ((pos (point))
                 (node (ein:worksheet-get-nearest-cell-ewoc-node pos limit))
                 (cell (ein:ml-current-or-next-input-cell node))
                 (start (ein:cell-input-pos-min cell))
                 (end   (ein:cell-input-pos-max cell))
                 ((<= end limit))
                 ((< start end))
                 (lang (ein:cell-language cell)))
    (let ((inhibit-read-only t))
      (ein:mlf-font-lock-fontify-block lang start end)
      ;; Emacs fontification mechanism requires the function to move
      ;; the point.  Do *not* use `(goto-char end)'.  As END is in the
      ;; input area, fontification falls into an infinite loop.
      (ewoc-goto-node (slot-value cell 'ewoc) (ein:cell-element-get cell :footer)))
    t))

(defun ein:ml-back-to-prev-node ()
  (ein:aand (ein:worksheet-get-ewoc) (ewoc-goto-prev it 1)))

(defvar ein:ml-font-lock-keywords
  '((ein:ml-fontify))
  "Default `font-lock-keywords' for `ein:notebook-multilang-mode'.")

(defun ein:ml-set-font-lock-defaults ()
  (setq-local font-lock-defaults
       '(ein:ml-font-lock-keywords
         ;; The following are adapted from org-mode but I am not sure
         ;; if I need them:
         t nil nil
         ein:ml-back-to-prev-node)))

;;;###autoload
(define-derived-mode ein:notebook-multilang-mode prog-mode "EIN"
  "A mode for fontifying multiple languages.

\\{ein:notebook-multilang-mode-map}
"
  (setq-local beginning-of-defun-function
       'ein:worksheet-beginning-of-cell-input)
  (setq-local end-of-defun-function
       'ein:worksheet-end-of-cell-input)
  (ein:ml-set-font-lock-defaults))

(eval-after-load "auto-complete"
  '(add-to-list 'ac-modes 'ein:notebook-multilang-mode))


;;; Language setup functions

(defun ein:ml-narrow-to-cell ()
  "Narrow to the current cell."
  (ein:and-let* ((pos (point))
                 (node (ein:worksheet-get-nearest-cell-ewoc-node pos))
                 (cell (ein:ml-current-or-next-input-cell node))
                 (start (ein:cell-input-pos-min cell))
                 (end   (ein:cell-input-pos-max cell))
                 ((< start end)))
    (narrow-to-region start end)))

(defun ein:ml-indent-line-function (lang-func)
  (save-restriction
    (ein:ml-narrow-to-cell)
    (funcall lang-func)))

(defun ein:ml-indent-region (lang-func start end)
  (save-restriction
    (ein:ml-narrow-to-cell)
    (funcall lang-func start end)))

(defun ein:ml-lang-setup-python ()
  "Presumably tkf had good reasons to choose only these forms from `python-mode'."
  (setq-local mode-name "EIN[Py]")
  (setq-local comment-start "# ")
  (setq-local comment-start-skip  "#+\\s-*")
  (setq-local parse-sexp-lookup-properties t)
  (setq-local indent-line-function
              (apply-partially #'ein:ml-indent-line-function #'python-indent-line-function))
  (setq-local indent-region-function
              (apply-partially #'ein:ml-indent-region #'python-indent-region))
  (set-syntax-table python-mode-syntax-table)
  (set-keymap-parent ein:notebook-multilang-mode-map python-mode-map))

(defun ein:ml-lang-setup-clojure ()
  "Minimally different than the the python setup"
  (when (featurep 'clojure-mode)
    (setq-local mode-name "EIN[Clj]")
    (setq-local comment-start "; ")
    (setq-local comment-start-skip  ";+\\s-*")
    (setq-local parse-sexp-lookup-properties t)
    (setq-local indent-line-function
                (apply-partially #'ein:ml-indent-line-function #'clojure-indent-line))
    (setq-local indent-region-function
                (apply-partially #'ein:ml-indent-region #'clojure-indent-region))
    (set-syntax-table clojure-mode-syntax-table)
    (set-keymap-parent ein:notebook-multilang-mode-map clojure-mode-map)))

(defun ein:ml-lang-setup-julia ()
  (when (featurep 'julia-mode)
    (setq-local mode-name "EIN[julia]")
    (setq-local comment-start "# ")
    (setq-local comment-start-skip  "#+\\s-*")
    (setq-local indent-line-function
                (apply-partially #'ein:ml-indent-line-function #'julia-indent-line))
    (when (boundp 'julia-mode-syntax-table)
      (set-syntax-table julia-mode-syntax-table))
    (when (boundp 'julia-mode-map)
      (set-keymap-parent ein:notebook-multilang-mode-map julia-mode-map))))

(defun ein:ml-lang-setup-R ()
  (when (and (featurep 'ess-r-mode) (featurep 'ess-custom))
    (setq-local mode-name "EIN[R]")
    (when (boundp 'ess-r-customize-alist)
      (ess-setq-vars-local ess-r-customize-alist))
    (setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
    (setq-local paragraph-separate (concat "\\s-*$\\|" page-delimiter))
    (setq-local paragraph-ignore-fill-prefix t)
    (setq-local indent-line-function
                (apply-partially #'ein:ml-indent-line-function #'ess-indent-line))
    (when (and (boundp 'ess-style) (boundp 'ess-default-style))
      (setq-local ess-style ess-default-style))
    (when (and (boundp 'prettify-symbols-alist) (boundp 'ess-r-prettify-symbols))
      (setq-local prettify-symbols-alist ess-r-prettify-symbols))
    (when (boundp 'ess-r-mode-syntax-table)
      (set-syntax-table ess-r-mode-syntax-table))
    (when (boundp 'ess-r-mode-map)
      (set-keymap-parent ein:notebook-multilang-mode-map ess-r-mode-map))))

(defun ein:ml-lang-setup-haskell ()
  (when (featurep 'haskell-mode)
    (setq-local mode-name "EIN[haskell]")
    (setq-local comment-start "-- ")
    ;; (setq-local comment-start-skip  "--\\s-*")
    (when (boundp 'haskell-indentation-indent-line)
      (setq-local indent-line-function
                  (apply-partially #'ein:ml-indent-line-function #'haskell-indentation-indent-line)))
    (when (boundp 'haskell-mode-syntax-table)
      (set-syntax-table haskell-mode-syntax-table))
    (when (boundp 'haskell-mode-map)
      (set-keymap-parent ein:notebook-multilang-mode-map haskell-mode-map))))

(defun ein:ml-lang-setup-hy ()
  (when (featurep 'hy-mode)
    (setq-local mode-name "EIN[hy]")
    (hy-mode--setup-font-lock)
    (hy-mode--setup-syntax)
    (hy-mode--support-smartparens)
    (set-keymap-parent ein:notebook-multilang-mode-map hy-mode-map)))

(defun ein:ml-lang-setup-c++ ()
  (when (featurep 'c++-mode)
    (setq-local mode-name "EIN[c++]")
    (setq-local comment-start "// ")
    (setq-local indent-line-function
                (apply-partially #'ein:ml-indent-line-function #'c-indent-line))
    (set-syntax-table c++-mode-syntax-table)
    (set-keymap-parent ein:notebook-multilang-mode-map c++-mode-map)))

(defun ein:ml-lang-setup-c ()
  (when (featurep 'c-mode)
    (setq-local mode-name "EIN[c]")
    (setq-local comment-start "/* ")
    (setq-local comment-end " */")
    (setq-local indent-line-function
                (apply-partially #'ein:ml-indent-line-function #'c-indent-line))
    (set-syntax-table c-mode-syntax-table)
    (set-keymap-parent ein:notebook-multilang-mode-map c-mode-map)))

(defun ein:ml-lang-setup-C++11 ()
  (ein:ml-lang-setup-c++))

(defun ein:ml-lang-setup-C++14 ()
  (ein:ml-lang-setup-c++))

(defun ein:ml-lang-setup-C++17 ()
  (ein:ml-lang-setup-c++))

(defun ein:ml-lang-setup-generic ()
  (setq-local mode-name "EIN[unknown]")
  (setq-local indent-line-function
              (apply-partially #'ein:ml-indent-line-function #'indent-relative))
  (set-syntax-table prog-mode-syntax-table)
  (set-keymap-parent ein:notebook-multilang-mode-map prog-mode-map))

(defun ein:ml-lang-setup (kernelspec)
  (let ((setup-func (intern (concat "ein:ml-lang-setup-" (ein:$kernelspec-language kernelspec)))))
    (if (fboundp setup-func)
        (funcall setup-func)
      (warn "ein:ml-lang-setup: unknown kernelspec language '%s', multilang support disabled."
            (ein:$kernelspec-language kernelspec))
      (ein:ml-lang-setup-generic))))

;; (defun ein:ml-lang-setup-markdown ()
;;   "Use `markdown-mode-map'.  NOTE: This function is not used now."
;;   (when (featurep 'markdown-mode)
;;     (set-keymap-parent ein:notebook-multilang-mode-map markdown-mode-map)))

;;; yasnippet

(defvar ein:ml-yasnippet-parents '(python-mode markdown-mode)
  "Parent modes for `ein:notebook-multilang-mode' to register in yasnippet.")

(defun ein:ml-setup-yasnippet ()
  (cl-loop for define-parents in '(yas/define-parents
                                   yas--define-parents)
    when (fboundp define-parents)
    do (ignore-errors
         ;; `let' is for workaround the bug in yasnippet
         (let ((mode-sym 'ein:notebook-multilang-mode))
           (funcall define-parents
                    mode-sym
                    ein:ml-yasnippet-parents)))))

(eval-after-load "yasnippet" '(ein:ml-setup-yasnippet))

;;; Imenu Support

;; Most of this is borrowed from python.el
;; Just replace python with ein in most cases.

(defvar ein:imenu-format-item-label-function
  'ein:imenu-format-item-label
  "Imenu function used to format an item label.
It must be a function with two arguments: TYPE and NAME.")

(defvar ein:imenu-format-parent-item-label-function
  'ein:imenu-format-parent-item-label
  "Imenu function used to format a parent item label.
It must be a function with two arguments: TYPE and NAME.")

(defvar ein:imenu-format-parent-item-jump-label-function
  'ein:imenu-format-parent-item-jump-label
  "Imenu function used to format a parent jump item label.
It must be a function with two arguments: TYPE and NAME.")

(defun ein:imenu-format-item-label (type name)
  "Return Imenu label for single node using TYPE and NAME."
  (format "%s (%s)" name type))

(defun ein:imenu-format-parent-item-label (type name)
  "Return Imenu label for parent node using TYPE and NAME."
  (format "%s..." (ein:imenu-format-item-label type name)))

(defun python-imenu-format-parent-item-jump-label (type _name)
  "Return Imenu label for parent node jump using TYPE and NAME."
  (if (string= type "class")
      "*class definition*"
    "*function definition*"))

(defun ein:imenu--put-parent (type name pos tree)
  "Add the parent with TYPE, NAME and POS to TREE."
  (let ((label
         (funcall ein:imenu-format-item-label-function type name))
        (jump-label
         (funcall ein:imenu-format-parent-item-jump-label-function type name)))
    (if (not tree)
        (cons label pos)
      (cons label (cons (cons jump-label pos) tree)))))

(defun ein:imenu--build-tree (&optional min-indent prev-indent tree)
  "Recursively build the tree of nested definitions of a node.
Arguments MIN-INDENT, PREV-INDENT and TREE are internal and should
not be passed explicitly unless you know what you are doing."
  (setq min-indent (or min-indent 0)
        prev-indent (or prev-indent python-indent-offset))
  (let* ((pos (python-nav-backward-defun))
         (type)
         (name (when (and pos (looking-at python-nav-beginning-of-defun-regexp))
                 (let ((split (split-string (match-string-no-properties 0))))
                   (setq type (car split))
                   (cadr split))))
         (label (when name
                  (funcall ein:imenu-format-item-label-function type name)))
         (indent (current-indentation))
         (children-indent-limit (+ python-indent-offset min-indent)))
    (cond ((not pos)
           ;; Nothing found, probably near to bobp.
           nil)
          ((<= indent min-indent)
           ;; The current indentation points that this is a parent
           ;; node, add it to the tree and stop recursing.
           (ein:imenu--put-parent type name pos tree))
          (t
           (ein:imenu--build-tree
            min-indent
            indent
            (if (<= indent children-indent-limit)
                ;; This lies within the children indent offset range,
                ;; so it's a normal child of its parent (i.e., not
                ;; a child of a child).
                (cons (cons label pos) tree)
              ;; Oh no, a child of a child?!  Fear not, we
              ;; know how to roll.  We recursively parse these by
              ;; swapping prev-indent and min-indent plus adding this
              ;; newly found item to a fresh subtree.  This works, I
              ;; promise.
              (cons
               (ein:imenu--build-tree
                prev-indent indent (list (cons label pos)))
               tree)))))))

(defun ein:imenu-create-index ()
  "Return tree Imenu alist for the current Python buffer.
Change `ein:imenu-format-item-label-function',
`ein:imenu-format-parent-item-label-function',
`ein:imenu-format-parent-item-jump-label-function' to
customize how labels are formatted."
  (goto-char (point-max))
  (let ((index)
        (tree))
    (while (setq tree (ein:imenu--build-tree))
      (setq index (cons tree index)))
    index))

(defun ein:imenu-create-flat-index (&optional alist prefix)
  "Return flat outline of the current Python buffer for Imenu.
Optional argument ALIST is the tree to be flattened; when nil
`ein:imenu-build-index' is used with
`ein:imenu-format-parent-item-jump-label-function'
`ein:imenu-format-parent-item-label-function'
`ein:imenu-format-item-label-function' set to
  (lambda (type name) name)
Optional argument PREFIX is used in recursive calls and should
not be passed explicitly.

Converts this:

    ((\"Foo\" . 103)
     (\"Bar\" . 138)
     (\"decorator\"
      (\"decorator\" . 173)
      (\"wrap\"
       (\"wrap\" . 353)
       (\"wrapped_f\" . 393))))

To this:

    ((\"Foo\" . 103)
     (\"Bar\" . 138)
     (\"decorator\" . 173)
     (\"decorator.wrap\" . 353)
     (\"decorator.wrapped_f\" . 393))"
  ;; Inspired by imenu--flatten-index-alist removed in revno 21853.
  (apply
   'nconc
   (mapcar
    (lambda (item)
      (let ((name (if prefix
                      (concat prefix "." (car item))
                    (car item)))
            (pos (cdr item)))
        (cond ((or (numberp pos) (markerp pos))
               (list (cons name pos)))
              ((listp pos)
               (cons
                (cons name (cdar pos))
                (python-imenu-create-flat-index (cddr item) name))))))
    (or alist
        (let* ((fn (lambda (_type name) name))
               (ein:imenu-format-item-label-function fn)
              (ein:imenu-format-parent-item-label-function fn)
              (ein:imenu-format-parent-item-jump-label-function fn))
          (python-imenu-create-index))))))


(provide 'ein-multilang)

;;; ein-multilang.el ends here