dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-eldoc.el (7978B)


      1 ;;; org-eldoc.el --- display org header and src block info using eldoc -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (c) 2014-2021 Free Software Foundation, Inc.
      4 
      5 ;; Author: Łukasz Gruner <lukasz@gruner.lu>
      6 ;; Maintainer: Łukasz Gruner <lukasz@gruner.lu>
      7 ;; Version: 6
      8 ;; Package-Requires: ((org "8"))
      9 ;; Homepage: https://git.sr.ht/~bzg/org-contrib
     10 ;; Created: 25/05/2014
     11 ;; Keywords: eldoc, outline, breadcrumb, org, babel, minibuffer
     12 
     13 ;; This file is not part of Emacs.
     14 
     15 ;; GNU Emacs is free software: you can redistribute it and/or modify
     16 ;; it under the terms of the GNU General Public License as published by
     17 ;; the Free Software Foundation, either version 3 of the License, or
     18 ;; (at your option) any later version.
     19 
     20 ;; GNU Emacs is distributed in the hope that it will be useful,
     21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     23 ;; GNU General Public License for more details.
     24 
     25 ;; You should have received a copy of the GNU General Public License
     26 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     27 
     28 ;;; Commentary:
     29 
     30 ;;; Changelog:
     31 
     32 ;; As of 01/11/14 switching license to GPL3 to allow submission to org-mode.
     33 ;; 08/11/14 switch code to automatically define eldoc-documentation-function, but don't autostart eldoc-mode.
     34 
     35 ;;; Code:
     36 
     37 (require 'org)
     38 (require 'ob-core)
     39 (require 'eldoc)
     40 
     41 (declare-function org-element-at-point "org-element" ())
     42 (declare-function org-element-property "org-element" (property element))
     43 (declare-function org-element-type "org-element" (element))
     44 
     45 (defgroup org-eldoc nil "" :group 'org)
     46 
     47 (defcustom org-eldoc-breadcrumb-separator "/"
     48   "Breadcrumb separator."
     49   :group 'org-eldoc
     50   :type 'string)
     51 
     52 (defcustom org-eldoc-test-buffer-name " *Org-eldoc test buffer*"
     53   "Name of the buffer used while testing for mode-local variable values."
     54   :group 'org-eldoc
     55   :type 'string)
     56 
     57 (defun org-eldoc-get-breadcrumb ()
     58   "Return breadcrumb if on a headline or nil."
     59   (let ((case-fold-search t) cur)
     60     (save-excursion
     61       (beginning-of-line)
     62       (save-match-data
     63         (when (looking-at org-complex-heading-regexp)
     64           (setq cur (match-string 4))
     65           (org-format-outline-path
     66            (append (org-get-outline-path) (list cur))
     67            (frame-width) "" org-eldoc-breadcrumb-separator))))))
     68 
     69 (defun org-eldoc-get-src-header ()
     70   "Returns lang and list of header properties if on src definition line and nil otherwise."
     71   (let ((case-fold-search t) info lang hdr-args)
     72     (save-excursion
     73       (beginning-of-line)
     74       (save-match-data
     75         (when (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_src")
     76           (setq info (org-babel-get-src-block-info 'light)
     77                 lang (propertize (or (nth 0 info) "no lang") 'face 'font-lock-string-face)
     78                 hdr-args (nth 2 info))
     79           (concat
     80            lang
     81            ": "
     82            (mapconcat
     83             (lambda (elem)
     84               (when-let* ((val (and (cdr elem)
     85                                     (format "%s" (cdr elem))))
     86                           (_ (not (string-empty-p val))))
     87                 (concat
     88                  (propertize (symbol-name (car elem)) 'face 'org-list-dt)
     89                  " "
     90                  (propertize val 'face 'org-verbatim)
     91                  " ")))
     92             hdr-args " ")))))))
     93 
     94 (defun org-eldoc-get-src-lang ()
     95   "Return value of lang for the current block if in block body and nil otherwise."
     96   (let ((element (save-match-data (org-element-at-point))))
     97     (and (eq (org-element-type element) 'src-block)
     98 	 (>= (line-beginning-position)
     99 	     (org-element-property :post-affiliated element))
    100 	 (<=
    101 	  (line-end-position)
    102 	  (org-with-wide-buffer
    103 	   (goto-char (org-element-property :end element))
    104 	   (skip-chars-backward " \t\n")
    105 	   (line-end-position)))
    106 	 (org-element-property :language element))))
    107 
    108 (defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal)
    109   "Cache of major-mode's eldoc-documentation-functions,
    110  used by \\[org-eldoc-get-mode-local-documentation-function].")
    111 
    112 (defun org-eldoc-get-mode-local-documentation-function (lang)
    113   "Check if LANG-mode sets eldoc-documentation-function and return its value."
    114   (let ((cached-func (gethash lang org-eldoc-local-functions-cache 'empty))
    115         (mode-func (org-src-get-lang-mode lang))
    116         doc-func)
    117     (if (eq 'empty cached-func)
    118         (when (fboundp mode-func)
    119 	  (with-temp-buffer
    120 	    (funcall mode-func)
    121 	    (setq doc-func (if (boundp 'eldoc-documentation-functions)
    122 			       (let ((doc-funs eldoc-documentation-functions))
    123 				 (lambda (callback)
    124 				   (let ((eldoc-documentation-functions doc-funs))
    125 				     (run-hook-with-args-until-success
    126 				      'eldoc-documentation-functions
    127 				      callback))))
    128 			     (and eldoc-documentation-function
    129 				  (symbol-value 'eldoc-documentation-function))))
    130 	    (puthash lang doc-func org-eldoc-local-functions-cache))
    131           doc-func)
    132       cached-func)))
    133 
    134 (declare-function c-eldoc-print-current-symbol-info "c-eldoc" ())
    135 (declare-function css-eldoc-function "css-eldoc" ())
    136 (declare-function php-eldoc-function "php-eldoc" ())
    137 (declare-function go-eldoc--documentation-function "go-eldoc" ())
    138 
    139 (defun org-eldoc-documentation-function (&rest args)
    140   "Return breadcrumbs when on a headline, args for src block header-line,
    141   calls other documentation functions depending on lang when inside src body."
    142   (or
    143    (org-eldoc-get-breadcrumb)
    144    (org-eldoc-get-src-header)
    145    (let ((lang (org-eldoc-get-src-lang)))
    146      (cond
    147       ((string= lang "org")       ;Prevent inf-loop for Org src blocks
    148        nil)
    149       ((or
    150         (string= lang "emacs-lisp")
    151         (string= lang "elisp"))
    152        (cond ((and (boundp 'eldoc-documentation-functions) ; Emacs>=28
    153                    (fboundp 'elisp-eldoc-var-docstring)
    154                    (fboundp 'elisp-eldoc-funcall))
    155               (let ((eldoc-documentation-functions
    156                      '(elisp-eldoc-var-docstring elisp-eldoc-funcall)))
    157                 (eldoc-print-current-symbol-info)))
    158              ((fboundp 'elisp-eldoc-documentation-function)
    159               (elisp-eldoc-documentation-function))
    160              (t            ; Emacs<25
    161               (let (eldoc-documentation-function)
    162                 (eldoc-print-current-symbol-info)))))
    163       ((or
    164         (string= lang "c") ;; https://github.com/nflath/c-eldoc
    165         (string= lang "C"))
    166        (when (require 'c-eldoc nil t)
    167          (c-eldoc-print-current-symbol-info)))
    168       ;; https://github.com/zenozeng/css-eldoc
    169       ((string= lang "css") (when (require 'css-eldoc nil t)
    170                               (css-eldoc-function)))
    171       ;; https://github.com/zenozeng/php-eldoc
    172       ((string= lang "php") (when (require 'php-eldoc nil t)
    173                               (php-eldoc-function)))
    174       ((or
    175         (string= lang "go")
    176         (string= lang "golang"))
    177        (when (require 'go-eldoc nil t)
    178          (go-eldoc--documentation-function)))
    179       (t
    180        (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang))
    181              (callback (car args)))
    182          (when (functionp doc-fun)
    183            (if (functionp callback)
    184                (funcall doc-fun callback)
    185              (funcall doc-fun)))))))))
    186 
    187 ;;;###autoload
    188 (defun org-eldoc-load ()
    189   "Set up org-eldoc documentation function."
    190   (interactive)
    191   ;; This approach is taken from python.el.
    192   (with-no-warnings
    193     (cond
    194      ((null eldoc-documentation-function) ; Emacs<25
    195       (setq-local eldoc-documentation-function
    196 		  #'org-eldoc-documentation-function))
    197      ((boundp 'eldoc-documentation-functions) ; Emacs>=28
    198       (add-hook 'eldoc-documentation-functions
    199 		#'org-eldoc-documentation-function nil t))
    200      (t
    201       (add-function :before-until (local 'eldoc-documentation-function)
    202 		    #'org-eldoc-documentation-function)))))
    203 
    204 ;;;###autoload
    205 (add-hook 'org-mode-hook #'org-eldoc-load)
    206 
    207 (provide 'org-eldoc)
    208 
    209 ;; -*- coding: utf-8-emacs; -*-
    210 
    211 ;;; org-eldoc.el ends here