;;; sclang-language.el --- IDE for working with SuperCollider -*- coding: utf-8;
;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>

;;; License:

;; 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 of the
;; License, 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:
;; Utilities for SuperCollider syntax

(require 'cl-lib)
(require 'sclang-browser)
(require 'sclang-interp)
(require 'sclang-util)

;; ===================================================================
;; regexp utilities
;; ===================================================================

;;; Code:

(defun sclang-regexp-group (regexp &optional addressable)
  "Enclose REGEXP in grouping parentheses.

If ADDRESSABLE is non-nil the group match data can be addressed
separately after matching."
  (concat "\\(" (unless addressable "?:") regexp "\\)"))

(defun sclang-regexp-concat (&rest regexps)
  "Concatenate REGEXPS by grouping.

The expressions are joined as alternatives with the \\| operator."
  (mapconcat 'sclang-regexp-group regexps "\\|"))

;; ===================================================================
;; some useful regular expressions
;; ===================================================================

(defconst sclang-symbol-regexp
  "\\(?:\\sw\\|\\s_\\)*"
  "Regular expression matching symbols.")

(defconst sclang-identifier-regexp
  (concat "[a-zA-Z]" sclang-symbol-regexp)
  "Regular expression matching valid identifiers.")

(defconst sclang-method-name-special-chars
  "-!%&*+/<=>?@|"
  "Regular expression matching special method name characters.")

(defconst sclang-method-name-plain-regexp
  (concat sclang-identifier-regexp "_?")
  "Regular expression matching regular method names.")

(defconst sclang-method-name-special-regexp
  (concat
   "[" (regexp-quote sclang-method-name-special-chars) "]+")
  "Regular expression matching method names composed of special characters.")

(defconst sclang-method-name-regexp
  (sclang-regexp-concat
   sclang-method-name-special-regexp
   sclang-method-name-plain-regexp)
  "Regular expression matching method names.")

(defconst sclang-class-name-regexp
  "\\<\\(?:Meta_\\)?[A-Z]\\(?:\\sw\\|\\s_\\)*"
  "Regular expression matching class names.")

(defconst sclang-primitive-name-regexp
  (concat "_[A-Z]" sclang-symbol-regexp)
  "Regular expression matching primitive names.")

(defconst sclang-symbol-name-regexp
  (sclang-regexp-concat
   sclang-method-name-regexp
   sclang-class-name-regexp)
  "Regular expression matching class and method names.")

(defconst sclang-class-definition-regexp
  (concat "^\\s *\\("
          sclang-class-name-regexp
          "\\)\\(?:\\s *:\\s *\\("
          sclang-class-name-regexp
          "\\)\\)?[[:space:]]*{")
  "Regular expression matching class definitions.")

(defconst sclang-method-definition-regexp
  (concat "^\\s *\\*?\\(" sclang-method-name-regexp "\\)\\s *{")
  "Regular expression matching method definitions.")

(defconst sclang-block-regexp
  "^\\((\\)\\s *\\(?:/[/*]?.*\\)?"
  "Regular expression matching the beginning of a code block.

A block is enclosed by parentheses where the opening parenthesis must
be at the beginning of a line to avoid ambiguities.")

(defconst sclang-beginning-of-defun-regexp
  (sclang-regexp-concat
   sclang-class-definition-regexp
   sclang-block-regexp)
  "Regular expression matching the beginning of defuns.

The match is either the start of a class definition
\(`sclang-class-definition-regexp') or the beginning of a code block
enclosed by parenthesis (`sclang-block-regexp').")

(defconst sclang-method-definition-spec-regexp
  (concat (sclang-regexp-group sclang-class-name-regexp t)
          "-"
          (sclang-regexp-group sclang-method-name-regexp t))
  "Regular expression matching definition specifications.

A specification is of the form <class-name>-<method-name>.")

;; ===================================================================
;; regexp building
;; ===================================================================

(defun sclang-make-class-definition-regexp (name)
  "Return a regular expression matching the class definition NAME."
  (concat "\\(" (regexp-quote name) "\\)"
          "\\(?:\\s *:\\s *\\(" sclang-class-name-regexp "\\)\\)?"
          "[[:space:]]*{"))

(defun sclang-make-class-extension-regexp (name)
  "Return a regular expression matching the class extension NAME."
  (concat "\\+\\s *\\(" (regexp-quote name) "\\)"
          "\\s *{"))

(defun sclang-make-method-definition-regexp (name)
  "Return a regular expression matching the method definition NAME."
  (concat "\\(" (regexp-quote name) "\\)\\s *{"))

;; ===================================================================
;; string matching
;; ===================================================================

(defun sclang-string-match (regexp string)
  "Match REGEXP with STRING while preserving case."
  (let ((case-fold-search nil))
    (string-match regexp string)))

(defun sclang-symbol-match (symbol-regexp string)
  "Match SYMBOL-REGEXP in STRING."
  (sclang-string-match (concat "^" symbol-regexp "$") string))

;; ===================================================================
;; symbol name predicates
;; ===================================================================

(defun sclang-class-name-p (string)
  "Is STRING an sclang class name?"
  (sclang-symbol-match sclang-class-name-regexp string))

(defun sclang-meta-class-name-p (string)
  "Is STRING an sclang meta class name?"
  (and (sclang-class-name-p string)
       (sclang-string-match "^Meta_" string)))

(defun sclang-method-name-p (string)
  "Is STRING an sclang method name?"
  (sclang-symbol-match sclang-method-name-regexp string))

(defun sclang-symbol-name-p (string)
  "Is STRING an sclang symbol name?"
  (sclang-symbol-match sclang-symbol-name-regexp string))

(defun sclang-method-name-setter-p (method-name)
  "Is METHOD-NAME an sclang method name setter?"
  (string-match "_$" method-name))

(defun sclang-method-name-getter-p (method-name)
  "Is METHOD-NAME an sclang method name getter?"
  (not (sclang-method-name-setter-p method-name)))

;; ===================================================================
;; symbol name manipulation
;; ===================================================================

(defun sclang-method-name-setter (method-name)
  "Return a method name setter for METHOD-NAME."
  (if (sclang-method-name-setter-p method-name)
      method-name
    (concat method-name "_")))

(defun sclang-method-name-getter (method-name)
  "Return a method name getter for METHOD-NAME."
  (if (sclang-method-name-setter-p method-name)
      (substring method-name 0 (1- (length method-name)))
    method-name))

;; ===================================================================
;; symbol table access
;; ===================================================================

(defcustom sclang-use-symbol-table t
  "*Retrieve symbol table upon library initialization.

Symbol table retrieval is performed each time the library is
recompiled.  This takes some time and the symbol table has to be held
in memory, so it might be necessary to disable this option on
low-resource systems."
  :group 'sclang-interface
  :version "21.3"
  :type 'boolean)

(defvar sclang-symbol-table nil
  "List of all defined symbols.")

(defvar sclang-class-list nil
  "List of all defined classes.")

(defvar sclang-symbol-history nil
  "List of recent symbols read from the minibuffer.")

(defvar sclang-symbol-table-file nil)

(sclang-set-command-handler
 'symbolTable
 (lambda (arg)
   (when (and sclang-use-symbol-table arg)
     (setq sclang-symbol-table (sort arg 'string-lessp))
     (setq sclang-class-list (cl-remove-if
                              (lambda (x) (or (not (sclang-class-name-p x))
                                              (sclang-string-match "^Meta_" x)))
                              sclang-symbol-table))
     (sclang-update-font-lock))))

(add-hook 'sclang-library-startup-hook
          (lambda ()
            (when sclang-use-symbol-table
              (let ((file (make-temp-file "sclang-symbol-table.")))
                (when (and file (file-exists-p file))
                  (setq sclang-symbol-table-file file)
                  (sclang-perform-command 'symbolTable file))))))

(add-hook 'sclang-library-shutdown-hook
          (lambda ()
            (setq sclang-symbol-table nil)
            (sclang-update-font-lock)))

(defun sclang-get-symbol-completion-table ()
  "Get symbol completion table."
  (mapcar (lambda (s) (cons s nil)) sclang-symbol-table))

(defun sclang-make-symbol-completion-predicate (predicate)
  "Make symbol completion PREDICATE."
  (and predicate (lambda (assoc) (funcall predicate (car assoc)))))

(defun sclang-get-symbol (string)
  "Get symbol named STRING."
  (if (and sclang-use-symbol-table sclang-symbol-table)
      (car (member string sclang-symbol-table))
    string))

(defun sclang-read-symbol (prompt &optional default predicate require-match inherit-input-method)
"Read symbol PROMPT (options DEFAULT PREDICATE REQUIRE-MATCH and INHERIT-INPUT-METHOD)."
  (if sclang-use-symbol-table
      (cl-flet ((make-minibuffer-local-map
                  (parent-keymap)
                  (let ((map (make-sparse-keymap)))
                    (set-keymap-parent map parent-keymap)
                    ;; override keys bound to valid symbols
                    (define-key map [??] 'self-insert-command)
                    map)))
        (let ((symbol (sclang-get-symbol default))
              (minibuffer-local-completion-map (make-minibuffer-local-map
                                                minibuffer-local-completion-map))
              (minibuffer-local-must-match-map (make-minibuffer-local-map
                                                minibuffer-local-completion-map)))
          (completing-read (sclang-make-prompt-string prompt symbol)
                           (sclang-get-symbol-completion-table)
                           (sclang-make-symbol-completion-predicate predicate)
                           require-match nil
                           'sclang-symbol-history symbol
                           inherit-input-method)))
    (read-string (sclang-make-prompt-string prompt default) nil
                 'sclang-symbol-history default inherit-input-method)))

;; ===================================================================
;; buffer movement
;; ===================================================================

(defun sclang-point-in-comment-p ()
  "Return non-nil if point is inside a comment."
  (if (and (boundp 'font-lock-mode) (eval 'font-lock-mode))
      ;; use available information in font-lock-mode
      (eq (get-text-property (point) 'face) 'font-lock-comment-face)
    ;; else parse from the beginning
    (save-excursion
      (let ((beg (point)))
        (beginning-of-defun)
        (not (null (nth 4 (parse-partial-sexp (point) beg))))))))

(defun sclang-beginning-of-defun (&optional arg)
  "Move to beginning of function (optionally ARG)."
  (interactive "p")
  (let ((case-fold-search nil)
        (arg (or arg (prefix-numeric-value current-prefix-arg)))
        (orig (point))
        (success t))
    (while (and success (> arg 0))
      (setq success (re-search-backward sclang-beginning-of-defun-regexp
                                        nil 'move))
      (when (and success (not (sclang-point-in-comment-p)))
        (goto-char (match-beginning 0))
        (setq arg (1- arg))))
    (while (and success (< arg 0))
      (setq success (re-search-forward sclang-beginning-of-defun-regexp nil t))
      (when (and success (not (sclang-point-in-comment-p)))
        (goto-char (match-end 0))
        (setq arg (1+ arg))))
    (when success
      (beginning-of-line)
      (cond ((looking-at sclang-block-regexp) (goto-char (1- (match-end 1))))
            ((looking-at sclang-class-definition-regexp) (goto-char (1- (match-end 0)))))
      t)))

(defun sclang-point-in-defun-p ()
  "Return non-nil if point is inside a defun.
Return value is nil or (beg end) of defun."
  (save-excursion
    (let ((orig (point))
          beg end)
      (and (progn (end-of-line) (beginning-of-defun-raw 1) t)
           (setq beg (point))
           (condition-case nil (forward-list 1) (error nil))
           (setq end (point))
           (list beg end)))))

(defun sclang-end-of-defun (&optional arg)
  "Move to end of function (optionally ARG)."
  (interactive "p")
  (let ((case-fold-search nil)
        (arg (or arg (prefix-numeric-value current-prefix-arg)))
        (success t)
        n cur)
    (while (and success (> arg 0))
      (setq n (if (sclang-point-in-defun-p) 1 -1))
      (setq cur (point))
      (if (and (sclang-beginning-of-defun n)
               (condition-case nil (forward-list 1) (error nil)))
          (progn
            (setq arg (1- arg)))
        (goto-char cur)
        (setq success nil)))
    (while (and success (< arg 0))
      (setq n (if (sclang-point-in-defun-p) 2 1))
      (setq cur (point))
      (if (and (sclang-beginning-of-defun n)
               (condition-case nil (forward-list 1) (error nil)))
          (progn
            (backward-char 1)
            (setq arg (1+ arg)))
        (goto-char cur)
        (setq success nil)))
    (when success
      (forward-line 1) t)))

;; ===================================================================
;; buffer object access
;; ===================================================================

(defun sclang-symbol-at-point (&optional symbol-name-regexp)
  "Return the symbol at point, or nil if not a valid symbol.

The argument SYMBOL-NAME-REGEXP can be used to specify the type of
symbol matched, candidates are `sclang-symbol-name-regexp' and
`sclang-primitive-name-regexp', the default is
`sclang-symbol-name-regexp'."
  (save-excursion
    (with-syntax-table sclang-mode-syntax-table
      (let ((case-fold-search nil)
            beg end)
        (cond ((looking-at sclang-method-name-special-regexp)
               (skip-chars-backward sclang-method-name-special-chars)
               (setq beg (point))
               (skip-chars-forward sclang-method-name-special-chars)
               (setq end (point)))
              (t
               (skip-syntax-backward "w_")
               (setq beg (point))
               (skip-syntax-forward "w_")
               (setq end (point))))
        (goto-char beg)
        (if (looking-at (or symbol-name-regexp sclang-symbol-name-regexp))
            (buffer-substring-no-properties beg end))))))

(defun sclang-line-at-point ()
  "Return the line at point."
  (buffer-substring-no-properties (line-beginning-position) (line-end-position)))

(defun sclang-defun-at-point ()
  "Return the defun at point.

A defun may either be a class definition or a code block, see
`sclang-beginning-of-defun-regexp'."
  (save-excursion
    (with-syntax-table sclang-mode-syntax-table
      (cl-multiple-value-bind (beg end) (sclang-point-in-defun-p)
        (and beg end (buffer-substring-no-properties beg end))))))

;; ===================================================================
;; symbol completion
;; ===================================================================

(defun sclang-complete-symbol (&optional predicate)
  "Perform completion on symbol preceding point.
Compare that symbol against the known symbols.

When called from a program, optional arg PREDICATE is a predicate
determining which symbols are considered.
If PREDICATE is nil, the context determines which symbols are
considered.  If the symbol starts with an upper case letter,
class name completion is performed, otherwise only selector names
are considered."
  (interactive)
  (let* ((buffer (current-buffer))
         (end (point))
         (beg (save-excursion
                (backward-sexp 1)
                (skip-syntax-forward "'")
                (point)))
         (pattern (buffer-substring-no-properties beg end))
         (case-fold-search nil)
         (table (sclang-get-symbol-completion-table))
         (predicate (or predicate
                        (if (sclang-class-name-p pattern)
                            'sclang-class-name-p
                          'sclang-method-name-p)))
         (completion (try-completion pattern table (lambda (assoc) (funcall predicate (car assoc))))))
    (cond ((eq completion t))
          ((null completion)
           (sclang-message "Can't find completion for '%s'" pattern)
           (ding))
          ((not (string= pattern completion))
           (delete-region beg end)
           (insert completion))
          (t
           (sclang-message "Making completion list...")
           (let* ((list (all-completions pattern table (lambda (assoc) (funcall predicate (car assoc)))))
                  (win (selected-window))
                  (buffer-name (sclang-make-buffer-name "Completions"))
                  (same-window-buffer-names (list buffer-name)))
             (setq list (sort list 'string<))
             (with-sclang-browser
              buffer-name
              (add-hook 'sclang-browser-show-hook (lambda () (sclang-browser-next-link)))
              (setq sclang-browser-link-function
                    (lambda (arg)
                      (sclang-browser-quit)
                      (with-current-buffer (car arg)
                        (delete-region (car (cdr arg)) (point))
                        (insert (cdr (cdr arg))))))
              ;; (setq view-exit-action 'kill-buffer)
              (insert (format "Completions for '%s':\n\n" pattern))
              (dolist (x list)
                (insert (sclang-browser-make-link x (cons buffer (cons beg x))))
                (insert " \n"))))
           (sclang-message "Making completion list...%s" "done")))))

(defun sclang-completion-at-point ()
  "Function used for `completion-at-point-functions' in `sclang-mode'."
  (let* ((end (point))
         (beg (save-excursion
                (backward-sexp 1)
                (skip-syntax-forward "'")
                (point)))
         (pattern (buffer-substring-no-properties beg end))
         (case-fold-search nil)
         (predicate (if (sclang-class-name-p pattern)
                        #'sclang-class-name-p
                      #'sclang-method-name-p)))
    (list beg
          end
          (all-completions pattern sclang-symbol-table predicate)
          :exclusive 'no
          :company-docsig #'identity)))

;; ===================================================================
;; introspection
;; ===================================================================

(defcustom sclang-definition-marker-ring-length 32
  "*Length of marker ring `sclang-definition-marker-ring'."
  :group 'sclang-interface
  :version "21.3"
  :type 'integer)

(defvar sclang-definition-marker-ring
  (make-ring sclang-definition-marker-ring-length)
  "Ring of markers which are locations from which \\[sclang-find-definitions] was invoked.")

;; really do that?
(add-hook 'sclang-library-startup-hook
          (lambda ()
            (setq sclang-definition-marker-ring
                  (make-ring sclang-definition-marker-ring-length))))

(defun sclang-open-definition (name file pos &optional pos-func)
  "Open definition NAME in FILE at POS (optionally POS-FUNC)."
  (let ((buffer (find-file file)))
    (when (bufferp buffer)
      (with-current-buffer buffer
        (goto-char (or pos (point-min)))
        (when (and nil (functionp pos-func))
          (let ((pos (funcall pos-func name)))
            (and pos (goto-char pos))))))
    buffer))

(defun sclang-pop-definition-mark ()
  "Pop back to where \\[sclang-find-definition] or \\[sclang-find-reference] was last invoked."
  (interactive)
  (unless (ring-empty-p sclang-definition-marker-ring)
    (let ((marker (ring-remove sclang-definition-marker-ring 0)))
      (switch-to-buffer (or (marker-buffer marker)
                            (error "The marked buffer has been deleted")))
      (goto-char (marker-position marker))
      (set-marker marker nil nil))))

(defun sclang-browse-definitions (name definitions buffer-name header &optional pos-func)
  "Browse definitions.  NAME DEFINITIONS BUFFER-NAME HEADER (optionally POS-FUNC)."
  (if (cdr definitions)
      (let ((same-window-buffer-names (list buffer-name)))
        (with-sclang-browser
         buffer-name
         ;; (setq view-exit-action 'kill-buffer)
         (setq sclang-browser-link-function
               (lambda (data)
                 (sclang-browser-quit)
                 (apply 'sclang-open-definition data)))
         (add-hook 'sclang-browser-show-hook (lambda () (sclang-browser-next-link)))
         (insert header)
         (insert "\n")
         (let ((max-width 0)
               format-string)
           (dolist (def definitions)
             (setq max-width (max (length (file-name-nondirectory (nth 1 def))) max-width)))
           (setq format-string (format "%%-%ds  %%s" max-width))
           (dolist (def definitions)
             (let ((string (format format-string
                                   (propertize (file-name-nondirectory (nth 1 def)) 'face 'bold)
                                   (nth 0 def)))
                   (data (list name (nth 1 def) (nth 2 def) pos-func)))
               (insert (sclang-browser-make-link string data))
               (insert "\n"))))))
    ;; single definition: jump directly
    (let ((def (car definitions)))
      (sclang-open-definition name (nth 1 def) (nth 2 def) pos-func))))

(defun sclang-find-definitions (name)
  "Find all definitions of symbol NAME."
  (interactive
   (list
    (if current-prefix-arg
        (read-string "Find definition: ")
      (sclang-read-symbol "Find definitions of: "
                          (sclang-symbol-at-point) nil t))))
  (if (sclang-symbol-match sclang-method-definition-spec-regexp name)
      (sclang-perform-command 'openDefinition name)
    (if (sclang-get-symbol name)
        (progn
          (ring-insert sclang-definition-marker-ring (point-marker))
          (if (sclang-class-name-p name)
              (sclang-perform-command 'classDefinitions name)
            (sclang-perform-command 'methodDefinitions name)))
      (sclang-message "'%s' is undefined" name))))

(sclang-set-command-handler
 'openDefinition
 (lambda (assoc)
   (let ((name (car assoc))
         (data (cdr assoc)))
     (if data
         (sclang-open-definition nil (car data) (cadr data))
       (sclang-message "'%s' is undefined" name)))))

(sclang-set-command-handler
 'classDefinitions
 (lambda (assoc)
   (let ((name (car assoc))
         (data (cdr assoc)))
     (if data
         (sclang-browse-definitions
          name data
          "*Definitions*" (format "Definitions of '%s'\n" name)
          (lambda (name)
            (let ((case-fold-search nil))
              ;; point is either
              ;;  - at a class definition
              ;;  - inside a class extension
              ;; so jump to the class name
              (when (or (looking-at (sclang-make-class-definition-regexp name))
                        (re-search-backward (sclang-make-class-extension-regexp name) nil t))
                (match-beginning 1)))))
       (sclang-message "No definitions of '%s'" name)))))

(sclang-set-command-handler
 'methodDefinitions
 (lambda (assoc)
   (let ((name (car assoc))
         (data (cdr assoc)))
     (if data
         (sclang-browse-definitions
          name data
          "*Definitions*" (format "Definitions of '%s'\n" name)
          (lambda (name)
            (let ((case-fold-search nil))
              (when (re-search-forward (sclang-make-method-definition-regexp name))
                (match-beginning 1)))))
       (sclang-message "No definitions of '%s'" name)))))

(defun sclang-find-references (name)
  "Find all references to symbol NAME."
  (interactive
   (list
    (sclang-read-symbol "Find references to: "
                        (sclang-symbol-at-point) nil t)))
  (if (sclang-get-symbol name)
      (progn
        (ring-insert sclang-definition-marker-ring (point-marker))
        (sclang-perform-command 'methodReferences name))
    (sclang-message "'%s' is undefined" name)))

(sclang-set-command-handler
 'methodReferences
 (lambda (assoc)
   (let ((name (car assoc))
         (data (cdr assoc)))
     (if data
         (sclang-browse-definitions
          name data
          "*References*" (format "References to '%s'\n" name)
          (lambda (name)
            (let ((case-fold-search nil))
              (when (re-search-forward (regexp-quote name))
                (match-beginning 0)))))
       (sclang-message "No references to '%s'" name)))))

(defun sclang-show-method-args ()
  "Show method args."
  (interactive)
  (let ((regexp (concat
                 sclang-class-name-regexp
                 "[ \t\n]*\\(?:\\.[ \t\n]*\\("
                 sclang-method-name-regexp
                 "\\)\\)?[ \t\n]*("))
        (case-fold-search nil)
        (beg (point)))
    (save-excursion
      (while (and (re-search-backward regexp nil t)
                  (let ((class (save-match-data (sclang-get-symbol (sclang-symbol-at-point)))))
                    (goto-char (1- (match-end 0)))
                    (if (condition-case nil
                            (save-excursion
                              (forward-list 1)
                              (> (point) beg))
                          (error t))
                        (let ((method (sclang-get-symbol (or (match-string-no-properties 1) "new"))))
                          (and class method
                               (sclang-perform-command 'methodArgs class method)
                               nil))
                      (goto-char (match-beginning 0)) t)))))))

(sclang-set-command-handler
 'methodArgs
 (lambda (args)
   (and args (message "%s" args))))

(defun sclang-dump-full-interface (class)
  "Dump interface of CLASS."
  (interactive
   (list
    (let* ((symbol (sclang-symbol-at-point))
           (class (and (sclang-get-symbol symbol)
                       (sclang-class-name-p symbol)
                       symbol)))
      (sclang-read-symbol "Dump interface of: "
                          class 'sclang-class-name-p t))))
  (sclang-eval-string (format "%s.dumpFullInterface" class)))

(defun sclang-dump-interface (class)
  "Dump interface of CLASS."
  (interactive
   (list
    (let* ((symbol (sclang-symbol-at-point))
           (class (and (sclang-get-symbol symbol)
                       (sclang-class-name-p symbol)
                       symbol)))
      (sclang-read-symbol "Dump interface of: "
                          class 'sclang-class-name-p t))))
  (sclang-eval-string (format "%s.dumpInterface" class)))

;; ===================================================================
;; cscope interface
;; ===================================================================

(defcustom sclang-source-directory nil
  "Toplevel SuperCollider source directory.

This variable is used by `sclang-find-primitive' to locate the cscope
database."
  :group 'sclang-interface
  :version "21.4.1"
  :type 'directory
  :options '(must-match))

(defun sclang-find-primitive (name)
  "Find primitive NAME in a cscope database.

The database is searched in `sclang-source-directory', or the
current-directory, iff `sclang-source-directoy' is nil."
  (interactive
   (let ((default (sclang-symbol-at-point sclang-primitive-name-regexp)))
     (list (read-string (sclang-make-prompt-string "Find primitive: " default)
                        nil nil default))))
  (if (require 'xcscope nil t)
      (let ((cscope-initial-directory sclang-source-directory))
        ;; only fboundp when xcscope is loaded
        (cscope-find-this-text-string
         (if (string-match "^_" name) name (concat "_" name))))
    (sclang-message "cscope not available")))

;; ===================================================================
;; sc-code formatting
;; ===================================================================

(defun sclang-list-to-string (list)
  "Convert sclang LIST to string."
  (mapconcat 'sclang-object-to-string list ", "))

(defconst sclang-false 'false)

(defun sclang-object-to-string (obj)
  "Convert sclang object OBJ  to string."
  (cond ((null obj)
         "nil")
        ((eq sclang-false obj)
         "false")
        ((eq t obj)
         "true")
        ((symbolp obj)
         (format "'%s'" obj))
        ((listp obj)
         (format "[ %s ]" (sclang-list-to-string obj)))
        (t (format "%S" obj))))

(defun sclang-format (string &rest args)
  "Format STRING using ARGS.
%s - print string
%o - print object
%l - print argument list"
  (let ((case-fold-search nil)
        (i 0))
    (save-match-data
      (while (and (< i (length string))
                  (string-match "%[los%]" string i))
        (let* ((start (car (match-data)))
               (format (aref string (1+ start)))
               (arg (if args
                        (pop args)
                      (error "Not enough arguments for format string")))
               (repl (cond ((eq ?o format)
                            (sclang-object-to-string arg))
                           ((eq ?l format)
                            (if (listp arg)
                                (sclang-list-to-string arg)
                              (sclang-object-to-string arg)))
                           ((eq ?s format)
                            (format "%s" arg))
                           ((eq ?% format)
                            (push arg args)
                            "%"))))
          (setq string (replace-match repl t t string))
          (setq i (+ start (length repl)))))))
  string)

(defun sclang-format-pseq (items)
  "Format ITEMS (a flat list of numbers or symbols) as a possibly nested Pseq.
Looks for all repetitive patterns in ITEMS recursively.  Therefore, it is
computationally expensive, especially when ITEMS is a long list.  If you don't
want smart pattern guessing, use `sclang-format' directly to format your Pseq."
  (cl-labels ((find-reps (items)
                (let (r)
                  (while items
                    (let ((ret (car items))
                          (skip 1)
                          (rep (length items)))
                      (catch 'match-found
                        (while (>= rep 2)
                          (let ((i (/ (length items) rep)))
                            (while (> i 0)
                              (let ((sublst (cl-subseq items 0 i)))
                                (when (catch 'equal
                                        (let ((a items))
                                          (cl-loop repeat rep do
                                                   (let ((b sublst))
                                                     (while b
                                                       (unless (eql (car b) (car a))
                                                         (throw 'equal nil))
                                                       (setq a (cdr a)
                                                             b (cdr b)))))
                                          t))
                                  (setq ret (cons rep (if (> i 5)
                                                          (find-reps sublst)
                                                        sublst))
                                        skip (* i rep))
                                  (throw 'match-found t))
                                (cl-decf i))))
                          (cl-decf rep)))
                      (accept-process-output nil 0 100)
                      ;; invent better progress info
                      (message "Processed...%S" ret)
                      (setq r (append r (list ret))
                            items (nthcdr skip items))))
                  r))
              (elem-to-string (elem)
                (cond
                 ((consp elem)
                  (concat "Pseq([ "
                          (mapconcat #'elem-to-string (cdr elem) ", ")
                          (format " ], %d)" (car elem))))
                 (t (sclang-object-to-string elem)))))
    (let ((compressed (find-reps items)))
      (if (and (= (length compressed) 1) (consp (car compressed)))
          (elem-to-string (car compressed))
        (concat "Pseq([ "
                (mapconcat #'elem-to-string compressed ", ")
                " ], 1)")))))

;; ===================================================================
;; module setup
;; ===================================================================

(provide 'sclang-language)

;;; sclang-language.el ends here