Full Code of idris-hackers/idris-mode for AI

main d32b2396a8ad cached
61 files
449.8 KB
114.2k tokens
1 requests
Download .txt
Showing preview only (471K chars total). Download the full file or copy to clipboard to get everything.
Repository: idris-hackers/idris-mode
Branch: main
Commit: d32b2396a8ad
Files: 61
Total size: 449.8 KB

Directory structure:
gitextract_dxhrkfoy/

├── .github/
│   └── workflows/
│       ├── idris1.yml
│       └── idris2.yml
├── .gitignore
├── .travis.yml
├── .travis_install.sh
├── CHANGES.markdown
├── CONTRIBUTING.md
├── CONTRIBUTORS
├── COPYING
├── Makefile
├── docs/
│   └── documentation.tex
├── flycheck-idris.el
├── idris-commands.el
├── idris-common-utils.el
├── idris-compat.el
├── idris-core.el
├── idris-events.el
├── idris-highlight-input.el
├── idris-hole-list.el
├── idris-info.el
├── idris-ipkg-mode.el
├── idris-keys.el
├── idris-log.el
├── idris-mode.el
├── idris-navigate.el
├── idris-prover.el
├── idris-repl.el
├── idris-settings.el
├── idris-simple-indent.el
├── idris-syntax.el
├── idris-tree-info.el
├── idris-warnings-tree.el
├── idris-warnings.el
├── idris-xref.el
├── inferior-idris.el
├── readme.markdown
└── test/
    ├── idris-commands-test.el
    ├── idris-info-test.el
    ├── idris-navigate-test.el
    ├── idris-repl-test.el
    ├── idris-test-utils.el
    ├── idris-tests.el
    ├── idris-xref-test.el
    └── test-data/
        ├── AddClause.idr
        ├── AddMissing.idr
        ├── CaseSplit.idr
        ├── Empty.idr
        ├── Flycheck.idr
        ├── GenerateDef.idr
        ├── Literate.lidr
        ├── MakeLemma.idr
        ├── MakeWithBlock.idr
        ├── MetavarTest.idr
        ├── ProofSearch.idr
        ├── Refine.idr
        ├── TypeAtPoint.idr
        ├── TypeError.idr
        ├── cmdline/
        │   ├── commandlinetest.ipkg
        │   └── src/
        │       └── Command/
        │           └── Line/
        │               └── Test.idr
        └── package-test/
            ├── Packaging.idr
            └── test.ipkg

================================================
FILE CONTENTS
================================================

================================================
FILE: .github/workflows/idris1.yml
================================================
name: Idris1 on Ubuntu

on:
  push:
    branches:
      - '*'
    tags:
      - '*'
  pull_request:
    branches:
      - main

jobs:
# -- [ Build ]
  build:

# ---- [ Initialise Build Environment ]
    runs-on: ubuntu-latest
    timeout-minutes: 60
    strategy:
      matrix:
        emacs: [30.2]
        idris: [git]
    env:
      EMACS_VERSION: ${{ matrix.emacs }}
      IDRIS_VERSION: ${{ matrix.idris }}

# ---- [ Steps to Run ]
    steps:

# ----- [ Steps Dependencies ]
      - name: Fetch Dependencies
        run: sudo apt install -y libgc-dev libgif-dev libxaw7-dev openssl

# ----- [ Initialise Variables ]

      - name: Initialise variables
        run: |
          mkdir -p $HOME/.local/bin
          echo "$HOME/.local/bin" >> $GITHUB_PATH

# ----- [ Emacs ]

      - name: Fetch Emacs
        uses: purcell/setup-emacs@master
        with:
          version: ${{ matrix.emacs }}

# ----- [ Caches ]

      - name: Cache stack global package-db
        id: stack-global
        uses: actions/cache@v3
        with:
          path: ~/.stack
          key: ${{ runner.os }}-stack-global-${{ matrix.idris }}
          restore-keys: |
            ${{ runner.os }}-stack-global-${{ matrix.idris }}

      - name: Cache stack-installed programs in ~/.local/bin
        id:   stack-programs
        uses: actions/cache@v3
        with:
          path: ~/.local/bin
          key: ${{ runner.os }}-stack-programs-${{ matrix.idris }}
          restore-keys: |
               ${{ runner.os }}-stack-programs-${{ matrix.idris }}

      - name: Cache .stack-work
        uses: actions/cache@v3
        with:
          path: .stack-work
          key: ${{ runner.os }}-stack-work-${{ matrix.idris }}
          restore-keys: |
               ${{ runner.os }}-stack-work-${{ matrix.idris }}


      - name: Cache idris-dev-git/
        if: matrix.idris == 'git'
        id: idris-dev-git
        uses: actions/cache@v3
        with:
          path: ~/idris-dev-git/
          key: ${{ runner.os }}-idris-dev-stack-work-${{ matrix.idris }}
          restore-keys: |
               ${{ runner.os }}-idris-dev-stack-work-${{ matrix.idris }}

# ----- [ Idris from GIT ]
      - name: Install Idris from GIT
        if: matrix.idris == 'git' && steps.idris-dev-git.outputs.cache-hit != 'true'
        run: |
          pushd .
          git clone https://github.com/idris-lang/Idris-dev.git ~/idris-dev-git
          cd ~/idris-dev-git
          stack --no-terminal install --flag idris:-FFI --flag idris:-GMP
          popd
          idris --info

# ----- [ Idris from Stack ]
      - name: Install Idris from Stackage
        if: matrix.idris == 'stackage' && steps.stack-program.outputs.cache-hit != 'true'
        run: |
          stack install --resolver lts-12.26 idris

# ----- [ Checkout and Run]
      - name: Checkout
        uses: actions/checkout@v3

      - name: Run Tests
        run: |
          make clean
          make build
          make test

# -- EOF


================================================
FILE: .github/workflows/idris2.yml
================================================
## Adapted from The Frex Project.

name: Idris2 on Ubuntu

# -- [ When to Act]

on:
  push:
    branches:
      - '*'
    tags:
      - '*'
  pull_request:
    branches:
      - main

# -- [ ENV Variables ]

env:
  SCHEME: scheme

# -- [ Jobs ]
jobs:

## -- [ Initialise Build Environment ]
  build:
    runs-on: ubuntu-latest

    timeout-minutes: 60

    strategy:
      matrix:
        emacs: [28.2, 29.4, 30.2]

    env:
      EMACS_VERSION: ${{ matrix.emacs }}

## -- [ Steps To Run ]
    steps:

### -- [ Initialise Variables ]

      - name: Initialise variables
        run: |
          # Only deploy if the build follows from pushing to main
          echo "$HOME/.idris2/bin" >> $GITHUB_PATH

### -- [ Cache Idris2 ]

      - name: Cache Idris2
        uses: actions/cache@v3
        id: cache-idris2
        with:
          path: |
            ~/.idris2
          key: ${{ runner.os }}-idris2

### -- [ Fetch Dependencies ]

#### -- [ Chez Scheme ]

      - name: Install Chez
        run: |
          sudo apt-get update
          sudo apt-get install -y chezscheme

#### -- [ Idris2 ]

      - name: Install Idris2
        if: steps.cache-idris2.outputs.cache-hit != 'true'
        run: |
          pushd .
          git clone https://github.com/idris-lang/idris2
          cd idris2
          make bootstrap && make install
          popd

#### -- [ Emacs ]

      - name: Fetch Emacs
        uses: purcell/setup-emacs@master
        with:
          version: ${{ matrix.emacs }}

### -- [ Checkout the test ]

      - name: Checkout
        uses: actions/checkout@v3

### -- [ Test ]

      - name: Build and Run
        run: |
          make clean
          make build
          make test2

# -- [ EOF ]


================================================
FILE: .gitignore
================================================
*~
*.elc
documentation.aux
documentation.log
documentation.pdf
test-data/build/
test-data/*.ibc
test-data/idris2-history.eld
test-data/Empty.idr

docs/*.aux
docs/*.log
docs/*.pdf
docs/auto/
docs/*.fdb_latexmk
docs/*.fls
docs/*.xdv

*.ttc
*.ttm


================================================
FILE: .travis.yml
================================================
# Based on https://docs.haskellstack.org/en/stable/travis_ci/
#
# Copy these contents into the root directory of your Github project in a file
# named .travis.yml

# choose a build environment
dist: xenial

# Use new container infrastructure to enable caching
sudo: false

# Do not choose a language; we provide our own build tools.
language: generic

matrix:
  include:
    - env: EMACS_VERSION=24.5 IDRIS_VERSION=git
    - env: EMACS_VERSION=24.5 IDRIS_VERSION=stackage
    - env: EMACS_VERSION=25.3 IDRIS_VERSION=git
    - env: EMACS_VERSION=25.3 IDRIS_VERSION=stackage
    - env: EMACS_VERSION=26.1 IDRIS_VERSION=git
    - env: EMACS_VERSION=26.1 IDRIS_VERSION=stackage

# Caching so the next build will be fast too.
cache:
  directories:
  - $HOME/.stack

# Ensure necessary system libraries are present
addons:
  apt:
    packages:
      - libgc-dev

before_install:
  # Download and unpack the stack executable
  - mkdir -p ~/.local/bin
  - export PATH=$HOME/.local/bin:$PATH
  - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'

  ## Emacs
  - sudo apt-get install -y libgif-dev libxaw7-dev
  - wget http://ftpmirror.gnu.org/emacs/emacs-${EMACS_VERSION}.tar.xz
  - tar -xf emacs-${EMACS_VERSION}.tar.xz
  - cd emacs-${EMACS_VERSION}
  - ./configure --prefix=/usr/local/emacs-${EMACS_VERSION} --with-gnutls=no
  - make
  - sudo make install
  - cd ..

# Install Idris
install: . ./.travis_install.sh

before_script: true

script:
  - make clean
  - make build
  - make test EMACS=/usr/local/emacs-${EMACS_VERSION}/bin/emacs


================================================
FILE: .travis_install.sh
================================================
#! /usr/bin/env bash

set -ev

case $IDRIS_VERSION in
     git)
         pushd .
         git clone https://github.com/idris-lang/Idris-dev.git /tmp/Idris-dev
         cd /tmp/Idris-dev
         stack --no-terminal --install-ghc install --flag idris:-FFI --flag idris:-GMP
         popd
         ;;
     stackage)
         travis_wait 30 stack install --resolver lts-12.26 idris
         ;;
     *)
         echo '$IDRIS_VERSION unspecified'
         ;;
esac


================================================
FILE: CHANGES.markdown
================================================
# Changes

This file documents the user-interface changes in idris-mode, starting
with release 0.9.19.

## master (unreleased)

### New features

+ [cab781537f](https://github.com/idris-hackers/idris-mode/commit/cab781537f): Improved flycheck integration for Idris1 and Idris2.
+ [c9b2a4bee6](https://github.com/idris-hackers/idris-mode/commit/c9b2a4bee6): Xref integration to support "jump to definition" features.
+ [103f1e5fbf](https://github.com/idris-hackers/idris-mode/commit/103f1e5fbf): New command `M-x idris-switch-to-last-idris-buffer` to move point from Idris repl buffer to Idris source code buffer.
  It is opposite of `M-x idris-switch-to-repl` and uses same key binding by default (`C-c C-z`).
+ [e350ed25a5](https://github.com/idris-hackers/idris-mode/commit/e350ed25a5): New command `idris-compile-and-execute`. Backport of `idris2-compile-and-execute` from https://github.com/idris-community/idris2-mode/pull/20/files with preserving backward compatibility for Idris 1.
+ [e350ed25a5](https://github.com/idris-hackers/idris-mode/commit/e350ed25a5): New command `idris-intro`. Backport of `idris2-intro from` https://github.com/idris-community/idris2-mode/pull/21/files
+ [cc098578fe](https://github.com/idris-hackers/idris-mode/commit/cc098578fe): Restore position after case split with improved user experience. Related to https://github.com/idris-hackers/idris-mode/pull/465
+ [3cce2336b7](https://github.com/idris-hackers/idris-mode/commit/3cce2336b7): More granular configuration for enabling semantic source highlighting.

### Changes

+ [b6a5b2ec60](https://github.com/idris-hackers/idris-mode/commit/b6a5b2ec60): Kill Idris buffer and it's window if it was the only buffer in windows history.
+ [d1a9171fd7](https://github.com/idris-hackers/idris-mode/commit/d1a9171fd7): Jump to last Idris Code buffer when we quit buffer
+ [cd734fdc7a](https://github.com/idris-hackers/idris-mode/commit/cd734fdc7a): Write Idris repl history file to `~/.idris2/` directory.
+ [8329b73be8](https://github.com/idris-hackers/idris-mode/commit/8329b73be8): Move "words of encouragement" from mini-buffer to Idris repl banner.
+ [71ab6a35e3](https://github.com/idris-hackers/idris-mode/commit/71ab6a35e3): Update semantic source highlighting file only in changed code parts reducing buffer "flickering".
+ [e5ef933366](https://github.com/idris-hackers/idris-mode/commit/e5ef933366): Only display Idris repl buffer on load without moving the point.
+ [9e931bf1ff](https://github.com/idris-hackers/idris-mode/commit/9e931bf1ff): Make `idris-list-holes-on-load` obsolete in favour of `idris-list-holes` command.
+ [446c67cec7](https://github.com/idris-hackers/idris-mode/commit/446c67cec7): Ensure Idris connection established and current file loaded  when running interactive command `idris-thing-at-point`
+ [cb71c82e13](https://github.com/idris-hackers/idris-mode/commit/cb71c82e13): Make commands `idris-pop-to-repl` and `idris-switch-to-output-buffer` obsolete in favour of `idris-switch-to-repl` command.
+ [7697b8b95e](https://github.com/idris-hackers/idris-mode/commit/7697b8b95e): Make `idris-print-definition-of-name` obsolete in favour of `idris-print-definition-of-name-at-point`.
+ [600c8f584b](https://github.com/idris-hackers/idris-mode/commit/600c8f584b): Make Idris info buffers derived from Help mode making handling them more align with general Emacs conventions.

### Bug fixes

+ Fix `idris-identifier-face` looking wrong in `org-mode` blocks and the like.
+ [3c3a87c66c](https://github.com/idris-hackers/idris-mode/commit/3c3a87c66c): Fix failure to find beginning of function type definition when lifting hole and function name contains underscore.
+ [62c3ad2b0d](https://github.com/idris-hackers/idris-mode/commit/62c3ad2b0d): Do not display unnecessary `*idris-process*` buffer when loading file.
+ [486be1b740](https://github.com/idris-hackers/idris-mode/commit/486be1b740): Improve `idris-case-dwim` to make case expression from hole in edge case point positions.
+ [8ff4a2d9d5](https://github.com/idris-hackers/idris-mode/commit/8ff4a2d9d5) [4f654a8b20ba6](https://github.com/idris-hackers/idris-mode/commit/4f654a8b20ba6) [c84ed5a733](https://github.com/idris-hackers/idris-mode/commit/c84ed5a733): Improve resetting state on `idris-quit` making it easier to switch Idris version or restart connection.
+ [1382948269](https://github.com/idris-hackers/idris-mode/commit/1382948269): Consider `-` as operator in idris-thing-at-point . Fixes https://github.com/idris-community/idris2-mode/issues/16
+ [216945f4a6](https://github.com/idris-hackers/idris-mode/commit/216945f4a6): Fix "off-by-one" source code highlighting in Idris 1.
+ [928f785bb7](https://github.com/idris-hackers/idris-mode/commit/928f785bb7): Allow loading multiple files with identical name but in different directories.
+ [ac029bc67e](https://github.com/idris-hackers/idris-mode/commit/ac029bc67e): Remove extra white-space included by Idris2 on `idris-add-clause` command.
+ [24ce417b69](https://github.com/idris-hackers/idris-mode/commit/24ce417b69): Preserve point position after adding warning overlay. Resolves part of: https://github.com/idris-community/idris2-mode/issues/36
+ [a47811be8b](https://github.com/idris-hackers/idris-mode/commit/a47811be8b): Remove `{{{{{ VAL }}}}}` value from `idris-name-key` text property fixing some command depending on it to have meaningful or no value.
+ [3e7cbb331f](https://github.com/idris-hackers/idris-mode/commit/3e7cbb331f): Improve compatibility with Idris2
+ [43b6036c99](https://github.com/idris-hackers/idris-mode/commit/43b6036c99): Display key binding for `idris-case-split` and `idris-make-cases-from-hole` in menu. Resolves: https://github.com/idris-hackers/idris-mode/issues/447

## 1.1

+ New customisation settings:
  + `idris-display-words-of-encouragement` toggles showing words of encouragement.
  + `idris-completion-via-compiler` toggles use of the Idris compiler to provide completion.
    + Tab in the repl still uses `completion-at-point`.
+ Improvements to testing harness, with support for testing against Idris2.
+ Migration of CI from Travis to GitHub Actions
  + Deprecation of older emacs for testing.
+ More support for IDE Protocol Version2 (i.e. Idris2).
+ Upstream changes as contributed to the Idris2-Mode on idris-community.
  + Improvements to Makefile
  + Changes to semantic faces

## 1.0

+ Idris mode has been brought uptodate with Idris1
+ Basic navigation commands added

### Fixes

+ Fix regular expression when matching on `.ipkg` extensions
+ Prevent completion-error when identifier is at beginning of buffer
+ Internal code changes
+ Better development testing with travis

### UX

+ `C-u C-c C-l` flags the buffer as dirty
+ Add images back into the repl
+ Disable the Idris event log by default
+ When Idris returns no proof search, do not delete the metavas
+ Remove references to idris-event-buffer-name when idris-log-events is nil
+ Fix idris-simple-indent-backtab
+ Give operator chars "." syntax and improve idris-thing-at-point
+ Conditional semantic faces for light/dark backgrounds

### Documentation

+ General fix ups
+ Document a way of reducing excessive frames


## 2016 Feb 29

 * It is possible to customize what happens to the focus of the current
   window when the type checking is performed and type errors are detected,
   now the user can choose between two options: 1) the current window stays
   focused or 2) the focus goes to the `*idris-notes*` buffer.
   The  true or false value of the variable
   `idris-stay-in-current-window-on-compiler-error` controls this behaviour.

## 0.9.19

 * The variable `idris-packages` has been renamed to
   `idris-load-packages`. If you have this as a file variable, please
   rename it.
 * The faces `idris-quasiquotation-face` and
   `idris-antiquotation-face` have been added, for compiler-supported
   highlighting of quotations. They are, by default, without
   properties, but they can be customized if desired.
 * Active terms can now be right-clicked. The old "show term widgets"
   command is no longer necessary, and will be removed in an upcoming
   release.
 * The case split command can be run on a hole, causing it to be filled
   with a prototype for a case split expression. Case-splitting a pattern
   variable has the same effect as before.
 * There is support for the interactive elaborator, which may replace
   the interactive prover in a future release. To use this, set
   `idris-enable-elab-prover` to non-`nil`.


================================================
FILE: CONTRIBUTING.md
================================================
# Contributing to Idris-Mode

Contributions are always welcome to `idris-mode`.
Here we describe how you can best contribute to `idris-mode`.

Much like Idris itself, `idris-mode` is run by volunteers and there are no full-time maintainers.
Our time is limited and we must take care to ensure that the demands of our day job take priority.
Thus, we must take care in ensure that *we* can maintain `idris-mode` itself.

## Tests

Before sending a patch or pull request, please run the automated tests for `idris-mode` and correct any errors that are found. There are two kinds of test:

1. The Emacs byte code compiler can catch many issues. Running `make compile` will invoke the byte code compiler, failing if there are any warnings. You may wish to run `make clean` after `make compile` to get rid of pesky `.elc` files.

2. There is a test suite that can be invoked with `make test`. It requires a functioning `idris` executable.

## General Comments

We expect contributions to come in the form of PRs (via GitHub), and larger discussions to take place on the project's issue tracker, the Idris Mailing List, or the Idris Discord.
While `idris-mode` does not pertain to any general philosophy we make one thing clear:

> First and foremost Idris-mode was created to provide a rich interacting editing experience in emacs for the language's created as part of the Idris project that support the IDE-Protocol.

Thus `idris-mode` must support *all* versions of the protocol associated with Idris1 and Idris2.

The `idris-mode` has simple test suite and some documentation.
Please try to ensure that contributions to the project keeps those in sync.

We do not prescribe to any coding style wrt to emacs lisp; this may change.
Please try to remember to keep the code styling consistent with how you found it.
A good rule to follow is that of the 'CampSite Rule': Leave the code tidier than you found it.

Please remember to update `CHANGELOG.md`, and if it's your first contribution you can add yourself to `CONTRIBUTORS`.

When submitting a pull request to the project, please try to adhere to good commit practises.

+ Lead the commit with a short description that explains it purpose;
+ optionally prepending the description with descriptive tags enclosed in square brackets;
+ If necessary provide a longer description after the brief.

GitHub will populate the description of a PR with the HEAD's commit message.
While convenient it may mean that the entire purpose of the PR is lost.
Please try to ensure that the PR description sufficiently describes the PR and not just the HERAD commit.
Similarly, try to ensure that the GitHub description does not contain information that should be in the commits.
We may end up moving from GitHub and we want to retain as much of the development history as possible.

In general, any major change to `idris-mode` should be discussed via the issue tracker and then resolved either by a PR or closing the issue.
We want to ensure that people do not waste their time on things we will not accept.
We will endeavour to keep track in the code-base larger discussions that are closed.

## Things we welcome

+ New features;
+ Fixes for the issue tracker;
+ Support for Version 2 of the IDE-Protoccol;
+ Documentation;
+ More tests;

## Things we want to discuss first

+ major code refactorings;
+ changes to the core operations;
+ anything that makes deep changes to how `idris-mode` operates;

## Things we are hesitent about

+ minor refactorings, reviewing PRs take time and minor refactorings based on style are not an effective use of a reviewers time, that being said if the refactorings are part of a larger PR then please do so, and make sure the refactorings are separated from the PRs main contribution;

## Things we will not welcome

+ Dropping of support for older versions of the protocol;


## Other possible contributions

If you have any other ideas on how to improve `idris-mode`, that is not covered above, please do get in touch.
We can discuss your idea and see how well it would fit in to the project as a whole.

## Where to talk.

The maintainers of `idris-mode` are embedded within the larger Idris project, you can find us hanging around there.
Good places to discuss possible contributions are:

    The mailing list <https://groups.google.com/forum/#!forum/idris-lang>_.
    The Idris community on Discord (Invite link) <https://discord.gg/YXmWC5yKYM>_
    The issue tracker (in this case, please make your proposal as concrete as possible).

<!-- EOF -->


================================================
FILE: CONTRIBUTORS
================================================
# Contributors

Over the years many people have contributed to the development of idris-mode.
We thanks the following for their contributions:

Ahmad Salim Al-Sibahi
Alex Segura
Alyssa Carter
Andreas Roehler
Arnaud Bailly
Bartosz Przygoda
Brendan Zabarauskas
Daniel Kimbel
David Christiansen
David Raymond Christiansen
David Thrane Christiansen
Eldar Gabdullin
Guillaume ALLAIS
Hannes Mehnert
Hardy Jones
Hugh FD Jackson
Jan de Muijnck-Hughes
Jefferson Carpenter
Jeremy Yallop
John Soo
Josh
Jozsef Hegedus
Juergen Hoetzel
Mario Rodas
Marek L.
Mark Laws
Matti Hanninen
Micah Werbitt
Michael Morgan
Mort Yao
Nicolas Dudebout
Ohad Kammar
Paul Dempster
Peter Harpending
Samuel Memmel
Simon Pelchat
Steve Purcell
Steven Shaw
Syohei YOSHIDA
Taru Karttunen
Tassilo Horn
Tim Humphries
Yasu Watanabe
defanor
startling
κeen
identity


================================================
FILE: COPYING
================================================
                    GNU GENERAL PUBLIC LICENSE
                       Version 3, 29 June 2007

 Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
 Everyone is permitted to copy and distribute verbatim copies
 of this license document, but changing it is not allowed.

                            Preamble

  The GNU General Public License is a free, copyleft license for
software and other kinds of works.

  The licenses for most software and other practical works are designed
to take away your freedom to share and change the works.  By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users.  We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors.  You can apply it to
your programs, too.

  When we speak of free software, we are referring to freedom, not
price.  Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.

  To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights.  Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.

  For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received.  You must make sure that they, too, receive
or can get the source code.  And you must show them these terms so they
know their rights.

  Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.

  For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software.  For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.

  Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so.  This is fundamentally incompatible with the aim of
protecting users' freedom to change the software.  The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable.  Therefore, we
have designed this version of the GPL to prohibit the practice for those
products.  If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.

  Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary.  To prevent this, the GPL assures that
patents cannot be used to render the program non-free.

  The precise terms and conditions for copying, distribution and
modification follow.

                       TERMS AND CONDITIONS

  0. Definitions.

  "This License" refers to version 3 of the GNU General Public License.

  "Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.

  "The Program" refers to any copyrightable work licensed under this
License.  Each licensee is addressed as "you".  "Licensees" and
"recipients" may be individuals or organizations.

  To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy.  The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.

  A "covered work" means either the unmodified Program or a work based
on the Program.

  To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy.  Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.

  To "convey" a work means any kind of propagation that enables other
parties to make or receive copies.  Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.

  An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License.  If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.

  1. Source Code.

  The "source code" for a work means the preferred form of the work
for making modifications to it.  "Object code" means any non-source
form of a work.

  A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.

  The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form.  A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.

  The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities.  However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work.  For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.

  The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.

  The Corresponding Source for a work in source code form is that
same work.

  2. Basic Permissions.

  All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met.  This License explicitly affirms your unlimited
permission to run the unmodified Program.  The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work.  This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.

  You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force.  You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright.  Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.

  Conveying under any other circumstances is permitted solely under
the conditions stated below.  Sublicensing is not allowed; section 10
makes it unnecessary.

  3. Protecting Users' Legal Rights From Anti-Circumvention Law.

  No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.

  When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.

  4. Conveying Verbatim Copies.

  You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.

  You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.

  5. Conveying Modified Source Versions.

  You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:

    a) The work must carry prominent notices stating that you modified
    it, and giving a relevant date.

    b) The work must carry prominent notices stating that it is
    released under this License and any conditions added under section
    7.  This requirement modifies the requirement in section 4 to
    "keep intact all notices".

    c) You must license the entire work, as a whole, under this
    License to anyone who comes into possession of a copy.  This
    License will therefore apply, along with any applicable section 7
    additional terms, to the whole of the work, and all its parts,
    regardless of how they are packaged.  This License gives no
    permission to license the work in any other way, but it does not
    invalidate such permission if you have separately received it.

    d) If the work has interactive user interfaces, each must display
    Appropriate Legal Notices; however, if the Program has interactive
    interfaces that do not display Appropriate Legal Notices, your
    work need not make them do so.

  A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit.  Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.

  6. Conveying Non-Source Forms.

  You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:

    a) Convey the object code in, or embodied in, a physical product
    (including a physical distribution medium), accompanied by the
    Corresponding Source fixed on a durable physical medium
    customarily used for software interchange.

    b) Convey the object code in, or embodied in, a physical product
    (including a physical distribution medium), accompanied by a
    written offer, valid for at least three years and valid for as
    long as you offer spare parts or customer support for that product
    model, to give anyone who possesses the object code either (1) a
    copy of the Corresponding Source for all the software in the
    product that is covered by this License, on a durable physical
    medium customarily used for software interchange, for a price no
    more than your reasonable cost of physically performing this
    conveying of source, or (2) access to copy the
    Corresponding Source from a network server at no charge.

    c) Convey individual copies of the object code with a copy of the
    written offer to provide the Corresponding Source.  This
    alternative is allowed only occasionally and noncommercially, and
    only if you received the object code with such an offer, in accord
    with subsection 6b.

    d) Convey the object code by offering access from a designated
    place (gratis or for a charge), and offer equivalent access to the
    Corresponding Source in the same way through the same place at no
    further charge.  You need not require recipients to copy the
    Corresponding Source along with the object code.  If the place to
    copy the object code is a network server, the Corresponding Source
    may be on a different server (operated by you or a third party)
    that supports equivalent copying facilities, provided you maintain
    clear directions next to the object code saying where to find the
    Corresponding Source.  Regardless of what server hosts the
    Corresponding Source, you remain obligated to ensure that it is
    available for as long as needed to satisfy these requirements.

    e) Convey the object code using peer-to-peer transmission, provided
    you inform other peers where the object code and Corresponding
    Source of the work are being offered to the general public at no
    charge under subsection 6d.

  A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.

  A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling.  In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage.  For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product.  A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.

  "Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source.  The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.

  If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information.  But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).

  The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed.  Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.

  Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.

  7. Additional Terms.

  "Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law.  If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.

  When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it.  (Additional permissions may be written to require their own
removal in certain cases when you modify the work.)  You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.

  Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:

    a) Disclaiming warranty or limiting liability differently from the
    terms of sections 15 and 16 of this License; or

    b) Requiring preservation of specified reasonable legal notices or
    author attributions in that material or in the Appropriate Legal
    Notices displayed by works containing it; or

    c) Prohibiting misrepresentation of the origin of that material, or
    requiring that modified versions of such material be marked in
    reasonable ways as different from the original version; or

    d) Limiting the use for publicity purposes of names of licensors or
    authors of the material; or

    e) Declining to grant rights under trademark law for use of some
    trade names, trademarks, or service marks; or

    f) Requiring indemnification of licensors and authors of that
    material by anyone who conveys the material (or modified versions of
    it) with contractual assumptions of liability to the recipient, for
    any liability that these contractual assumptions directly impose on
    those licensors and authors.

  All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10.  If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term.  If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.

  If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.

  Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.

  8. Termination.

  You may not propagate or modify a covered work except as expressly
provided under this License.  Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).

  However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.

  Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.

  Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License.  If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.

  9. Acceptance Not Required for Having Copies.

  You are not required to accept this License in order to receive or
run a copy of the Program.  Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance.  However,
nothing other than this License grants you permission to propagate or
modify any covered work.  These actions infringe copyright if you do
not accept this License.  Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.

  10. Automatic Licensing of Downstream Recipients.

  Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License.  You are not responsible
for enforcing compliance by third parties with this License.

  An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations.  If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.

  You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License.  For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.

  11. Patents.

  A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based.  The
work thus licensed is called the contributor's "contributor version".

  A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version.  For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.

  Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.

  In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement).  To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.

  If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients.  "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.

  If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.

  A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License.  You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.

  Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.

  12. No Surrender of Others' Freedom.

  If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License.  If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all.  For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.

  13. Use with the GNU Affero General Public License.

  Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work.  The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.

  14. Revised Versions of this License.

  The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time.  Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

  Each version is given a distinguishing version number.  If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation.  If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.

  If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.

  Later license versions may give you additional or different
permissions.  However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.

  15. Disclaimer of Warranty.

  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

  16. Limitation of Liability.

  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

  17. Interpretation of Sections 15 and 16.

  If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.

                     END OF TERMS AND CONDITIONS

            How to Apply These Terms to Your New Programs

  If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.

  To do so, attach the following notices to the program.  It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.

    <one line to give the program's name and a brief idea of what it does.>
    Copyright (C) <year>  <name of author>

    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 3 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, see <http://www.gnu.org/licenses/>.

Also add information on how to contact you by electronic and paper mail.

  If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:

    <program>  Copyright (C) <year>  <name of author>
    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
    This is free software, and you are welcome to redistribute it
    under certain conditions; type `show c' for details.

The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License.  Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".

  You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.

  The GNU General Public License does not permit incorporating your program
into proprietary programs.  If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library.  If this is what you want to do, use the GNU Lesser General
Public License instead of this License.  But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.


================================================
FILE: Makefile
================================================
# Makefile for idris-mode, to run tests and ensure dependencies are in order
# Portions based on the Makefile for Proof General

EMACS ?= emacs

NEED_PKGS=prop-menu flycheck

BATCHEMACS=$(EMACS) --batch --no-site-file -q \
	-eval '(add-to-list (quote load-path) "${PWD}/")' \
	-eval '(require (quote package))' \
	-eval '(add-to-list (quote package-archives) (quote ("melpa" . "http://melpa.org/packages/")) t)' \
	-eval '(package-initialize)'

BYTECOMP = $(BATCHEMACS) \
	-eval '(require (quote bytecomp))' \
	-eval '(setq byte-compile-warnings t)' \
	-eval '(setq byte-compile-error-on-warn t)' \
	-f batch-byte-compile

OBJS =	idris-commands.elc		\
	idris-common-utils.elc		\
	idris-compat.elc		\
	idris-core.elc			\
	idris-events.elc		\
	idris-highlight-input.elc	\
	idris-info.elc			\
	idris-ipkg-mode.elc		\
	idris-keys.elc			\
	idris-log.elc			\
	idris-hole-list.elc		\
	idris-mode.elc			\
	idris-prover.elc		\
	idris-repl.elc			\
	idris-settings.elc		\
	idris-simple-indent.elc		\
	idris-tree-info.elc             \
	idris-syntax.elc		\
	idris-warnings.elc		\
	idris-warnings-tree.elc		\
	idris-xref.elc                  \
	inferior-idris.elc              \
	flycheck-idris.elc

.el.elc:
	$(BYTECOMP) $<

build: getdeps $(OBJS)

test: getdeps build
	$(BATCHEMACS) -L . -l ert -l test/idris-tests.el -f ert-run-tests-batch-and-exit

test2: getdeps build
	$(BATCHEMACS) -L . \
		-eval '(setq idris-interpreter-path (executable-find "idris2"))' \
		-l ert -l test/idris-tests.el -f ert-run-tests-batch-and-exit

clean:
	-${RM} -f $(OBJS)
	-${RM} -f test/test-data/*ibc
	-${RM} -rf test/test-data/build/
	-${RM} -r docs/auto docs/*.aux docs/*.log docs/*.pdf
getdeps:
	$(BATCHEMACS) -eval \
		"(let* \
				((need-pkgs '($(NEED_PKGS))) \
				 (want-pkgs (seq-remove #'package-installed-p need-pkgs))) \
			(unless (null want-pkgs) \
				(package-initialize) \
				(package-refresh-contents) \
				(mapcar #'package-install want-pkgs)))"

docs: docs/documentation.tex
	-@( cd docs/ && latexmk -xelatex documentation.tex )

.PHONY: clean build test getdeps docs


================================================
FILE: docs/documentation.tex
================================================
\documentclass{article}
\usepackage{amsmath}
\usepackage{tikz}
\usetikzlibrary{positioning}

\title{idris-mode: Idris interaction with emacs}
\author{Hannes Mehnert\\\texttt{hannes@mehnert.org}}
\begin{document}
\sloppy
\maketitle

\begin{abstract}
This document describes the interaction of the Idris compiler with the editor emacs, to facilitate a lightweight development environment for Idris programs in emacs.

The goal of the IDE mode is to provide from Idris a structured input and output command processor, which supports all features available in the command line version of the Idris compiler.
\end{abstract}

\section{Introduction}
Getting dependently typed programs right is harder than usual statically typed programs, since the type system is more expressive.
Actually, the type checker of a dependently typed programming language can assist the programmer to develop a type correct program.

In this document we explain the interaction between Idris and emacs, this not a user guide for idris-mode.
The goal is to enable developers to extend idris-mode, as well as use Idris's IDE mode for other editors or tools.

The motivation for IDE mode is to provide an interface for Idris with structured input and output.
The motivation for idris-mode is to have a lightweight development environment for Idris within emacs.

A lot of inspiration for the interaction between Idris and emacs comes from SLIME, the superior LISP interaction mode for emacs~\footnote{not the German punk band ;)}.
The communication protocol is of asynchronous request-reply style: a single request from emacs is handled by Idris at a time.
Idris waits busily for a request on its standard input stream, and outputs the answer to standard output.
The result of a request can be either success or failure, and furthermore, before the result is delivered there might be informal messages.
Since a request can take an arbitrary amount of time, and emacs is single-threaded, the communication happens in an asynchronous fashion: instead of busy waiting for a reply, the requestor gives a continuation which is later called with the result.

\section{Features}
The idris-mode provides basic syntax highlighting for Idris, located in \texttt{idris-syntax.el} (not in scope of this document).
Also indentation is handled in idris-mode, implemented in \texttt{idris-simple-indent.el}.

The currently supported features which interact with the Idris compiler are a read-eval-print-loop (REPL), type checking of Idris files, processing and displaying of errors, a proof mode, case splitting, and other interactive features.

The REPL is useful on its own, and can be started by \textsf{M-x idris-repl}.
This creates a new buffer \emph{*idris-repl*}, whose interaction is very similar to the command-line REPL.
A history, available via C-down and C-up, of previous entered statements is present.
The search in the history uses the currently entered string for its prefix search to find available items.
Automatic completion of available commands is available via tab.

When working on an Idris file, the key C-c C-l loads the file of the current buffer and starts a REPL which has this as its context.
Also, if Idris presented errors while parsing or type checking the file, these are presented in the buffer as orange overlays with tooltips containing the error.

The interactive features: displaying the type of the current name, case splitting, add missing cases, add clause, insert with block, and proof search are all implemented synchronously.
Each feature is bound to a key in the idris-mode keymap.

Inspiration for the proof mode is taken from proof general~\cite{proofgeneral}, an emacs interface for a lot of interactive proof assistants like Coq, Isabelle, PVS.
The proof mode consists of three buffers, one shows the proof obligation, another the proof script, and the third the proof shell.
The proof script buffer highlights the processed parts of the proof script.
There are keybindings available to step forward and backwards over the proof script, namely C-n and C-p.
Additionally, completion of partially written proof script is supported and bound to the key tab.
To get into proof mode, start proving a hole by typing \textsf{:p hole} at the REPL.

Help for the current modes is available, as usual, by C-h m.

\section{Communication}\label{sec:protocol}
The request-reply communication uses the standard input and standard output stream of Idris.
A reply can consist of multiple messages: any number of messages to inform the user about the progress of the request or other informational output, and finally a result, either ``ok'' or ``error''.

The wire format is the length of the messages, encoded in 6 characters hexadecimal, followed by the message encoded as S-expression (sexp).
Additionally, each request includes a unique integer (counting upwards), which is repeated in all messages corresponding to that request.

An example interaction from loading the file \texttt{/home/hannes/empty.idr} looks as follows on the wire:
\begin{verbatim}
00002a((:load-file "/home/hannes/empty.idr") 1)
000039(:write-string "Type checking /home/hannes/empty.idr" 1)
000026(:set-prompt "*/home/hannes/empty" 1)
000032(:return (:ok "loaded /home/hannes/empty.idr") 1)
\end{verbatim}

The first message is the request from idris-mode to load the specific file, which length is hex 2a, decimal 42 (including the newline at the end).
The request identifier is set to 1.
The first message from Idris is to write the string ``Type checking /home/hannes/empty.idr'', another is to set the prompt to ``*/home/hannes/empty''.
The answer, starting with \texttt{:return} is \texttt{ok}, and additional information is that the file was loaded.

There are three atoms in the wire language: numbers, strings, and symbols.
The only compound object is a list, which is surrounded by parenthesis.
The syntax is given in Figure~\ref{fig:syntax}.

\begin{figure}
\centering
\begin{align*}
\mathcal{A}{~::=~}&\mathit{Num} \mid \texttt{"} \mathit{Alpha*} \texttt{"} \mid \texttt{:}\mathit{Alpha*}\\
\mathcal{S}{~::=~}&\mathcal{A} \mid \texttt{(} S \texttt{)} \mid \texttt{nil}
\end{align*}
\caption{Syntax of the wire language, where Num is a positive integer and Alpha is a character, nil is reserved for the empty list}
\label{fig:syntax}
\end{figure}

The state of the Idris process is mainly the active file, which needs to be kept synchronized between the editor and Idris.
This is achieved by the already seen \emph{LoadFile} command.

The full list of supported commands is the data structure \emph{IdeModeCommand} in \texttt{Idris/IdeMode.hs}, and explained in further detail in the following.

\begin{verbatim}
data IdeModeCommand  = REPLCompletions String
                     | Interpret String
                     | TypeOf String
                     | CaseSplit Int String
                     | AddClause Int String
                     | AddProofClause Int String
                     | AddMissing Int String
                     | MakeWithBlock Int String
                     | ProofSearch Int String [String]
                     | LoadFile String
\end{verbatim}

\paragraph{REPLCompletions} returns all possible commands for the given partial string by using the Haskeline completions (\emph{replCompletion} in \texttt{Completion.hs}).

\paragraph{Interpret} interprets the given string as a REPL command.

\paragraph{TypeOf} returns the type of the given top-level name.

\paragraph{CaseSplit} returns the cases for the given name.

\paragraph{AddClause} returns the definition for the given type.

\paragraph{AddProofClause} returns the proof clause for the given name.

\paragraph{AddMissing} returns the missing cases for the given name.

\paragraph{MakeWithBlock} returns a with block for the given name.

\paragraph{ProofSearch} returns a proof for the given name.

\paragraph{LoadFile} loads the given file.

Possible replies include a normal reply:
\begin{verbatim}
:return (:ok SEXP)
:return (:error String)
\end{verbatim}

Informational and abnormal replies
\begin{verbatim}
:write-string String
:set-prompt String
:warning (FilePath, Int, String)
\end{verbatim}

Specially for proof mode
\begin{verbatim}
:start-proof-mode
:write-proof-state [String]
:end-proof-mode
:write-goal String
\end{verbatim}

\section{Implementation}
The implementation of these features are twofold: the emacs side and the Idris side.

\subsection{Idris side}
On the Idris side, the marshaling and unmarshaling of sexps is done in \texttt{IdeMode.hs}.
The main entry point is \emph{idemodeStart}, called by \emph{idrisMain} (both in \texttt{REPL.hs}).
Also, the \emph{idris\_outputmode} field in the \emph{IState} record (in \texttt{AbsSyntaxTree.hs}) is set to \emph{IdeMode 0} (by a call \emph{setIdeMode True} from \emph{idrisMain}).

In the Idris source base, instead of writing raw data to standard output (eg by using \emph{putStrLn}), which violates the protocol presented in Section~\ref{sec:protocol}, Idris uses \emph{ihputStrLn :: Handle $\rightarrow$ String $\rightarrow$ Idris ()}.
This function does a case analysis of the \emph{idris\_outputmode} field in the \emph{IState} record, and either uses \emph{putStrLn} for \emph{RawOutput} (actually \emph{hPutStrLn}) or first converts the message to a sexp by using \emph{convSExp} and wraps it into a \emph{:write-string} message, as seen on line 2 of our example.

To display a result for a command, \emph{ihPrintError} and \emph{ihPrintResult} are available (for failure and success).
Furthermore, the function \emph{ihWarn} produces a warning message, given a source location (\emph{FC} from \texttt{Core/TT.hs}) and a message.

Most of Idris works via IDE mode, for the time being setting the log level greater 5 results in calls to \emph{Debug.Trace.trace} from \texttt{Core}, which uses \emph{unsafePerformIO} and thus is not encapsulated in a sexp.
Also not supported is the execution of programs (\emph{Execute}), to support this the input and output streams of the executed program will need to be wrapped into sexps.

\subsection{Emacs side}
The emacs side is mainly implemented in \texttt{inferior-idris.el}, which provides both an asynchronous (\emph{idris-eval-async}) and a synchronous (busy waiting \emph{idris-eval}) function for interaction.
A dependency diagram of the various emacs lisp files is shown in Figure~\ref{fig:elisp-deps}.

\begin{figure}
\centering
\begin{tikzpicture}
  \tikzstyle{every node}=[draw]
  \node (im) {idris-mode.el};

  \node (commands) [below=of im] {idris-commands.el};

  \node (repl) [below right=of commands] {idris-repl.el};

  \node (inferior) [below left=of repl] {inferior-idris.el};
  \node (completion) [right=of inferior] {idris-completion.el};

  \node (prover) [below left=of inferior] {idris-prover.el};
  \node (log) [right=of prover] {idris-log.el};
  \node (events) [right=of log] {idris-events.el};

  \node (warnings) [below=of prover] {idris-warnings.el};

  \node (common) [below=of events] {idris-common-utils.el};
  \node (compat) [left=of commands] {idris-compat.el};
  \node (syntax) [right=of commands] {idris-syntax.el};
  \node (indentation) [right=of syntax] {idris-simple-indent.el};

  \draw [->] (im) -- (syntax);
  \draw [->] (im) -- (indentation);
  \draw [->] (im) -- (repl);
  \draw [->] (im) -- (commands);
  \draw [->] (im) -- (compat);

  \draw [->] (events) -- (common);
  \draw [->] (log) -- (common);

  \draw [->] (commands) -- (inferior);
  \draw [->] (commands) -- (repl);
  \draw [->] (commands) -- (warnings);

  \draw [->] (repl) -- (common);
  \draw [->] (repl) -- (completion);
  \draw [->] (repl) -- (inferior);

  \draw [->] (inferior) -- (events);
  \draw [->] (inferior) -- (log);
  \draw [->] (inferior) -- (warnings);
  \draw [->] (inferior) -- (prover);

  \draw [->] (prover) -- (warnings);

\end{tikzpicture}
\label{fig:elisp-deps}
\caption{The internal dependency graph of idris-mode}
\end{figure}

Minor notes on some of the implementation files: \texttt{compat.el} includes emacs 24.1 compatibility; \texttt{completion.el} implements a completion popup; \texttt{warnings.el} does the highlighting of warnings using overlays.

The current design uses exactly one Idris process for the interaction (a handle is stored in \emph{idris-process} (in \texttt{inferior-idris.el})).

Since it can consume an arbitrary amount of time to handle a request, \emph{idris-eval-async} (in \texttt{inferior-idris.el}) can be used to evaluate any sexp, where the given continuation is called with the asynchronous result.
Some features, like tab completion, return a result immediately.
To simplify understanding of code, idris-mode waits for the reply in a synchronous fashion.
This is achieved by \emph{idris-eval} (as well in \texttt{inferior-idris.el}), which takes a sexp and returns the result immediately.

Both methods of interaction use the same underlying mechanism, namely sending a sexp via \emph{idris-rex} using the dispatcher \emph{idris-dispatch-event}.

The main entry for interaction between emacs and Idris is the method \emph{idris-run} in the \texttt{inferior-idris.el} file.
It starts the idris binary with the \emph{--ide-mode} command line option, and additional customizable flags \emph{idris-interpreter-flags}.
The output of the idris process is connected to \emph{idris-output-filter}, which inserts the received string into the \emph{*idris-process*} buffer.
This buffer is read by \emph{idris-process-available-input}, which validates the string and constructs a sexp (s-expression), which is then logged (to the \emph{*idris-events*} buffer via \emph{idris-event-log} in \texttt{idris-events.el}) and passed to the main dispatcher in \emph{idris-dispatch-event}.

The dispatcher first calls the registered hooks (at the moment, logger, warning and prover, setup by \emph{add-hook 'idris-event-hooks} in \emph{idris-run}; furthermore repl, registered in \texttt{idris-repl.el}, directly in the \emph{idris-repl-mode}) in order until one handled the sexp.
If the sexp is a request (starts with \emph{:emacs-rex}), the given continuation is pushed onto the list of continuations, and the sexp is sent to idris, after being marshalled.
If the sexp is a result (starts with \emph{:result}), the continuation registered during the request is called.
Furthermore, the continuation is removed from the list.

The implementation of the REPL consists of a custom buffer, \emph{*idris-repl*}, which has a prompt (set by the message \emph{:set-prompt}), and several markers: where to put output and results, where to put the prompt and what is the unprocessed user input.
The REPL also has a persistent history, which is saved to \texttt{.idris/idris-history.eld}.
It consumes all \emph{:write-string} messages and inserts the received string to the output; furthermore \emph{:set-prompt} messages are used to update the prompt.

When logging is enabled, log messages are appended to the \emph{*idris-log*} buffer.

The proof mode consists of three buffers and is enabled by the \emph{:proof} command on the REPL.
The Idris prover (\texttt{Prover.hs}) sends the message \emph{:start-proof-mode}, which then opens the buffers \emph{*idris-proof-obligations*}, \emph{*idris-proof-shell*}, and \emph{*idris-proof-script*} in emacs.
Proof obligations are shown in the \emph{*idris-proof-obligations*} buffer, which is readonly.
There are keyboard shortcuts in the \emph{*idris-proof-script*} buffer available to step forward and backward over the proof script.
Furthermore, tab completion is available there as well as in the proof shell.
The proof script highlights the parts which have been processed by Idris.

\section{Highlighting}
Idris mode supports highlighting the output from Idris.
In reality, this highlighting is controlled by the Idris compiler.
Some of the return forms from Idris support an optional extra parameter: a list mapping spans of text to metadata about that text.
Idris mode then uses this list both to highlight the displayed output and to enable richer interaction by having more metadata present.

A particular semantic span is a three element list.
The first element of the list is the index at which the span begins, the second element is the number of characters included in the span, and the third is the semantic data itself.
The semantic data is a list of lists.
The head of each list is a key that denotes what kind of metadata is in the list, and the tail is the metadata itself.
Presently, the following keys are available:
\begin{description}
\item[name] gives a reference to the fully-qualified Idris name
\item[implicit] provides a Boolean value that is True if the region is the name of an implicit argument
\item[decor] describes the category of a token, which can be ``type'', ``function'', ``data'', ``keyword'', or ``bound''.
\item[source-loc] states that the region refers to a source code location. Its body is a collection of key-value pairs, with the following possibilities:
  \begin{description}
  \item[filename] provides the filename
  \item[start] provides the line and column that the source location starts at as a two-element tail
  \item[end]  provides the line and column that the source location ends at as a two-element tail
  \end{description}
\item[text-formatting] provides an attribute of formatted text. This is for use with natural-language text, not code, and is presently emitted only from inline documentation. The potential values are ``bold'', ``italic'', and ``underline''.

\end{description}

The spans emitted by Idris may completely contain another span, but they will never overlap non-hierarchically. That is, one span may be either completely outside the others or contained entirely within another span.
Presently, spans only overlap in output from documentation strings, but this may change in the future.

\section{Conclusion}
The IDE mode provides a structured output of the Idris compiler.
This is especially useful for interfacing Idris to use for interactive development.
It exposes some internals of the Idris compiler which are useful for interactive development environments.

\section{Bugs and Future Work}
The proof mode needs some further thinking, currently it rewrites the proof script with the one from Idris and applies its own indentation (2 whitespaces).
It should be more interactive and not reformat proof script typed in by a user.

The interactive commands also depend heavily on lines and just insert or rewrite the next line.
This should be prevented to avoid brittleness.

As mentioned in the implementation section, not all commands of the Idris REPL are available in IDE mode:
\begin{itemize}
\item Setting the log level greater 5 results in calls to \emph{Debug.Trace.trace}, which uses \emph{unsafePerformIO} and thus is not encapsulated into a sexp.
\item The execution of programs (\emph{Execute}) is not supported, because the input and output streams of the executed program are not wrapped into sexps.
\end{itemize}

\subsection{Future}

Also, navigation in the source code and further support for the developer.
\end{document}


================================================
FILE: flycheck-idris.el
================================================
;;; flycheck-idris.el --- Major mode for editing Idris code -*- lexical-binding: t -*-

;; Copyright (C) 2022

;; Author:
;; URL: https://github.com/idris-hackers/idris-mode
;; Keywords: languages
;; Package-Requires: ((emacs "24") (prop-menu "0.1") (cl-lib "0.5"))
;; Version: 1.1.0


;;; Commentary:

;; FlyCheck checkers for Idris(2)

;;; Code:

(require 'flycheck)
(require 'idris-mode)

(flycheck-define-checker idris
  "An Idris syntax and type checker."
  :command ("idris"
            "--check" "--nocolor" "--warnpartial"
            ;; Compute the command-line options similarly to inferior-idris
            (eval (idris-compute-flags))
            source-original)
  :error-patterns
  ((warning line-start
            (file-name)
            ":"
            line
            ":"
            column
            "-"
            end-column
            ":" line-end "\n"
            (one-or-more blank) "|\n"
            (one-or-more digit) (one-or-more blank) "|" (one-or-more not-newline) "\n"
            (one-or-more blank) "|" (zero-or-more blank) (one-or-more "~") "\n"
            "Warning - "(message (one-or-more not-newline)
                                 (zero-or-more "\n" (one-or-more not-newline))))
   (error line-start
          (file-name)
          ":"
          line
          ":"
          column
          "-"
          end-column
          ":" line-end "\n"
          (one-or-more blank) "|\n"
          (one-or-more digit) (one-or-more blank) "|" (one-or-more not-newline) "\n"
          (one-or-more blank) "|" (zero-or-more blank) (one-or-more "~") "\n"
          (one-or-more not-newline) "\n"
          (one-or-more blank) (one-or-more not-newline) "\n\n"
          (message (one-or-more not-newline)
                   (zero-or-more "\n" (one-or-more not-newline)))))
  :error-filter delete-dups
  :modes idris-mode)


(flycheck-define-checker idris2
  "An Idris2 syntax and type checker."
  :command ("idris2"
            "--check" "--no-colour"
            ;; Compute the command-line options similarly to inferior-idris
            (eval (idris-compute-flags))
            source-original)
  :error-patterns ((warning line-start
                            "Warning: "
                            (message (one-or-more not-newline)
                                     (zero-or-more "\n" (one-or-more not-newline))
                                     "\n\n")
                            (one-or-more (not ":")) ;; (file-name)
                            ":"  line
                            ":"  column
                            "--" end-line
                            ":"  end-column)
                   (error line-start
                          (zero-or-one "Uncaught error: ")
                          "Error: "
                          (zero-or-one "While processing" (one-or-more (not ".")) ".")
                          (message (one-or-more not-newline)
                                   (zero-or-more "\n" (one-or-more not-newline))
                                   "\n\n")
                          (one-or-more (not ":")) ;; (file-name)
                          ":"  line
                          ":"  column
                          "--" end-line
                          ":"  end-column))
  :modes idris-mode)


;;; ###autoload
(add-to-list 'flycheck-checkers 'idris)
(add-to-list 'flycheck-checkers 'idris2)


(provide 'flycheck-idris)
;;; flycheck-idris.el ends here


================================================
FILE: idris-commands.el
================================================
;;; idris-commands.el --- Commands for Emacs passed to Idris -*- lexical-binding: t -*-

;; Copyright (C) 2013 Hannes Mehnert

;; Author: Hannes Mehnert <hannes@mehnert.org> and David Raymond Christiansen <david@davidchristiansen.dk>

;; License:
;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)
;; Therefore license is GPL

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(require 'idris-core)
(require 'idris-settings)
(require 'inferior-idris)
(require 'idris-repl)
(require 'idris-warnings)
(require 'idris-compat)
(require 'idris-info)
(require 'idris-tree-info)
(require 'idris-log)
(require 'idris-ipkg-mode)
(require 'idris-warnings-tree)
(require 'idris-hole-list)
(require 'idris-prover)
(require 'idris-common-utils)
(require 'idris-syntax)
(require 'idris-highlight-input)

(require 'cl-lib)
(require 'thingatpt)

(defvar-local idris-load-to-here nil
  "The maximum position to load.")

(defun idris-make-dirty ()
  "Mark an Idris buffer as dirty and remove the loaded region."
  (setq idris-buffer-dirty-p t)
  (when idris-loaded-region-overlay
    (delete-overlay idris-loaded-region-overlay))
  (setq idris-loaded-region-overlay nil))

(defun idris-make-clean ()
  (setq idris-buffer-dirty-p nil))

(defun idris-current-buffer-dirty-p ()
  "Check whether the current buffer's most recent version is loaded."
  (or idris-buffer-dirty-p
      (not (equal (current-buffer)
                  idris-currently-loaded-buffer))
      ;; for when we load the whole buffer
      (and (not idris-load-to-here) (not idris-loaded-region-overlay))
      ;; true when the place to load is outside the loaded region - extend region!
      (and idris-loaded-region-overlay
           idris-load-to-here
           (> (marker-position idris-load-to-here)
              (overlay-end idris-loaded-region-overlay)))))

(defun idris-position-loaded-p (pos)
  (and idris-loaded-region-overlay
       (member idris-loaded-region-overlay (overlays-at pos))
       t))

(defun idris-ensure-process-and-repl-buffer ()
  "Ensure that an Idris process is running and the Idris REPL buffer exists."
  (idris-run)
  (idris-repl-buffer))

(defun idris-switch-working-directory (new-working-directory)
  "Switch working directory to NEW-WORKING-DIRECTORY."
  (unless (string= idris-process-current-working-directory new-working-directory)
    (idris-ensure-process-and-repl-buffer)
    (let* ((path (if (> idris-protocol-version 1)
                     (prin1-to-string new-working-directory)
                   new-working-directory))
           (eval-result (idris-eval `(:interpret ,(concat ":cd " path))))
           (result-msg (or (car-safe eval-result) "")))
      ;; Check if the message from Idris contains the new directory path.
      ;; Before check drop the last character (slash) in the path
      ;; as the message does not include it.
      (if (string-match-p (file-truename (substring new-working-directory 0 -1))
                          result-msg)
          (progn
            (message result-msg)
            (setq idris-process-current-working-directory new-working-directory))
        (error "Failed to switch the working directory %s" eval-result)))))

(define-obsolete-function-alias 'idris-list-holes-on-load 'idris-list-holes "2022-12-15"
  "Use the user's settings from customize to determine whether to list the holes.")

(defun idris-possibly-make-dirty (_beginning _end _length)
  "Make the buffer dirty."
  (idris-make-dirty))
  ;; If there is a load-to-here marker and a currently loaded region, only
  ;; make the buffer dirty when the change overlaps the loaded region.
  ;; (if (and idris-load-to-here idris-loaded-region-overlay)
  ;;     (when (member idris-loaded-region-overlay
  ;;                   (overlays-in beginning end))
  ;;       (idris-make-dirty))
  ;;   ;; Otherwise just make it dirty.
  ;; (idris-make-dirty)))

(defun idris-update-loaded-region (fc)
  (if fc
      (let* ((end (assoc :end fc))
             (line (cadr end))
             (col (cl-caddr end)))
        (when (overlayp idris-loaded-region-overlay)
          (delete-overlay idris-loaded-region-overlay))
        (with-current-buffer idris-currently-loaded-buffer
          (setq idris-loaded-region-overlay
                (make-overlay (point-min)
                              (save-excursion (goto-char (point-min))
                                              (forward-line (1- line))
                                              (move-to-column (1- col))
                                              (point))
                              (current-buffer)))
          (overlay-put idris-loaded-region-overlay 'face 'idris-loaded-region-face)))

    ;; HACK: Some versions of Idris don't properly return a span for
    ;; some modules, returning () instead. Remove this (and the
    ;; surrounding (if fc)) after Idris 0.9.17, which contains a fix.
    (idris-update-loaded-region
     `((:filename ,(cdr (idris-filename-to-load)))
       (:start 1 1)
       ,`(:end ,(idris-get-line-num (point-max)) 1)))))

(defun idris-load-to (&optional pos)
  (when (not pos) (setq pos (point)))
  (setq idris-load-to-here (copy-marker pos t))
  (setq overlay-arrow-position (copy-marker (save-excursion
                                              (goto-char pos)
                                              (line-beginning-position))
                                            nil)))

(defun idris-no-load-to ()
  (setq idris-load-to-here nil)
  (setq overlay-arrow-position nil))

(defun idris-load-forward-line (&optional nlines)
  (interactive)
  (when idris-load-to-here
    (save-excursion
      (goto-char idris-load-to-here)
      (forward-line nlines)
      (idris-make-dirty)
      (idris-load-to (point)))))

(defun idris-load-backward-line ()
  (interactive)
  (idris-load-forward-line -1))

(defun idris-filename-to-load ()
  "Compute the working directory and filename to load in Idris.
Returning these as a cons."
  (let* ((ipkg-file (car-safe (idris-find-file-upwards "ipkg")))
         (file-name (buffer-file-name))
         (work-dir (directory-file-name (idris-file-name-parent-directory (or ipkg-file file-name))))
         (source-dir (or (idris-ipkg-find-src-dir) work-dir)))
    ;; TODO: Update once https://github.com/idris-lang/Idris2/issues/3310 is resolved
    (if (> idris-protocol-version 1)
        (cons work-dir (file-relative-name file-name work-dir))
      (cons source-dir (file-relative-name file-name source-dir)))))

(defun idris-load-file (&optional set-line)
  "Pass the current buffer's file to the inferior Idris process.
A prefix argument SET-LINE forces loading but only up to the current line."
  (interactive "p")
  (save-buffer)
  (idris-ensure-process-and-repl-buffer)
  (when (and set-line (= set-line 4))
    (idris-load-to (point))
    (idris-make-dirty))
  (when (and set-line (= set-line 16)) (idris-no-load-to))
  (if (buffer-file-name)
      (when (idris-current-buffer-dirty-p)
        (when idris-prover-currently-proving
          (if (y-or-n-p (format "%s is open in the prover. Abandon and load? "
                                idris-prover-currently-proving))
              (idris-prover-abandon)
            (signal 'quit nil)))
        ;; Remove warning overlays
        (idris-warning-reset-all)
        ;; Clear the contents of the compiler notes buffer, if it exists
        (when (get-buffer idris-notes-buffer-name)
          (with-current-buffer idris-notes-buffer-name
            (let ((inhibit-read-only t)) (erase-buffer))))
        ;; Actually do the loading
        (let* ((dir-and-fn (idris-filename-to-load))
               (fn (cdr dir-and-fn))
               (srcdir (car dir-and-fn))
               (idris-semantic-source-highlighting (idris-buffer-semantic-source-highlighting)))
          (setq idris-currently-loaded-buffer nil)
          (idris-switch-working-directory srcdir)
          (idris-delete-ibc t) ;; delete the ibc to avoid interfering with partial loads
          (idris-toggle-semantic-source-highlighting)
          (idris-eval-async
           (if idris-load-to-here
               `(:load-file ,fn ,(idris-get-line-num idris-load-to-here))
             `(:load-file ,fn))
           (lambda (result)
             (pcase result
               (`(:highlight-source ,hs)
                (idris-highlight-source-file hs))
               (_ (idris-make-clean)
                  (idris-update-options-cache)
                  (setq idris-currently-loaded-buffer (current-buffer))
                  (when (member 'warnings-tree idris-warnings-printing)
                    (idris-list-compiler-notes))
                  (run-hooks 'idris-load-file-success-hook)
                  (idris-update-loaded-region result))))
           (lambda (_condition)
             (when (member 'warnings-tree idris-warnings-printing)
               (idris-list-compiler-notes))))))
    (user-error "Cannot find file for current buffer")))

(defun idris-view-compiler-log ()
  "Jump to the log buffer, if it is open."
  (interactive)
  (let ((buffer (get-buffer idris-log-buffer-name)))
    (if buffer
        (pop-to-buffer buffer)
      (message "No Idris compiler log is currently open"))))

(defun idris-next-error ()
  "Jump to the next error overlay in the buffer."
  (interactive)
  (let ((warnings-forward (sort (cl-remove-if-not #'(lambda (w) (> (overlay-start w) (point))) idris-warnings)
                                #'(lambda (w1 w2) (<= (overlay-start w1) (overlay-start w2))))))
    (if warnings-forward
        (goto-char (overlay-start (car warnings-forward)))
      (user-error "No warnings or errors until end of buffer"))))

(defun idris-previous-error ()
  "Jump to the previous error overlay in the buffer."
  (interactive)
  (let ((warnings-backward (sort (cl-remove-if-not #'(lambda (w) (< (overlay-end w) (point))) idris-warnings)
                                 #'(lambda (w1 w2) (>= (overlay-end w1) (overlay-end w2))))))
    (if warnings-backward
        (goto-char (overlay-end (car warnings-backward)))
      (user-error "No warnings or errors until beginning of buffer"))))

(defun idris-load-file-sync ()
  "Pass the current buffer's file synchronously to the inferior Idris process.
This sets the load position to point, if there is one."
  (save-buffer)
  (idris-ensure-process-and-repl-buffer)
  (if (buffer-file-name)
      (unless (idris-position-loaded-p (point))
        (idris-warning-reset-all)
        (when (and idris-load-to-here
                   (< (marker-position idris-load-to-here) (point)))
          (idris-load-to (point)))
        (let* ((dir-and-fn (idris-filename-to-load))
               (fn (cdr dir-and-fn))
               (srcdir (car dir-and-fn)))
          (setq idris-currently-loaded-buffer nil)
          (idris-switch-working-directory srcdir)
          (let ((result
                 (idris-eval
                  (if idris-load-to-here
                      `(:load-file ,fn ,(idris-get-line-num idris-load-to-here))
                    `(:load-file ,fn)))))
            (idris-update-options-cache)
            (setq idris-currently-loaded-buffer (current-buffer))
            (idris-make-clean)
            (idris-update-loaded-region (car result)))))
    (user-error "Cannot find file for current buffer")))



(defun idris-info-for-name (command name)
  "Pass to Idris compiler COMMAND with NAME as argument and display the result."
  (let* ((ty (idris-eval (list command name)))
         (result (car ty))
         (formatting (cdr ty)))
    (idris-show-info (format "%s" result) formatting)))


(defun idris-type-at-point (thing)
  "Display the type of the THING at point, considered as a global variable."
  (interactive "P")
  (let ((name (if thing (read-string "Check: ")
                (idris-name-at-point))))
    (when (idris-current-buffer-dirty-p)
      (idris-load-file-sync))
    (when name
      (idris-info-for-name :type-of name))))

(defun idris--print-definition-of-name (name)
  "Fetch from the Idris compiler and display the definition of the NAME."
  (if (>=-protocol-version 2 1)
      (idris-info-for-name :interpret (concat ":printdef " name))
    (idris-info-for-name :print-definition name)))

(defun idris-print-definition-of-name-at-point (name)
  "Display the definition of the function or type of the NAME at point.

Idris 2 as of 05/01/2023 does not yet fully support
printing definition of a type at point."
  (interactive "P")
  (let ((name* (if name
                   (read-string "Print definition: ")
                 (idris-name-at-point))))
    (when name*
      (idris--print-definition-of-name name*))))

(define-obsolete-function-alias 'idris-print-definition-of-name 'idris-print-definition-of-name-at-point "2023-01-05")

(defun idris-who-calls-name (name)
  "Show the callers of NAME in a tree."
  (let* ((callers (idris-eval `(:who-calls ,name)))
         (roots (mapcar #'(lambda (c) (idris-caller-tree c :who-calls))
                        (car callers))))
    (if (not (null roots))
        (idris-tree-info-show-multiple roots "Callers")
      (message "The name %s was not found." name))
    nil))

(defun idris-who-calls-name-at-point (thing)
  (interactive "P")
  (let ((name (if thing (read-string "Who calls: ")
                (idris-name-at-point))))
    (when name
      (idris-who-calls-name name))))

(defun idris-name-calls-who (name)
  "Show the callees of NAME in a tree."
  (let* ((callees (idris-eval `(:calls-who ,name)))
         (roots (mapcar #'(lambda (c) (idris-caller-tree c :calls-who)) (car callees))))
    (if (not (null roots))
        (idris-tree-info-show-multiple roots "Callees")
      (message "The name %s was not found." name))
    nil))

(defun idris-name-calls-who-at-point (thing)
  (interactive "P")
  (let ((name (if thing (read-string "Calls who: ")
                (idris-name-at-point))))
    (when name
      (idris-name-calls-who name))))

(defun idris-browse-namespace (namespace)
  "Show the contents of NAMESPACE in a tree info buffer."
  (interactive
   ;; Compute a default namespace for the prompt based on the text
   ;; annotations at point when called interactively. Overlays are
   ;; preferred over text properties.
   (let ((default
           (or (cl-some #'(lambda (o) (overlay-get o 'idris-namespace))
                        (overlays-at (point)))
               (get-text-property (point) 'idris-namespace))))
     (list (read-string "Browse namespace: " default))))
  (idris-tree-info-show (idris-namespace-tree namespace)
                        "Browse Namespace"))

(defun idris-caller-tree (caller cmd)
  "Display a tree from an IDE CALLER list.
Using CMD lazily retrieve a few levels at a time from Idris compiler."
  (pcase caller
    (`((,name ,highlight) ,children)
     (make-idris-tree
      :item name
      :highlighting highlight
      :collapsed-p t
      :kids (lambda ()
              (cl-mapcan #'(lambda (child)
                             (let ((child-name (caar (idris-eval `(,cmd ,(car child))))))
                               (if child-name
                                   (list (idris-caller-tree child-name cmd))
                                 nil)))
                         children))
      :preserve-properties '(idris-tt-tree)))
    (_ (error "Failed to make tree from %s" caller))))

(defun idris-namespace-tree (namespace &optional recursive)
  "Create a tree of the contents of NAMESPACE.
Lazily retrieve children when RECURSIVE is non-nil."
  (cl-flet*
      ;; Show names as childless trees with decorated roots
      ((name-tree (n) (make-idris-tree :item (car n)
                                       :highlighting (cadr n)
                                       :kids nil
                                       :preserve-properties '(idris-tt-tree)))
       ;; The children of a tree are the namespaces followed by the names.
       (get-children (sub-namespaces names)
                     (append (mapcar #'(lambda (ns)
                                         (idris-namespace-tree ns t))
                                     sub-namespaces)
                             (mapcar #'name-tree names))))
    (let ((highlight `((0 ,(length namespace)
                          ((:decor :namespace)
                           (:namespace ,namespace))))))
      (if recursive
          ;; In the recursive case, generate a collapsed tree and lazily
          ;; get the contents as expansion is requested
          (make-idris-tree
           :item namespace
           :highlighting highlight
           :collapsed-p t
           :kids (lambda ()
                   (pcase (idris-eval `(:browse-namespace ,namespace))
                     (`((,sub-namespaces ,names . ,_))
                      (get-children sub-namespaces names))
                     (_ nil)))
           :preserve-properties '(idris-tt-term))
        ;; In the non-recursive case, generate an expanded tree with the
        ;; first level available, but only if the namespace actually makes
        ;; sense
        (pcase (idris-eval `(:browse-namespace ,namespace))
          (`((,sub-namespaces ,names . ,_))
           (make-idris-tree
            :item namespace
            :highlighting highlight
            :collapsed-p nil
            :kids (get-children sub-namespaces names)
            :preserve-properties '(idris-tt-term)))
          (_ (error "Invalid namespace %s" namespace)))))))

(defun idris-newline-and-indent ()
  "Indent a new line like the current one by default."
  (interactive)
  (let ((indent ""))
    (save-excursion
      (move-beginning-of-line nil)
      (when (looking-at (if (idris-lidr-p) "^\\(>\\s-*\\)" "\\(\\s-*\\)"))
        (setq indent (match-string 1))))
    (insert "\n" indent)))

(defun idris-delete-forward-char (n &optional killflag)
  "Delete the following N characters (previous if N is negative).
If the current buffer is in `idris-mode' and the file being
edited is a literate Idris file, deleting the end of a line will
take into account bird tracks.  If Transient Mark mode is
enabled, the mark is active, and N is 1, delete the text in the
region and deactivate the mark instead.
To disable this, set variable `delete-active-region' to nil.

Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete.  Interactively, N is the prefix arg, and
KILLFLAG is set if N was explicitly specified."
  (interactive "p\nP")
  (unless (integerp n)
    (signal 'wrong-type-argument (list 'integerp n)))
  (cond
   ;; Under the circumstances that `delete-forward-char' does something
   ;; special, delegate to it. This was discovered by reading the source to
   ;; it.
   ((and (use-region-p)
         delete-active-region
         (= n 1))
    (call-interactively 'delete-forward-char n killflag))
   ;; If in idris-mode and editing an LIDR file and at the end of a line,
   ;; then delete the newline and a leading >, if it exists
   ((and (eq major-mode 'idris-mode)
         (idris-lidr-p)
         (= n 1)
         (eolp))
    (delete-char 1 killflag)
    (when (and (not (eolp)) (equal (following-char) ?\>))
      (delete-char 1 killflag)
      (when (and (not (eolp)) (equal (following-char) ?\ ))
        (delete-char 1 killflag))))
   ;; Nothing special to do - delegate to `delete-char', just as
   ;; `delete-forward-char' does
   (t (delete-char 1 killflag))))


(defun idris-apropos (what)
  "Look up WHAT in names, type signatures, and docstrings."
  (interactive "sSearch Idris docs for: ")
  (idris-info-for-name :apropos what))

(defun idris-type-search (what)
  "Search the Idris libraries for WHAT by fuzzy type matching."
  (interactive "sSearch for type: ")
  (idris-info-for-name :interpret (concat ":search " what)))

(defun idris-docs-at-point (thing)
  "Display the internal documentation for the THING (name at point).
Considered as a global variable"
  (interactive "P")
  (let ((name (if thing (read-string "Docs: ")
                (idris-name-at-point))))
    (when name
      (idris-info-for-name :docs-for name))))

(defun idris-eldoc-lookup ()
  "Return Eldoc string associated with the thing at point."
  (get-char-property (point) 'idris-eldoc))

(defun idris-pretty-print ()
  "Get a term or definition pretty-printed by Idris.
Useful for writing papers or slides."
  (interactive)
  (let ((what (read-string "What should be pretty-printed? "))
        (fmt (completing-read "What format? " '("html", "latex") nil t nil nil "latex"))
        (width (read-string "How wide? " nil nil "80")))
    (if (<= (string-to-number width) 0)
        (user-error "Width must be positive")
      (if (< (length what) 1)
          (user-error "Nothing to pretty-print")
        (let ((text (idris-eval `(:interpret ,(concat ":pprint " fmt " " width " " what)))))
          (with-idris-info-buffer
            (insert (car text))
            (goto-char (point-min))
            (re-search-forward (if (string= fmt "latex")
                                   "% START CODE\n"
                                 "<!-- START CODE -->"))
            (push-mark nil t)
            (re-search-forward (if (string= fmt "latex")
                                   "% END CODE\n"
                                 "<!-- END CODE -->"))
            (goto-char (match-beginning 0))
            (copy-region-as-kill (mark) (point))
            (message "Code copied to kill ring")))))))


(defun idris-case-split ()
  "Case split the pattern variable at point."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)
      (let ((result (car (idris-eval `(:case-split ,(cdr what) ,(car what)))))
            (initial-position (point)))
        (if (<= (length result) 2)
            (message "Can't case split %s" (car what))
          (delete-region (line-beginning-position) (line-end-position))
          (if (> idris-protocol-version 1)
              (insert (substring result 0 (length result)))
            (insert (substring result 0 (1- (length result)))))
          (goto-char initial-position))))))

(defun idris-make-cases-from-hole ()
  "Make a case expression from the metavariable at point."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)
      (let ((result (car (idris-eval `(:make-case ,(cdr what) ,(car what))))))
        (if (<= (length result) 2)
            (message "Can't make cases from %s" (car what))
          (delete-region (line-beginning-position) (line-end-position))
          (if (> idris-protocol-version 1)
              (insert (substring result 0 (length result)))
            (insert (substring result 0 (1- (length result)))))
          (search-backward "_ of\n"))))))

(defun idris-case-dwim ()
  "If point is on a hole name, make it into a case expression.
Otherwise, case split as a pattern variable."
  (interactive)
  (cond
   ((looking-at-p "\\?[a-zA-Z_]+") ;; point at "?" in ?hole_rs1
    (forward-char) ;; move from "?" for idris-make-cases-from-hole to work correctly
    (idris-make-cases-from-hole))
   ((or (and (char-equal (char-before) ??) ;; point at "h" in ?hole_rs1
             (looking-at-p "[a-zA-Z_]+"))
        (looking-back "\\?[a-zA-Z0-9_]+" nil)) ;; point somewhere afte "?h" in ?hole_rs1
    (idris-make-cases-from-hole))
   (t (idris-case-split))))

(defun idris-line-indentation-for (thing)
  "Return the indentation prefix string for the line indicated by THING.

THING should be an Idris source location object, where the cdr gives the
1-based line number of the expression the current command was invoked on.

The return value is the leading whitespace of that line.
For Idris protocol versions <= 1, the prefix may also include a leading ‘>’.
If no indentation is found, return the empty string."
  (save-excursion
    (goto-char (point-min))
    (forward-line (1- (cdr thing)))
    (goto-char (line-beginning-position))
    (re-search-forward (if (> idris-protocol-version 1)
                           "^\\(\\s-*\\)"
                         "\\(^>?\\s-*\\)")
                       nil t)
    (or (match-string 1) "")))

(defun idris-add-clause (proof)
  "Add clauses to the declaration at point."
  (interactive "P")
  (let ((what (idris-thing-at-point))
        (command (if proof :add-proof-clause :add-clause)))
    (when (car what)
      (idris-load-file-sync)
      (let ((result (string-trim-left (car (idris-eval `(,command ,(cdr what) ,(car what))))))
            final-point
            (prefix (idris-line-indentation-for what)))
        ;; Go forward until we get to a line with equal or less indentation to
        ;; the type declaration, or the end of the buffer, and insert the
        ;; result
        (goto-char (line-beginning-position))
        (forward-line)
        (while (and (not (eobp))
                    (progn (goto-char (line-beginning-position))
                           ;; this will be true if we're looking at the prefix
                           ;; with extra whitespace
                           (looking-at-p (concat prefix "\\s-+"))))
          (forward-line))
        (insert prefix)
        (setq final-point (point)) ;; Save the location of the start of the clause
        (insert result)
        (newline)
        (goto-char final-point))))) ;; Put the cursor on the start of the inserted clause

(defun idris-add-missing ()
  "Add missing cases."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)
      (let ((result (car (idris-eval `(:add-missing ,(cdr what) ,(car what))))))
        (forward-line 1)
        (insert result)))))

(defun idris-make-with-block ()
  "Add with block."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)
      (let ((result (car (idris-eval `(:make-with ,(cdr what) ,(car what))))))
        (beginning-of-line)
        (kill-line)
        (insert result)))))

(defun idris-make-lemma ()
  "Extract lemma from hole."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)
      (let* ((result (car (idris-eval `(:make-lemma ,(cdr what) ,(car what)))))
             (lemma-type (car result)))
        ;; There are two cases here: either a ?hole, or the {name} of a provisional defn.
        (cond ((equal lemma-type :metavariable-lemma)
               (let ((lem-app (cadr (assoc :replace-metavariable (cdr result))))
                     (type-decl (cadr (assoc :definition-type (cdr result)))))
                 ;; replace the hole
                 ;; assume point is on the hole right now!
                 (while (not (looking-at "\\?[a-zA-Z0-9?_]+"))
                   (backward-char 1))
                 ;; now we're on the ? - we just matched the metavar
                 (replace-match lem-app)

                 ;; now we add the type signature - search upwards for the current
                 ;; signature, then insert before it
                 (re-search-backward (if (idris-lidr-p)
                                         "^\\(>\\s-*\\)\\(([^)]+)\\|[a-zA-Z_0-9]+\\)\\s-*:"
                                       "^\\(\\s-*\\)\\(([^)]+)\\|[a-zA-Z_0-9]+\\)\\s-*:"))
                 (let ((indentation (match-string 1))
                       end-point)
                   (beginning-of-line)

                   ;; make sure we are above the documentation string
                   (forward-line -1)
                   (while (and (not (looking-at-p "^\\s-*$"))
                               (not (equal (point) (point-min)))
                               (or (looking-at-p "^|||") (looking-at-p "^--")))
                     (forward-line -1))

                   ;; if we reached beginning of file
                   ;; add new line between the type signature and the lemma
                   (if (equal (point) (point-min))
                       (progn
                         (newline 1)
                         (forward-line -1))
                     ;; otherwise find first non empty line
                     (forward-line -1)
                     (when (looking-at-p "^.*\\S-.*$")
                       (forward-line 1)
                       (newline 1)))

                   (insert indentation)
                   (setq end-point (point))
                   (insert type-decl)
                   (newline 1)
                   ;; make sure point ends up ready to start a new pattern match
                   (goto-char end-point))))
              ((equal lemma-type :provisional-definition-lemma)
               (let ((clause (cadr (assoc :definition-clause (cdr result)))))
                 ;; Insert the definition just after the current definition
                 ;; This can either be before the next type definition or at the end of
                 ;; the buffer, if there is no next type definition
                 (let ((next-defn-point
                        (re-search-forward (if (idris-lidr-p)
                                               "^\\(>\\s-*\\)\\(([^)]+)\\|\\w+\\)\\s-*:"
                                             "^\\(\\s-*\\)\\(([^)]+)\\|\\w+\\)\\s-*:")
                                           nil t)))
                   (if next-defn-point ;; if we found a definition
                       (let ((indentation (match-string 1)) end-point)
                         (goto-char next-defn-point)
                         (beginning-of-line)
                         (insert indentation)
                         (setq end-point (point))
                         (insert clause)
                         (newline 2)
                         ;; make sure point is at new defn
                         (goto-char end-point))
                     ;; otherwise it goes at the end of the buffer
                     (let ((end (point-max)))
                       (goto-char end)
                       (insert clause)
                       (newline)
                       ;; make sure point is at new defn
                       (goto-char end)))))))))))

(defun idris-compile-and-execute ()
  "Execute the program in the current buffer."
  (interactive)
  (idris-load-file-sync)
  (if (>=-protocol-version 2 1)
      (let ((name (read-string "MExpression to compile & execute (default main): "
                               nil nil "main")))
        (idris-repl-eval-string (format ":exec %s" name) 0))
    (idris-eval '(:interpret ":exec"))))

(defun idris-replace-hole-with (expr)
  "Replace the hole under the cursor by some EXPR."
  (save-excursion
    (let ((start (progn (search-backward "?") (point)))
          (end (progn (forward-char) (search-forward-regexp "[^a-zA-Z0-9_']")
                      (backward-char) (point))))
      (delete-region start end))
    (insert expr)))

(defvar-local proof-region-start nil
  "The start position of the last proof region.")
(defvar-local proof-region-end nil
  "The end position of the last proof region.")

(defun idris-proof-search (&optional arg)
  "Invoke the proof search.
A plain prefix ARG causes the command to prompt for hints and recursion
 depth, while a numeric prefix argument sets the recursion depth directly."
  (interactive "P")
  (let ((hints (if (consp arg)
                   (split-string (read-string "Hints: ") "[^a-zA-Z0-9']")
                 '()))
        (depth (cond ((consp arg)
                      (let ((input (string-to-number (read-string "Search depth: "))))
                        (if (= input 0)
                            nil
                          (list input))))
                     ((numberp arg)
                      (list arg))
                     (t nil)))
        (what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)

      (let ((result (car (if (> idris-protocol-version 1)
                             (idris-eval `(:proof-search ,(cdr what) ,(car what)))
                           (idris-eval `(:proof-search ,(cdr what) ,(car what) ,hints ,@depth))
                           ))))
        (if (string= result "")
            (user-error "Nothing found")
          (idris-replace-hole-with result))))))

(defun idris-proof-search-next ()
  "Replace the previous proof search result with the next one, if it exists.
Idris 2 only."
  (interactive)
  (if (not proof-region-start)
      (user-error "You must proof search first before looking for subsequent proof results")
    (let ((result (car (idris-eval `:proof-search-next))))
      (if (string= result "No more results")
          (message "No more results")
        (save-excursion
          (goto-char proof-region-start)
          (delete-region proof-region-start proof-region-end)
          (setq proof-region-start (point))
          (insert result)
          (setq proof-region-end (point)))))))

(defvar-local def-region-start nil)
(defvar-local def-region-end nil)

(defun idris-generate-def ()
  "Generate definition."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (when (car what)
      (idris-load-file-sync)
      (let ((result (car (idris-eval `(:generate-def ,(cdr what) ,(car what)))))
            final-point
            (prefix (idris-line-indentation-for what)))
        (if (string= result "")
            (user-error "Nothing found")
          (beginning-of-line)
          (forward-line)
          (while (and (not (eobp))
                      (progn (beginning-of-line)
                             (looking-at-p (concat prefix "\\s-+"))))
            (forward-line))
          (insert prefix)
          (setq final-point (point))
          (setq def-region-start (point))
          (insert result)
          (setq def-region-end (point))
          (newline)
          (goto-char final-point))))))

(defun idris-generate-def-next ()
  "Replace the previous generated definition with next definition, if it exists.
Idris 2 only."
  (interactive)
  (if (not def-region-start)
      (user-error "You must program search first before looking for subsequent program results")
    (let ((result (car (idris-eval `:generate-def-next))))
      (if (string= result "No more results")
          (message "No more results")
        (save-excursion
          (goto-char def-region-start)
          (delete-region def-region-start def-region-end)
          (setq def-region-start (point))
          (insert result)
          (setq def-region-end (point)))))))

(defun idris-intro ()
  "Introduce the unambiguous constructor to use in this hole."
  (interactive)
  (let ((what (idris-thing-at-point)))
    (unless (car what)
      (user-error "Could not find a hole at point to refine by"))
    (idris-load-file-sync)
    (let ((results (car (idris-eval `(:intro ,(cdr what) ,(car what))))))
      (pcase results
        (`(,result) (idris-replace-hole-with result))
        (_ (idris-replace-hole-with (ido-completing-read "I'm hesitating between: " results)))))))

(defun idris-refine (name)
  "Refine by some NAME, without recursive proof search."
  (interactive "MRefine by: ")
  (let ((what (idris-thing-at-point)))
    (unless (car what)
      (user-error "Could not find a hole at point to refine by"))
    (idris-load-file-sync)
    (let ((result (car (idris-eval `(:refine ,(cdr what) ,(car what) ,name)))))
      (idris-replace-hole-with result))))

(defun idris-identifier-backwards-from-point ()
  (let (identifier-start
        (identifier-end (point))
        (failure (list nil nil nil)))
    (save-excursion
      (while (and (> (point) (point-min)) (idris-is-ident-char-p (char-before)))
        (backward-char)
        (setq identifier-start (point)))
      (if identifier-start
          (list (buffer-substring-no-properties identifier-start identifier-end)
                identifier-start
                identifier-end)
        failure))))

(defun idris-complete-symbol-at-point ()
  "Attempt to complete the symbol at point as a global variable.

This function does not attempt to load the buffer if it's not
already loaded, as a buffer awaiting completion is probably not
type-correct, so loading will fail."
  (if (not idris-process)
      nil
    (when idris-completion-via-compiler
      (cl-destructuring-bind (identifier start end) (idris-identifier-backwards-from-point)
        (when identifier
          (let ((result (car (idris-eval `(:repl-completions ,identifier)))))
            (cl-destructuring-bind (completions _partial) result
              (if (null completions)
                  nil
                (list start end completions
                      :exclusive 'no)))))))))

(defun idris-complete-keyword-at-point ()
  "Attempt to complete the symbol at point as an Idris keyword."
  (pcase-let* ((all-idris-keywords
                (append idris-keywords idris-definition-keywords))
               (`(,identifier ,start ,end)
                (idris-identifier-backwards-from-point)))
    (when identifier
      (let ((candidates (cl-remove-if-not
                         (apply-partially #'string-prefix-p identifier)
                         all-idris-keywords)))
        (if (null candidates)
            nil
          (list start end candidates
                :exclusive 'no))))))

(defun idris-list-holes ()
  "Get a list of currently open holes."
  (interactive)
  (when (idris-current-buffer-dirty-p)
    (idris-load-file-sync))
  (idris-hole-list-show (car (idris-eval '(:metavariables 80)))))

(defun idris-list-compiler-notes ()
  "Show the compiler notes in tree view."
  (interactive)
  (with-temp-message "Preparing compiler note tree..."
    (idris-compiler-notes-list-show (reverse idris-raw-warnings))))

(defun idris-kill-buffers ()
  ;; not killing :events since it it tremendously useful for debuging
  (let ((bufs (list :repl :proof-obligations :proof-shell :proof-script :log :info :notes :holes :tree-viewer)))
    (dolist (b bufs) (idris-kill-buffer b))))

(defun idris-remove-event-hooks ()
  "Remove Idris event hooks set after connection with Idris established."
  (dolist (h idris-event-hooks) (remove-hook 'idris-event-hooks h)))

(define-obsolete-function-alias 'idris-pop-to-repl 'idris-switch-to-repl "2022-12-28")

(defun idris-switch-to-last-idris-buffer ()
  "Switch to the last Idris buffer.
The default keybinding for this command is
the same as for command `idris-switch-to-repl',
so it is convenient to jump between Idris code and REPL.

Inspired by `cider-switch-to-last-clojure-buffer'
https://github.com/clojure-emacs/cider"
  (interactive)
  (if (derived-mode-p 'idris-repl-mode)
      (let ((idris-buffer (seq-find
                           (lambda (b) (eq 'idris-mode (buffer-local-value 'major-mode b)))
                           (buffer-list))))
        (if idris-buffer
            (pop-to-buffer idris-buffer `(display-buffer-reuse-window))
          (user-error "No Idris buffer found")))
    (user-error "Not in a Idris REPL buffer")))

(defun idris-run ()
  "Run an inferior Idris process."
  (interactive)
  (let ((command-line-flags (idris-compute-flags)))
    ;; Kill the running Idris if the command-line flags need updating
    (when (and (get-buffer-process idris-connection-buffer-name)
               (not (equal command-line-flags idris-current-flags)))
      (message "Idris command line arguments changed, restarting Idris")
      (idris-quit)
      (sit-for 0.01)) ; allows the sentinel to run and reset idris-process
    ;; Start Idris if necessary
    (when (not idris-process)
      (setq idris-process
            (get-buffer-process
             (apply #'make-comint-in-buffer
                    "idris"
                    idris-process-buffer-name
                    idris-interpreter-path
                    nil
                    "--ide-mode-socket"
                    command-line-flags)))
      (with-current-buffer idris-process-buffer-name
        (add-hook 'comint-preoutput-filter-functions
                  'idris-process-filter
                  nil
                  t)
        (add-hook 'comint-output-filter-functions
                  'idris-show-process-buffer
                  nil
                  t))
      (set-process-sentinel idris-process 'idris-sentinel)
      (setq idris-current-flags command-line-flags)
      (accept-process-output idris-process 3))))

(defun idris-quit ()
  "Quit the Idris process, cleaning up the state synchronized with Emacs."
  (interactive)
  (if (get-buffer-process idris-process-buffer-name)
      (delete-process idris-process-buffer-name))
  (if (get-buffer-process idris-connection-buffer-name)
      (delete-process idris-connection-buffer-name))
  (if (get-buffer idris-process-buffer-name)
      (kill-buffer idris-process-buffer-name))
  (if (get-buffer idris-connection-buffer-name)
      (kill-buffer idris-connection-buffer-name))
  (if idris-loaded-region-overlay
      (delete-overlay idris-loaded-region-overlay))
  (idris-prover-end)
  (idris-warning-reset-all)
  (idris-remove-event-hooks)
  (idris-kill-buffers)
  (setq idris-loaded-region-overlay nil
        idris-currently-loaded-buffer nil
        idris-rex-continuations '()
        idris-process-current-working-directory nil
        idris-protocol-version 0
        idris-protocol-version-minor 0))

(defun idris-delete-ibc (no-confirmation)
  "Delete the IBC file for the current buffer.
When NO-CONFIRMATION argument is set to t the deletion will be
performed silently without confirmation from the user."
  (interactive "P")
  (unless (> idris-protocol-version 1)
    (let* ((fname (buffer-file-name))
           (ibc (concat (file-name-sans-extension fname) ".ibc")))
      (if (not (member (file-name-extension fname)
                       '("idr" "lidr" "org" "markdown" "md")))
          (user-error "The current file is not an Idris file")
        (when (or no-confirmation (y-or-n-p (concat "Really delete " ibc "?")))
          (when (file-exists-p ibc)
            (delete-file ibc)
            (message "%s deleted" ibc)))))))

(defun idris--active-term-beginning (term pos)
  "Find the beginning of active term TERM that occurs at POS.

It is an error if POS is not in the specified term. TERM should
be Idris's own serialization of the term in question."
  (unless (equal (get-char-property pos 'idris-tt-term) term)
    (user-error "Term not present at %s" pos))
  (save-excursion
    ;; Find the beginning of the active term
    (goto-char pos)
    (while (equal (get-char-property (point) 'idris-tt-term)
                  term)
      (backward-char 1))
    (forward-char 1)
    (point)))

(defun idris-make-term-menu (_term)
  "Make a menu for the widget for some term."
  (let ((menu (make-sparse-keymap)))
    (define-key menu [idris-term-menu-normalize]
      `(menu-item "Normalize"
                  (lambda () (interactive))))
    (define-key-after menu [idris-term-menu-show-implicits]
      `(menu-item "Show implicits"
                  (lambda () (interactive))))
    (define-key-after menu [idris-term-menu-hide-implicits]
      `(menu-item "Hide implicits"
                  (lambda () (interactive))))
    (define-key-after menu [idris-term-menu-core]
      `(menu-item "Show core"
                  (lambda () (interactive))))
    menu))

(defun idris-insert-term-widget (term)
  "Make a widget for interacting with the TERM."
  (let ((inhibit-read-only t)
        (start-pos (copy-marker (point)))
        (end-pos (copy-marker (idris-find-term-end (point) 1)))
        (buffer (current-buffer)))
    (insert-before-markers
     (propertize
      "▶"
      'face 'idris-active-term-face
      'mouse-face 'highlight
      'idris-term-widget term
      'help-echo "<mouse-3>: term menu"
      'keymap (let ((map (make-sparse-keymap)))
                (define-key map [mouse-3]
                  (lambda () (interactive)
                    (let ((selection
                           (x-popup-menu t (idris-make-term-menu term))))
                      (cond ((equal selection
                                    '(idris-term-menu-normalize))
                             (idris-normalize-term start-pos buffer)
                             (idris-remove-term-widgets))
                            ((equal selection
                                    '(idris-term-menu-show-implicits))
                             (idris-show-term-implicits start-pos buffer)
                             (idris-remove-term-widgets))
                            ((equal selection
                                    '(idris-term-menu-hide-implicits))
                             (idris-hide-term-implicits start-pos buffer)
                             (idris-remove-term-widgets))
                            ((equal selection
                                    '(idris-term-menu-core))
                             (idris-show-core-term start-pos buffer)
                             (idris-remove-term-widgets))))))
                map)))
    (let ((term-overlay (make-overlay start-pos end-pos)))
      ;; TODO: delete the markers now that they're not useful
      (overlay-put term-overlay 'idris-term-widget term)
      (overlay-put term-overlay 'face 'idris-active-term-face))))

(defun idris-add-term-widgets ()
  "Add interaction widgets to annotated terms."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let (term)
      (while (setq term (idris-search-property 'idris-tt-term))
        (idris-insert-term-widget term)))))

(defun idris-remove-term-widgets (&optional buffer)
  "Remove interaction widgets from annotated terms in BUFFER."
  (interactive)
  (with-current-buffer (or buffer (current-buffer))
    (save-excursion
      (let ((inhibit-read-only t))
        (mapc (lambda (overlay)
                (when (overlay-get overlay 'idris-term-widget)
                  (delete-overlay overlay)))
              (overlays-in (point-min) (point-max)))
        (goto-char (point-min))
        (while (idris-search-property 'idris-term-widget)
          (delete-char 1))))))

(defun idris-show-term-implicits (position &optional buffer)
  "Replace the term at POSITION in BUFFER with a fully-explicit version."
  (interactive "d")
  (idris-active-term-command position :show-term-implicits buffer))

(defun idris-hide-term-implicits (position &optional buffer)
  "Replace the term at POSITION in BUFFER with a fully-implicit version."
  (interactive "d")
  (idris-active-term-command position :hide-term-implicits buffer))

(defun idris-normalize-term (position &optional buffer)
  "Replace the term at POSITION in BUFFER with a normalized version."
  (interactive "d")
  (idris-active-term-command position :normalise-term buffer))

(defun idris-show-core-term (position &optional buffer)
  "Replace the term at POSITION in BUFFER with the corresponding core term."
  (interactive "d")
  (idris-active-term-command position :elaborate-term buffer))

(defun idris-active-term-command (position cmd &optional buffer)
  "For the term at POSITION in BUFFER, run the live term command (CMD)."
  (unless (member cmd '(:show-term-implicits
                        :hide-term-implicits
                        :normalise-term
                        :elaborate-term))
    (error "Invalid term command %s" cmd))
  (with-current-buffer (or buffer (current-buffer))
    (let ((term (plist-get (text-properties-at position) 'idris-tt-term)))
      (if (null term)
          (error "No term here")
        (let* ((res (car (idris-eval (list cmd term))))
               (new-term (car res))
               (spans (cadr res))
               (col (save-excursion (goto-char (idris-find-term-end position -1))
                                    (current-column)))
               (rendered
                (with-temp-buffer
                  (idris-propertize-spans (idris-repl-semantic-text-props spans)
                    (insert new-term))
                  ;; Indent the new term properly, if it's annotated
                  (let ((new-tt-term (plist-get (text-properties-at (point-min)) 'idris-tt-term)))
                    (when new-tt-term
                      (goto-char (point-min))
                      (when (= (forward-line 1) 0)
                        (indent-rigidly (point) (point-max) col))
                      (put-text-property (point-min) (point-max) 'idris-tt-term new-tt-term)))
                  (buffer-string))))
          (idris-replace-term-at position rendered))))))

(defun idris-find-term-end (pos step)
  "Find an end of the term at POS, moving STEP positions in each iteration.
Return the position found."
  (unless (or (= step 1) (= step -1))
    (error "Valid values for STEP are 1 or -1"))
  ;; Can't use previous-single-property-change-position because it breaks if
  ;; point is at the beginning of the term (likewise for next/end).
  (let ((term (plist-get (text-properties-at pos) 'idris-tt-term)))
    (when (null term)
      (error "No term at %s" pos))
    (save-excursion
      (goto-char pos)
      (while (and (string= term
                           (plist-get (text-properties-at (point))
                                      'idris-tt-term))
                  (not (eobp))
                  (not (bobp)))
        (forward-char step))
      (if (= step -1)
          (1+ (point))
        (point)))))

(defun idris-replace-term-at (position new-term)
  "Replace the term at POSITION with the new rendered term NEW-TERM.
The idris-tt-term text property is used to determined the extent
of the term to replace."
  (when (null (plist-get (text-properties-at position) 'idris-tt-term))
    (error "No term here"))
  (let ((start (idris-find-term-end position -1))
        (end (idris-find-term-end position 1))
        (inhibit-read-only t))
    (save-excursion
      (delete-region start end)
      (goto-char start)
      (insert new-term))))

(defun idris-prove-hole (name &optional elab)
  "Launch the prover on the hole NAME, using Elab mode if ELAB is non-nil."
  (idris-eval-async `(:interpret ,(concat (if elab ":elab " ":p ") name))
                    (lambda (_) t))
  ;; The timer is necessary because of the async nature of starting the prover
  (run-with-timer 0.25 nil
                  #'(lambda ()
                      (let ((buffer (get-buffer idris-prover-script-buffer-name)))
                        (when buffer
                          (let ((window (get-buffer-window buffer)))
                            (when window
                              (select-window window))))))))

(defun idris-fill-paragraph (justify)
  "In literate Idris files, allow filling non-code paragraphs."
  (if (and (idris-lidr-p) (not (save-excursion (move-beginning-of-line nil)
                                               (looking-at-p ">\\s-"))))
      (fill-paragraph justify)
    (save-excursion
      (if (nth 4 (syntax-ppss))
          (fill-comment-paragraph justify) ;; if inside comment, use normal Emacs comment filling
        (if (save-excursion (move-beginning-of-line nil)
                            (looking-at "\\s-*|||\s-*")) ;; if inside documentation, fill with special prefix
            (let ((fill-prefix (substring-no-properties (match-string 0)))
                  (paragraph-start "\\s-*|||\\s-*$\\|\\s-*$\\|\\s-*@" )
                  (paragraph-separate "\\s-*|||\\s-*$\\|\\s-*$"))
              (fill-paragraph))
          ;; Otherwise do nothing
          "")))))


(defun idris-set-idris-load-packages ()
  "Interactively set the `idris-load-packages' variable."
  (interactive)
  (let* ((idris-libdir (replace-regexp-in-string
                        "[\r\n]*\\'" ""   ; remove trailing newline junk
                        (shell-command-to-string (concat idris-interpreter-path " --libdir"))))
         (idris-libs (cl-remove-if #'(lambda (x) (string= (substring x 0 1) "."))
                                   (directory-files idris-libdir)))
         (packages '())
         (prompt "Package to use (blank when done): ")
         (this-package (completing-read prompt (cons "" idris-libs))))
    (while (not (string= this-package ""))
      (push this-package packages)
      (setq this-package (completing-read prompt (cl-remove-if #'(lambda (x) (member x packages))
                                                               idris-libs))))
    (when (y-or-n-p (format "Use the packages %s for this session?"
                            (cl-reduce #'(lambda (x y) (concat x ", " y)) packages)))
      (setq idris-load-packages packages)
      (when (y-or-n-p "Save package list for future sessions? ")
        (add-file-local-variable 'idris-load-packages packages)))))

(defun idris-open-package-file ()
  "Provide easy access to package files."
  (interactive)
  (let ((files (idris-find-file-upwards "ipkg")))
    (cond ((= (length files) 0)
           (user-error "No .ipkg file found"))
          ((= (length files) 1)
           (find-file (car files)))
          (t (find-file (completing-read "Package file: " files nil t))))))

(defun idris-start-project ()
  "Interactively create a new Idris project, complete with ipkg file."
  (interactive)
  (let* ((project-name (read-string "Project name: "))
         (default-filename (downcase (replace-regexp-in-string "[^a-zA-Z]" "" project-name)))
         (create-in (read-directory-name "Create in: " nil default-filename))
         (default-ipkg-name (concat default-filename ".ipkg"))
         (ipkg-file (read-string
                     (format "Package file name (%s): " default-ipkg-name)
                     nil nil default-ipkg-name))
         (src-dir (read-string "Source directory (src): " nil nil "src"))
         (module-name-suggestion (replace-regexp-in-string "[^a-zA-Z]+" "." (capitalize project-name)))
         (first-mod (read-string
                     (format "First module name (%s): " module-name-suggestion)
                     nil nil module-name-suggestion)))
    (when (file-exists-p create-in) (user-error "%s already exists" create-in))
    (when (string= src-dir "") (setq src-dir nil))
    (make-directory create-in t)
    (when src-dir (make-directory (concat (file-name-as-directory create-in) src-dir) t))
    (find-file (concat (file-name-as-directory create-in) ipkg-file))
    (insert "package " (replace-regexp-in-string ".ipkg$" "" ipkg-file))
    (newline 2)
    (insert "-- " project-name)
    (newline)
    (let ((name (user-full-name)))
      (unless (string= name "unknown")
        (insert "-- by " name)
        (newline)))
    (newline)
    (insert "opts = \"\"")
    (newline)
    (when src-dir (insert "sourcedir = \"" src-dir "\"") (newline))
    (insert "modules = ")
    (insert first-mod)
    (newline)
    (save-buffer)
    (let* ((mod-path (reverse (split-string first-mod "\\.+")))
           (mod-dir (mapconcat #'file-name-as-directory
                               (cons create-in (cons src-dir (reverse (cdr mod-path))))
                               ""))
           (filename (concat mod-dir (car mod-path) ".idr")))
      (make-directory mod-dir t)
      (pop-to-buffer (find-file-noselect filename))
      (insert "module " first-mod)
      (newline)
      (save-buffer))))

;;; Pretty-printer stuff

(defun idris-set-current-pretty-print-width ()
  "Send the current pretty-printer width to Idris, if there is a process."
  (let ((command (format ":consolewidth %s"
                         (or idris-pretty-printer-width
                             "infinite"))))
    (when (and idris-process
               (not idris-prover-currently-proving))
      (idris-eval `(:interpret ,command) t))))

;;; Computing a menu with these commands
(defun idris-context-menu-items (plist)
  "Compute a contextual menu based on the Idris semantic decorations in PLIST."
  (let ((ref (or (plist-get plist 'idris-name-key) (plist-get plist 'idris-ref)))
        (ref-style (plist-get plist 'idris-ref-style))
        (namespace (plist-get plist 'idris-namespace))
        (source-file (plist-get plist 'idris-source-file))
        (tt-term (plist-get plist 'idris-tt-term)))
    (append
     (when ref
       (append (list (list "Get type"
                           (lambda ()
                             (interactive)
                             (idris-info-for-name :type-of ref))))
               (cond ((member ref-style
                              '(:type :data :function))
                      (list
                       (list "Get docs"
                             (lambda ()
                               (interactive)
                               (idris-info-for-name :docs-for ref)))
                       (list "Get definition"
                             (lambda ()
                               (interactive)
                               (idris--print-definition-of-name ref)))
                       (list "Who calls?"
                             (lambda ()
                               (interactive)
                               (idris-who-calls-name ref)))
                       (list "Calls who?"
                             (lambda ()
                               (interactive)
                               (idris-name-calls-who ref)))))
                     ((equal ref-style :metavar)
                      (cons (list "Launch prover"
                                  (lambda ()
                                    (interactive)
                                    (idris-prove-hole ref)))
                            (when idris-enable-elab-prover
                              (list (list "Launch interactive elaborator"
                                          (lambda ()
                                            (interactive)
                                            (idris-prove-hole ref t))))))))))
     (when namespace
       (list (list (concat "Browse " namespace)
                   (lambda ()
                     (interactive)
                     (idris-browse-namespace namespace)))))
     (when (and namespace source-file)
       (list (list (concat "Edit " source-file)
                   (lambda ()
                     (interactive)
                     (find-file source-file)))))
     (when tt-term
       (list (list "Normalize term"
                   (let ((pos (point)))
                     (lambda ()
                       (interactive)
                       (save-excursion
                         (idris-normalize-term
                          (idris--active-term-beginning tt-term pos))))))
             (list "Show term implicits"
                   (let ((pos (point)))
                     (lambda ()
                       (interactive)
                       (save-excursion
                         (idris-show-term-implicits
                          (idris--active-term-beginning tt-term pos))))))
             (list "Hide term implicits"
                   (let ((pos (point)))
                     (lambda ()
                       (interactive)
                       (save-excursion
                         (idris-hide-term-implicits
                          (idris--active-term-beginning tt-term pos))))))
             (list "Show core"
                   (let ((pos (point)))
                     (lambda ()
                       (interactive)
                       (save-excursion
                         (idris-show-core-term
                          (idris--active-term-beginning tt-term pos)))))))))))

(provide 'idris-commands)
;;; idris-commands.el ends here


================================================
FILE: idris-common-utils.el
================================================
;;; idris-common-utils.el --- Useful utilities -*- lexical-binding: t -*-

;; Copyright (C) 2013-2015 Hannes Mehnert and David Raymond Christiansen

;; Author: Hannes Mehnert <hannes@mehnert.org> and David Raymond Christiansen <david@davidchristiansen.dk>

;; License:
;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)
;; Therefore license is GPL

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary
;; This file contains various useful things that are employed
;; throughout idris-mode.

;;; Code:
(require 'idris-core)
(require 'idris-settings)
(require 'cl-lib)


;;; These variables are here because many things depend on them
(defvar-local idris-buffer-dirty-p t
  "An Idris buffer is dirty if it have been modified since it was last loaded.")

(defvar idris-currently-loaded-buffer nil
  "The buffer currently loaded by the running Idris.")

(defvar idris-loaded-region-overlay nil
  "The region loaded by Idris, should such a thing exist.")

(defvar idris-process-current-working-directory ""
  "Working directory of Idris process.")

(defvar idris-command-line-option-functions nil
  "A list of functions to call to compute the `command-line' arguments to Idris.
Each function should take no arguments and return a list of
strings that are suitable arguments to `start-process'.")

(defvar idris-mode-path nil
  "Directory containing the `idris-mode' package.
This is used to load resource files such as images.  The default
value is automatically computed from the location of the Emacs
Lisp package.")
(when load-file-name ;; guard to allow M-x eval-buffer
  (setq idris-mode-path (file-name-directory load-file-name)))

(defun idris-buffer-name (type)
  (cl-assert (keywordp type))
  (concat (format "*idris-%s*" (substring (symbol-name type) 1))))

(defun idris-kill-buffer (buffer)
  (let ((buf (cond
              ((symbolp buffer)
               (get-buffer (idris-buffer-name buffer)))
              ((stringp buffer)
               (get-buffer buffer))
              ((bufferp buffer)
               buffer)
              (t (message "don't know how to kill buffer"))))
        (return-buffer (seq-find (lambda (b) (eq 'idris-mode (buffer-local-value 'major-mode b)))
                                 (buffer-list))))
    (when (and buf (buffer-live-p buf))
      (let ((win (get-buffer-window buf)))
        (kill-buffer buf)
        (when (and (null (window-prev-buffers win)) (< 1 (length (window-list))))
          (delete-window win))))
    (when return-buffer (pop-to-buffer return-buffer `(display-buffer-reuse-window)))))

(defun idris-minibuffer-respecting-message (text &rest args)
  "Display TEXT as a message, without hiding any minibuffer contents."
  (let ((mtext (format " [%s]" (apply #'format text args))))
    (if (minibuffer-window-active-p (minibuffer-window))
        (minibuffer-message mtext)
      (message "%s" mtext))))

(defun idris-same-line-p (pos1 pos2)
  "Return t if buffer positions POS1 and POS2 are on the same line."
  (save-excursion (goto-char (min pos1 pos2))
                  (<= (max pos1 pos2) (line-end-position))))

(defmacro idris-save-marker (marker &rest body)
  "Save the contents of the marker MARKER while executing BODY."
  (declare (indent 1))
  (let ((pos (gensym "pos")))
  `(let ((,pos (marker-position ,marker)))
     (prog1 (progn . ,body)
       (set-marker ,marker ,pos)))))

(defmacro idris-propertize-region (props &rest body)
  "Execute BODY and add PROPS to all the text it inserts.
More precisely, PROPS are added to the region between the point's
positions before and after executing BODY."
  (declare (indent 1))
  (let ((start (gensym "foo")))
    `(let ((,start (point)))
       (prog1 (progn ,@body)
         (add-text-properties ,start (point) ,props)))))

(defmacro idris-propertize-spans (spans &rest body)
  "Execute BODY and add the properties indicated by SPANS to the
inserted text (that is, relative to point prior to insertion)."
  (declare (indent 1))
  (let ((start (gensym)))
    `(let ((,start (point)))
       (prog1 (progn ,@body)
         (cl-loop for (begin length props) in ,spans
                  do (add-text-properties (+ ,start begin)
                                          (+ ,start begin length)
                                          props))))))

;;; TODO: Take care of circular dependency issue
(autoload 'idris-eval "inferior-idris.el")

(defun idris-make-link-keymap (url)
  "Compute the keymap for a clickable link to URL."
  (let ((map (make-sparse-keymap))
        (browse (lambda () (interactive) (browse-url url))))
    (define-key map [mouse-1] browse)
    (define-key map [mouse-2] browse)
    (define-key map (kbd "RET") browse)
    map))

(defconst idris-semantic-properties-clickable-decors
  '(:type :data :function :metavar :module :namespace :postulate)
  "The decors that should light up as responsive to mouse clicks.")

(defun idris-semantic-properties-face (props)
  "Compute the text property `face' from the Idris properties (PROPS) for a region."
  (let* ((decor (assoc :decor props))
         (implicit (assoc :implicit props))
         (text-format (assoc :text-formatting props))
         (idris-err (assoc :error props))
         (link-href (assoc :link-href props))
         (qquote (assoc :quasiquotation props))
         (aquote (assoc :antiquotation props))
         (decor-face (if decor
                         (pcase (cadr decor)
                           (:type '(idris-semantic-type-face))
                           (:data '(idris-semantic-data-face))
                           (:function '(idris-semantic-function-face))
                           (:keyword '(idris-keyword-face))
                           (:metavar '(idris-hole-face))
                           (:bound '(idris-semantic-bound-face))
                           (:namespace '(idris-semantic-namespace-face))
                           (:postulate '(idris-semantic-postulate-face))
                           (:module '(idris-semantic-module-face))
                           (_ nil))
                       nil))
         (implicit-face (if (and implicit (equal (cadr implicit) :True))
                            '(idris-semantic-implicit-face)
                          nil))
         (err-face (if idris-err
                       '(idris-warning-face)
                     ()))
         (text-face (pcase (cadr text-format)
                      (:bold      '(bold))
                      (:italic    '(italic))
                      (:underline '(underline))
                      (_ nil)))
         (link-face (if link-href '(idris-link-face) ()))
         (unique-val (gensym)) ; HACK to stop consecutive mouse-faces from interfering
         (mousable-face
          (cond ((member (cadr decor) idris-semantic-properties-clickable-decors)
                 `((:inherit (,decor-face highlight) :hack ,unique-val)))
                (idris-err
                 `((:inherit ('idris-warning-face highlight))))
                (link-href
                 '(highlight))
                (t nil)))
         (qquote-face (when qquote '(idris-quasiquotation-face)))
         (aquote-face (when aquote '(idris-antiquotation-face)))
         (computed-face (append text-face
                                implicit-face
                                decor-face
                                err-face
                                link-face
                                qquote-face
                                aquote-face)))
    (append (if computed-face (list 'face computed-face) ())
            (if mousable-face (list 'mouse-face mousable-face) ()))))


(defun idris-semantic-properties-eldoc (props)
  "Compute an Eldoc string from Idris semantic properties (PROPS)."
  (let* ((name (assoc :name props))
         (namespace (assoc :namespace props))
         (source-file (assoc :source-file props))
         (type (pcase (assoc :type props)
                 (`(:type ,ty)
                  (concat " : " ty))
                 (_ "")))
         (doc-overview (pcase (assoc :doc-overview props)
                         (`(:doc-overview ,docs)
                          (if (string-match "[^ ]" docs)
                              (concat "\n"
                                      ;; Emacs will do its own line-wrapping in Eldoc
                                      (replace-regexp-in-string "\\\n" " " docs))
                            ""))
                         (_ ""))))
    (cond (name (list 'idris-eldoc
                      (concat (cadr name)
                              ;; Emacs will do its own line-wrapping in Eldoc
                              (replace-regexp-in-string "\\\n" " " type)
                              doc-overview)))
          ((and namespace source-file)
           (list 'idris-eldoc
                 (file-relative-name (cadr source-file))))
          (namespace (list 'idris-eldoc
                           (cadr namespace)))
          (t nil))))


(defun idris-semantic-properties-help-echo (props)
  (let* ((name (assoc :name props))
         (decor (assoc :decor props))
         (namespace (assoc :namespace props))
         (idris-err (assoc :error props))
         (link-href (assoc :link-href props))
         (image (assoc :image props))
         (type (pcase (assoc :type props)
                 (`(:type ,ty) (concat " : " ty))
                 (_ "")))
         (doc-overview (pcase (assoc :doc-overview props)
                         (`(:doc-overview ,docs) (concat "\n" docs))
                         (_ "")))
         (mouse-help
          (cond ((member (cadr decor) idris-semantic-properties-clickable-decors)
                 "\n<mouse-3> context menu")
                (idris-err (idris-eval `(:error-string ,(cadr idris-err))))
                (t ""))))
    (cond (name (list 'help-echo
                      (concat (cadr name)
                              type
                              doc-overview
                              mouse-help)))
          (namespace (list 'help-echo (concat (cadr namespace) "\n" mouse-help)))
          (link-href (list 'help-echo (concat "<mouse-1> browse " (cadr link-href))))
          (image (list 'help-echo (cadr image)))
          (t nil))))

(defun idris-semantic-properties (props)
  "Compute how to highlight with Idris compiler properties (PROPS)."
  (let* ((name (assoc :name props))
         (decor (assoc :decor props))
         (term (assoc :tt-term props))
         (key (assoc :key props))
         (namespace (assoc :namespace props))
         (source-file (assoc :source-file props))
         (idris-err (assoc :error props))
         (link-href (assoc :link-href props))
         (image (assoc :image props)))
    (append '(rear-nonsticky t)
            (cond (name
                   (if (and (member (cadr decor)
                                    '(:type :data :function :metavar))
                            name)
                       (append (list 'idris-ref (cadr name)
                                     'idris-ref-style (cadr decor))
                               (when namespace
                                 (list 'idris-namespace (cadr namespace))))
                     ()))
                  (namespace
                   (if (or (equal (cadr decor) :module)
                           (equal (cadr decor) :namespace))
                       (append (list 'idris-namespace (cadr namespace))
                               (when source-file
                                 (list 'idris-source-file (cadr source-file))))
                     ()))
                  (link-href
                   (list 'keymap (idris-make-link-keymap (cadr link-href))
                         'idris-url (cadr link-href)))
                  (image
                   (list 'display
                         `(image :type imagemagick
                                 :file ,(expand-file-name (cl-caddr image)
                                                          (file-name-directory idris-process-current-working-directory)))))
                  (t nil))
            (if term
                (list 'idris-tt-term (cadr term))
              ())
            (if (and key (not (string-empty-p (cadr key))))
                (list 'idris-name-key (concat "{{{{{" (cadr key) "}}}}}"))
              ())
            (if idris-err
                (list 'idris-tt-error (cadr idris-err))
              ())
            (idris-semantic-properties-help-echo props)
            (idris-semantic-properties-face props)
            (idris-semantic-properties-eldoc props))))

(defun idris-repl-semantic-text-props (highlighting)
  (cl-loop for (start length props) in highlighting
           collecting (list start
                            length
                            (idris-semantic-properties props))))

(defun idris-add-overlay-properties (overlay plist)
  "Add the contents of PLIST to the properties of OVERLAY."
  (while (and plist (cdr plist))
    (overlay-put overlay (car plist) (cadr plist))
    (setq plist (cddr plist))))

;;; Was originally slime-search-property - thanks SLIME!
(defun idris-search-property (prop &optional backward prop-value-fn)
  "Search for the next text range where PROP is non-nil.
Return the value of PROP, or nil if it is not found.
If BACKWARD is non-nil, search backward.
If PROP-VALUE-FN is non-nil use it to extract PROP's value."
  (let ((next-candidate (if backward
                            #'previous-single-char-property-change
                          #'next-single-char-property-change))
        (prop-value-fn (or prop-value-fn
                            (lambda ()
                              (get-text-property (point) prop))))
        (start (point))
        (prop-value))
    (while (progn
             (goto-char (funcall next-candidate (point) prop))
             (not (or (setq prop-value (funcall prop-value-fn))
                      (eobp)
                      (bobp)))))
    (cond (prop-value)
          (t (goto-char start) nil))))

;;; Dispatching of events and helpers
(defmacro destructure-case (value &rest patterns)
  "Dispatch VALUE to one of PATTERNS.
A cross between `cl-case' and `cl-destructuring-bind'.
The pattern syntax is:
  ((HEAD . ARGS) . BODY)
The list of patterns is searched for a HEAD `eq' to the car of
VALUE. If one is found, the BODY is executed with ARGS bound to the
corresponding values in the CDR of VALUE."
  (declare (indent 1))
  (let ((operator (gensym "op-"))
        (operands (gensym "rand-"))
        (tmp (gensym "tmp-")))
    `(let* ((,tmp ,value)
            (,operator (car ,tmp))
            (,operands (cdr ,tmp)))
       (cl-case ,operator
         ,@(mapcar (lambda (clause)
                     (if (eq (car clause) t)
                         `(t ,@(cdr clause))
                       (cl-destructuring-bind ((op &rest rands) &rest body) clause
                         `(,op (cl-destructuring-bind ,rands ,operands
                                 . ,body)))))
                   patterns)
         ,@(if (eq (caar (last patterns)) t)
               '()
             `((t (error "ELISP destructure-case failed: %S" ,tmp))))))))

(defun idris-lidr-p (&optional buffer)
  "Return t if BUFFER is a literate Idris file, or nil otherwise.
Use the current buffer if BUFFER is not supplied or is nil."
  (let ((file-name (buffer-file-name buffer)))
    ;; We check for nil here because idris-lidr-p might be called on
    ;; buffers that don't have associated files, such as the REPL
    ;; buffer or an info buffer
    (and (stringp file-name)
         (string= (file-name-extension file-name) "lidr"))))

(defun idris-make-file-link-overlay (start end keymap help-echo)
  (let ((overlay (make-overlay start end)))
    (overlay-put overlay 'idris-file-link t)
    (overlay-put overlay 'keymap keymap)
    (overlay-put overlay 'mouse-face 'highlight)
    (overlay-put overlay 'help-echo help-echo)))

(defun idris-clear-file-link-overlays (&optional mode)
  "Remove all file link overlays from the current buffer."
  (when (or (not mode) (eq major-mode mode))
    (remove-overlays (point-min) (point-max) 'idris-file-link t)))

(defun idris-make-module-link (start end src-dir)
  "Attempt to make the region between START and END into a
clickable link to open a module for editing, with modules located
relative to SRC-DIR"
  (let* ((name (buffer-substring-no-properties start end))
         (fname (split-string name "\\."))
         (basename (concat (mapconcat 'file-name-as-directory (cons src-dir (butlast fname)) "")
                           (car (last fname))))
         (idr (concat basename ".idr"))
         (lidr (concat basename ".lidr")))
    (cl-flet ((make-link (src-name)
                         (let ((map (make-sparse-keymap)))
                           (define-key map [mouse-2] #'(lambda ()
                                                         (interactive)
                                                         (find-file src-name)))
                           (idris-make-file-link-overlay start end map "mouse-2: edit module"))))
      (if (file-exists-p idr)
          (make-link idr)
        (when (file-exists-p lidr)
          (make-link lidr))))))

(defvar idris-protocol-version 0 "The protocol version.")
(defvar idris-protocol-version-minor 0 "The protocol minor version.")

(defun >=-protocol-version (major minor)
  (or  (> idris-protocol-version major)
       (and (>= idris-protocol-version       major)
            (>= idris-protocol-version-minor minor))))

(defun idris-get-line-num (position)
  "Get the absolute line number at POSITION."
  ;; In Emacs 26.1 > line-number-at-pos accepts
  ;; additional optional argument ABSOLUTE which
  ;; removes need for `save-restriction' and `widen'
  (save-restriction
    (widen)
    (line-number-at-pos position)))

(defun idris-operator-at-position-p (pos)
  "Return t if syntax lookup is `.' or char after POS is `-'."
  (or (equal (syntax-after pos) (string-to-syntax "."))
      (eq (char-after pos) ?-)))

(defun idris-thing-at-point ()
  "Return the line number and name at point as a cons.
Use this in Idris source buffers."
  (let ((line (idris-get-line-num (point))))
    (cons
     (if (idris-operator-at-position-p (point))
         (save-excursion
           (skip-syntax-backward ".")
           (let ((beg (point)))
             (skip-syntax-forward ".")
             (buffer-substring-no-properties beg (point))))
       ;; Try if we're on a symbol or fail otherwise.
       (or (current-word t)
           (user-error "Nothing identifiable under point")))
     line)))

(defun idris-name-at-point ()
  "Return the name at point, taking into account semantic annotations.
Use this in Idris source buffers or in compiler-annotated output.
Does not return a line number."
  (let ((ref (cl-remove-if
              #'null
              (cons (get-text-property (point) 'idris-ref)
                    (cl-loop for overlay in (overlays-at (point))
                             collecting (overlay-get overlay 'idris-ref))))))
    (car (or ref (idris-thing-at-point)))))

(provide 'idris-common-utils)


================================================
FILE: idris-compat.el
================================================
;;; idris-compat.el --- compatibility functions for Emacs 24.1 -*- lexical-binding: t -*-

;;; Commentary:
;; This file defines defvar-local, which was introduced in Emacs 24.3, and string-suffix-p, from Emacs 24.4.

;;; Code:
(require 'subr-x nil 'no-error)   ; Additional utilities, Emacs 24.4 and upwards

(eval-and-compile
  (unless (featurep 'subr-x)
    ;; `subr-x' function for Emacs 24.3 and below
    (defsubst string-blank-p (string)
      "Check whether STRING is either empty or only whitespace."
      (string-match-p "\\`[ \t\n\r]*\\'" string))))

(unless (fboundp 'defvar-local)
  (defmacro defvar-local (var val &optional docstring)
    `(progn
       (defvar ,var ,val ,docstring)
       (make-variable-buffer-local ',var))))

;;; The following function is copyright FSF, from GNU Emacs 24.4 source code.
(unless (fboundp 'string-suffix-p)
  (defun string-suffix-p (suffix string  &optional ignore-case)
    "Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
    (let ((start-pos (- (length string) (length suffix))))
      (and (>= start-pos 0)
           (eq t (compare-strings suffix nil nil
                                  string start-pos nil ignore-case))))))

;; gensym fun introduced at or before Emacs version 26.1.
(unless (fboundp 'gensym)
  (defalias 'gensym 'cl-gensym))

(if (fboundp 'file-name-concat)
    (defalias 'idris-file-name-concat 'file-name-concat)
  (defun idris-file-name-concat (&rest components)
    (let ((dirs (butlast components)))
      (concat (apply 'concat (mapcar 'file-name-as-directory dirs))
              (car (reverse components))))))

(if (fboundp 'file-name-parent-directory)
    (defalias 'idris-file-name-parent-directory 'file-name-parent-directory)
  ;; Extracted from Emacs 29+ https://github.com/emacs-mirror/emacs/blob/master/lisp/files.el
  (defun idris-file-name-parent-directory (filename)
    "Return the directory name of the parent directory of FILENAME.
If FILENAME is at the root of the filesystem, return nil.
If FILENAME is relative, it is interpreted to be relative
to `default-directory', and the result will also be relative."
    (let* ((expanded-filename (expand-file-name filename))
           (parent (file-name-directory (directory-file-name expanded-filename))))
      (cond
       ;; filename is at top-level, therefore no parent
       ((or (null parent)
            ;; `equal' is enough, we don't need to resolve symlinks here
            ;; with `file-equal-p', also for performance
            (equal parent expanded-filename))
        nil)
       ;; filename is relative, return relative parent
       ((not (file-name-absolute-p filename))
        (file-relative-name parent))
       (t
        parent)))))

(provide 'idris-compat)
;;; idris-compat.el ends here


================================================
FILE: idris-core.el
================================================
;;; idris-core.el --- Core functionality -*- lexical-binding: t -*-
;; Copyright (C) 2013 Hannes Mehnert

;; Authors: Hannes Mehnert <hannes@mehnert.org>
;;          David Raymond Christiansen <david@davidchristiansen.dk>

;; License:
;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)
;; Therefore license is GPL

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:
(require 'idris-compat)

(defun idris-is-ident-char-p (ch)
  (or (and (<= ?a ch) (<= ch ?z))
      (and (<= ?A ch) (<= ch ?Z))
      (and (<= ?0 ch) (<= ch ?9))
      (= ch ?_)))

(provide 'idris-core)
;;; idris-core.el ends here


================================================
FILE: idris-events.el
================================================
;;; idris-events.el --- Logging of events in inferior Idris -*- lexical-binding: t -*-

;; Copyright (C) 2013 Hannes Mehnert

;; Author: Hannes Mehnert <hannes@mehnert.org>

;; License:
;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)
;; Therefore license is GPL

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

(require 'pp)

(require 'idris-core)
(require 'idris-common-utils)
(require 'idris-settings)

(defvar idris-event-buffer-name (idris-buffer-name :events)
  "The name of the Idris event buffer.")

(defun idris-events-buffer ()
  "Return or create the event log buffer."
  (or (get-buffer idris-event-buffer-name)
      (let ((buffer (get-buffer-create idris-event-buffer-name)))
        (with-current-buffer buffer
          (buffer-disable-undo)
          (set (make-local-variable 'outline-regexp) "^(")
          (set (make-local-variable 'comment-start) ";")
          (set (make-local-variable 'comment-end) "")
          (setq buffer-read-only t))
        buffer)))

(defun idris-event-log (event sending)
  "Record the fact that EVENT occured in the SENDING direction.

The event is only logged if `idris-log-events' is non-nil."
  (when idris-log-events
    (with-current-buffer (idris-events-buffer)
      (goto-char (point-max))
      (let ((buffer-read-only nil)
            (time (format-time-string "%H:%M:%S")))
        (save-excursion
          (if sending
              (insert (concat time " -> "))
            (insert (concat time " <- ")))
          (idris-pprint-event event (current-buffer))))
      (goto-char (point-max)))))

(defun idris-pprint-event (event buffer)
  "Pretty print EVENT in BUFFER."
  (let ((print-length 20)
        (print-level 10)
        (pp-escape-newlines t))
    (pp event buffer)))

(defun idris-dump-events-to-file (file)
  "Dump event log to FILE."
  (when idris-log-events
    (with-current-buffer (idris-events-buffer)
      (write-file file))))

(provide 'idris-events)
;;; idris-events.el ends here


================================================
FILE: idris-highlight-input.el
================================================
;;; idris-highlight-input.el --- Compiler-driven highlighting of user input  -*- lexical-binding: t; -*-

;; Copyright (C) 2015  David Raymond Christiansen

;; Author: David Raymond Christiansen <david@davidchristiansen.dk>
;; Keywords: languages

;; 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 3 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, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file contains routines for highlighting user input with
;; information generated by the Idris elaborator.

;;; Code:

(require 'idris-common-utils)
(require 'idris-settings)

(defun idris-highlight-remove-overlays (&optional buffer)
  "Remove all Idris highlighting overlays from BUFFER.
Use the current buffer if BUFFER is nil."
  (interactive)
  (with-current-buffer (or buffer (current-buffer))
    (save-restriction
      (widen)
      (dolist (overlay (overlays-in (point-min) (point-max)))
        (when (overlay-get overlay 'idris-source-highlight)
          (delete-overlay overlay))))))

(defun idris-highlight-column (idris-col)
  "Compute the Emacs position offset of the Idris column IDRIS-COL.

In particular, this takes bird tracks into account in literate Idris."
  (+ idris-col (if (idris-lidr-p) 1 -1)))

(defun idris-highlight--overlay-modification-hook (&rest args)
  "Delete semantic overlays if they are changed.

See Info node `(elisp)Overlay Properties' to understand how ARGS are used."
  ;; There are 5 args when it's called post-modification
  (when (= (length args) 5)
    (delete-overlay (car args))))

(defun idris-highlight-input-region (start-line start-col end-line end-col highlight)
  "Highlight in BUFFER using an overlay from START-LINE and START-COL to
 END-LINE and END-COL and the semantic properties specified in HIGHLIGHT."
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (let* ((start-pos (+ (line-beginning-position start-line)
                           (idris-highlight-column start-col)))
             (end-pos (+ (line-beginning-position end-line)
                         (idris-highlight-column end-col)))
             (existing-idris-overlays-in-range (seq-filter
                                                (lambda (overlay)
                                                  (overlay-get overlay 'idris-source-highlight))
                                                (overlays-in start-pos end-pos)))
             (existing-idris-overlay (seq-find (lambda (overlay)
                                                 (and
                                                  (eql start-pos (overlay-start overlay))
                                                  (eql end-pos (overlay-end overlay))
                                                  ;; TODO: overlay properties match
                                                  ))
                                               existing-idris-overlays-in-range)))
        (when (null existing-idris-overlay)
          (mapc #'delete-overlay existing-idris-overlays-in-range)
          (let ((highlight-overlay (make-overlay start-pos end-pos)))
            (overlay-put highlight-overlay 'idris-source-highlight t)
            (idris-add-overlay-properties highlight-overlay (idris-semantic-properties highlight))
            (overlay-put highlight-overlay 'modification-hooks '(idris-highlight--overlay-modification-hook))))))))

(defun idris-highlight-source-file (hs)
  (pcase-dolist
      (`(((:filename ,fn)
          (:start ,start-line-raw ,start-col-raw)
          (:end ,end-line-raw ,end-col-raw))
         ,props)
       hs)
    (when (string= (file-name-nondirectory fn)
                   (file-name-nondirectory (buffer-file-name)))
      (let ((start-line (if (>=-protocol-version 2 1)
                            (1+ start-line-raw)
                          start-line-raw))
            (start-col  (if (>=-protocol-version 2 1)
                            (1+ start-col-raw)
                          start-col-raw))
            (end-line   (if (>=-protocol-version 2 1)
                            (1+ end-line-raw)
                          end-line-raw))
            (end-col    (if (>= idris-protocol-version 1)
                            (1+ end-col-raw)
                          end-col-raw)))
        (idris-highlight-input-region start-line start-col
                                      end-line end-col
                                      props)))))

(defun idris-highlight-input-region-debug (start-line start-col end-line end-col highlight)
  (when (not (or (> end-line start-line)
                 (and (= end-line start-line)
                      (> end-col start-col))))
    (message "Not highlighting absurd span %s:%s-%s:%s with %s"
             start-line start-col
             end-line end-col
             highlight)))

(defun idris-toggle-semantic-source-highlighting ()
  "Turn on/off semantic highlighting.
This is controled by value of `idris-semantic-source-highlighting' variable.
When the value is `debug' additional checks are performed on received data."
  (if idris-semantic-source-highlighting
      (progn
        (if (eq idris-semantic-source-highlighting 'debug)
            (advice-add 'idris-highlight-input-region
                        :before-until
                        #'idris-highlight-input-region-debug)
          (advice-remove 'idris-highlight-input-region
                         #'idris-highlight-input-region-debug))
        (advice-remove 'idris-highlight-source-file #'ignore))
    (advice-add 'idris-highlight-source-file :around #'ignore)))

(defun idris-buffer-semantic-source-highlighting ()
  "Return nil if current buffer size is larger than set limit.
The limit is defined as value of:
`idris-semantic-source-highlighting-max-buffer-size'.
Otherwise return current value of `idris-semantic-source-highlighting'"
  (if (< (buffer-size)
         idris-semantic-source-highlighting-max-buffer-size)
      idris-semantic-source-highlighting
    (message "Semantic source highlighting is disabled for the current buffer. %s"
             "Customize `idris-semantic-source-highlighting-max-buffer-size' to enable it.")
    nil))

(provide 'idris-highlight-input)
;;; idris-highlight-input.el ends here


================================================
FILE: idris-hole-list.el
================================================
;;; idris-hole-list.el --- List Idris holes in a buffer -*- lexical-binding: t -*-

;; Copyright (C) 2014 David Raymond Christiansen

;; Author: David Raymond Christiansen <david@davidchristiansen.dk>

;; License:
;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)
;; Therefore license is GPL

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

(require 'cl-lib)
(require 'prop-menu)

(require 'idris-core)
(require 'idris-keys)
(require 'idris-warnings-tree)
(require 'idris-settings)

(defvar idris-hole-list-buffer-name (idris-buffer-name :holes)
  "The name of the buffer containing Idris holes.")

(defun idris-hole-list-quit ()
  "Quit the Idris hole list."
  (interactive)
  (idris-kill-buffer idris-hole-list-buffer-name))

(defvar idris-hole-list-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (define-key map (kbd "RET") 'idris-compiler-notes-default-action-or-show-details)
    (define-key map (kbd "<mouse-2>") 'idris-compiler-notes-default-action-or-show-details/mouse)
    ;;; Allow buttons to be clicked with the left mouse button in the hole list
    (define-key map [follow-link] 'mouse-face)
    (cl-loop for keyer
             in '(idris-define-docs-keys
                  idris-define-general-keys
                  idris-define-active-term-keys)
             do (funcall keyer map))
    map))

(easy-menu-define idris-hole-list-mode-menu idris-hole-list-mode-map
  "Menu for the Idris hole list buffer."
  `("Idris Holes"
    ["Show term interaction widgets" idris-add-term-widgets t]
    ["Close hole list buffer" idris-hole-list-quit t]
    "------------------"
    ["Customize idris-hole-list-mode" (customize-group 'idris-hole-list) t]
    ["Customize fonts and colors" (customize-group 'idris-faces) t]))

(define-derived-mode idris-hole-list-mode special-mode "Idris Holes"
  "Major mode used for transient Idris hole list buffers.
\\{idris-hole-list-mode-map}
Invokes `idris-hole-list-mode-hook'."
  (setq-local prop-menu-item-functions '(idris-context-menu-items)))

;; TODO: Auto detect mode for idris holes buffer instead of
;; invoking `idris-hole-list-mode' in `idris-hole-list-show'
;; (push '("#\\*idris-holes\\*$" . idris-hole-list-mode) auto-mode-alist)

(defun idris-hole-list-buffer ()
  "Return the Idris hole buffer, creating one if there is not one."
  (get-buffer-create idris-hole-list-buffer-name))

(defun idris-hole-list-show (hole-info)
  (if (null hole-info)
      (progn (message "No holes found!")
             (idris-hole-list-quit))
    (with-current-buffer (idris-hole-list-buffer)
      (idris-hole-list-mode)
      (let ((buffer-read-only nil))
        (erase-buffer)
        (insert (propertize "Holes" 'face 'idris-info-title-face) "\n\n")
        (when idris-show-help-text
          (insert "This buffer displays the unsolved holes from the currently-loaded code. ")
          (insert (concat "Press the "
                          (if idris-enable-elab-prover "[E]" "[P]")
                          " buttons to solve the holes interactively in the prover."))
          (let ((fill-column 80))
            (fill-region (point-min) (point-max)))
          (insert "\n\n"))
        (dolist (tree (mapcar #'idris-tree-for-hole hole-info))
          (idris-tree-insert tree "")
          (insert "\n\n"))
        (message "Press q to close")
        (goto-char (point-min))))
    (display-buffer (idris-hole-list-buffer))))

(defun idris-hole-tree-printer (tree)
  "Print TREE, formatted for holes."
  (idris-propertize-spans (idris-repl-semantic-text-props (idris-tree.highlighting tree))
    (insert (idris-tree.item tree)))
  (when (idris-tree.button tree)
    (insert " ")
    (apply #'insert-button (idris-tree.button tree))
    (insert (idris-tree.after-button tree))))


;;; Prevent circularity error
(autoload 'idris-prove-hole "idris-commands.el")

(defun idris-tree-for-hole (hole)
  "Generate a tree for HOLE.

HOLE should be a three-element list consisting of the
hole name, its premises, and its conclusion."
  (cl-destructuring-bind (name premises conclusion) hole
    (make-idris-tree :item name
                     :button (if idris-enable-elab-prover
                                 `("[E]"
                                   help-echo "Elaborate interactively"
                                   action ,#'(lambda (_)
                                               (interactive)
                                               (idris-prove-hole name t)))
                               `("[P]"
                                 help-echo "Open in prover"
                                 action ,#'(lambda (_)
                                             (interactive)
                                             (idris-prove-hole name))))
                     :highlighting `((0 ,(length name) ((:decor :metavar))))
                     :print-fn #'idris-hole-tree-printer
                     :collapsed-p (not idris-hole-list-show-expanded) ; from customize
                     :preserve-properties '(idris-tt-term)
                     :kids (list (idris-tree-for-hole-details name premises conclusion)))))

(defun idris-tree-for-hole-details (name premises conclusion)
  (let* ((name-width (1+ (apply #'max 0 (length name)
                                (mapcar #'(lambda (h) (length (car h)))
                                        premises))))
         (divider-marker nil)
         (contents (with-temp-buffer
                     (dolist (h premises)
                       (cl-destructuring-bind (name type formatting) h
                         (cl-dotimes (_ (- name-width (length name))) (insert " "))
                         (idris-propertize-spans (idris-repl-semantic-text-props
                                                  `((0 ,(length name) ((:decor :bound)))))
                           (insert name))
                         (insert " : ")
                         (let ((start (point)))
                           (idris-propertize-spans (idris-repl-semantic-text-props formatting)
                             (insert type))
                           (insert "\n")
                           ;; Indent the term to match the tree and
                           ;; its binder, if it is more than one line.
                           (let ((term-end-marker (copy-marker (point))))
                             (beginning-of-line)
                             (forward-line -1)
                             (while (< start (point))
                               ;; Preserve the term annotation, to not break active terms
                               (let ((tm (get-text-property (point) 'idris-tt-term)))
                                 (insert-before-markers
                                  (propertize (make-string (+ 3 name-width) ? )
                                              'idris-tt-term tm)))
                               (forward-line -1))
                             (goto-char term-end-marker)))))
                     (setq divider-marker (point-marker))
                     (cl-destructuring-bind (type formatting) conclusion
                       (when premises
                         (insert " ")
                         (idris-propertize-spans (idris-repl-semantic-text-props
                                                  `((0 ,(length name) ((:decor :metavar)))))
                           (insert name))
                         (insert " : "))
                       (idris-propertize-spans (idris-repl-semantic-text-props formatting)
                         (insert type)))
                     (when premises
                       (let ((width (apply #'max 0
                                           (mapcar #'length
                                                   (split-string (buffer-string) "\n")))))
                         (goto-char (marker-position divider-marker))
                         (dotimes (_ (1+ width)) (insert "-"))
                         (insert "\n")))
                     (buffer-string))))
    (make-idris-tree :item contents
                     :active-p nil
                     :highlighting '()
                     :preserve-properties '(idris-tt-term))))


(provide 'idris-hole-list)


================================================
FILE: idris-info.el
================================================
;;; idris-info.el --- Facilities for showing Idris help information -*- lexical-binding: t -*-

;; Copyright (C) 2014  David Raymond Christiansen

;; Author: David Raymond Christiansen <david@davidchristiansen.dk>
;; Keywords: languages, tools

;; 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 3 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, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This module contains facilities for showing information provided by the
;; Idris compiler in a separate buffer, as well as keeping the irritation of
;; that buffer to a minimum.

;;; Code:
(require 'prop-menu)
(require 'idris-core)
(require 'idris-common-utils)
(require 'help-mode)

(defvar idris-info-buffer-name (idris-buffer-name :info)
  "The name of the buffer containing Idris help information")

(defvar idris-info-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map) ; remove the self-inserting char commands
    ;;; Allow buttons to be clicked with the left mouse button in info buffers
    (define-key map [follow-link] 'mouse-face)
    (cl-loop for keyer
             in '(idris-define-docs-keys
                  idris-define-general-keys
                  idris-define-active-term-keys)
             do (funcall keyer map))
    map))

(easy-menu-define idris-info-mode-menu idris-info-mode-map
  "Menu for the Idris info buffer."
  `("Idris Info"
    ["Show term interaction widgets" idris-add-term-widgets t]
    ["Close Idris info buffer" idris-info-quit t]))

(define-derived-mode idris-info-mode help-mode "Idris Info"
  "Major mode used for transient Idris information.
\\{idris-info-mode-map}
Invokes `idris-info-mode-hook'."
  (setq-local prop-menu-item-functions '(idris-context-menu-items))
  (set (make-local-variable 'prop-menu-item-functions) '(idris-context-menu-items)))

(defun idris-info-buffer ()
  "Return Idris info buffer."
  (let ((buffer (get-buffer-create idris-info-buffer-name)))
    (with-current-buffer buffer
      (when (not (eq major-mode 'idris-info-mode))
        (idris-info-mode)))
    buffer))

(defalias 'idris-info-quit #'quit-window)

(defmacro with-idris-info-buffer (&rest cmds)
  "Execute `CMDS' in a fresh Idris info buffer, then display it to the user."
  (declare (indent defun))
  `(idris-show-info (with-temp-buffer ,@cmds (buffer-string))))

(defun idris-show-info (info-string &optional spans)
  "Show INFO-STRING with SPANS in the Idris info buffer."
  (with-current-buffer (idris-info-buffer)
    ;; (help-xref-following t) ensure that current buffer -> idris-info-buffer
    ;; is recognised by `help-setup-xref' and `with-help-window'
    ;; as `help-buffer'
    (let ((help-xref-following t))
      (help-setup-xref (list #'idris-show-info info-string spans)
                       (called-interactively-p 'interactive))
      (with-help-window (current-buffer)
        (idris-propertize-spans (idris-repl-semantic-text-props spans)
          (insert info-string)))
      ;; reset major-mode for idris-info-buffer
      ;; back from help-mode to idris-info-mode
      (idris-info-buffer))))

(provide 'idris-info)
;;; idris-info.el ends here


================================================
FILE: idris-ipkg-mode.el
================================================
;;; idris-ipkg-mode.el --- Major mode for editing Idris package files -*- lexical-binding: t -*-

;; Copyright (C) 2014

;; Author: David Raymond Christiansen
;; URL: https://github.com/idris-hackers/idris-mode
;; Keywords: languages
;; Package-Requires: ((emacs "24"))


;;; Commentary:

;; This is an Emacs mode for editing Idris packages. It requires the latest
;; version of Idris, and some features may rely on the latest Git version of
;; Idris.

;;; Code:
(require 'ansi-color)
(require 'compile)

(require 'idris-core)
(require 'idris-settings)
(require 'idris-common-utils)
(require 'idris-keys)

;;; Faces

(defface idris-ipkg-keyword-face
  '((t (:inherit font-lock-keyword-face)))
  "The face to highlight Idris package keywords."
  :group 'idris-faces)

(defface idris-ipkg-package-name-face
  '((t (:inherit font-lock-function-name-face)))
  "The face to highlight the name of the package."
  :group 'idris-faces)


;;; Syntax

(defconst idris-ipkg-syntax-table
  (let ((st (make-syntax-table (standard-syntax-table))))
    ;; Strings
    (modify-syntax-entry ?\" "\"" st)
    (modify-syntax-entry ?\\ "/" st)

    ;; Matching {}, but with nested comments
    (modify-syntax-entry ?\{ "(} 1bn" st)
    (modify-syntax-entry ?\} "){ 4bn" st)
    (modify-syntax-entry ?\- "_ 123" st)
    (modify-syntax-entry ?\n ">" st)

    st))

(defconst idris-ipkg-keywords
  '("package"
    "authors"
    "maintainers"
    "license"
    "brief"
    "readme"
    "homepage"
    "sourceloc"
    "bugtracker"
    "options"
    "opts"
    "sourcedir"
    "builddir"
    "outputdir"
    "prebuild"
    "postbuild"
    "preinstall"
    "postinstall"
    "preclean"
    "postclean"
    "version"
    "langversion"
    "depends"
    "modules"
    "main"
    "executable"
    "makefile"
    "objs"
    "libs"
    "pkgs"))

(defconst idris-ipkg-font-lock-defaults
  `(,idris-ipkg-keywords))

(defconst idris-ipkg-sourcedir-re
;;  "^sourcedir\\s-*=\\s-*\"?\\([a-zA-Z/0-9]+\\)\"?"
 "^\\s-*sourcedir\\s-*=\\s-*\\(\\sw+\\)"
)

;;; Completion

(defun idris-ipkg-find-keyword ()
  (let ((start nil)
        (end (point))
        (failure (list nil nil nil)))
    (if (idris-is-ident-char-p (char-before))
        (progn
          (save-excursion
            (while (idris-is-ident-char-p (char-before))
              (backward-char))
            (setq start (point)))
          (if start
              (list (buffer-substring-no-properties start end)
                    start
                    end)
            failure))
      failure)))

(defun idris-ipkg-complete-keyword ()
  "Complete the current .ipkg keyword, if possible."
  (interactive)
  (cl-destructuring-bind (identifier start end) (idris-ipkg-find-keyword)
    (when identifier
      (list start end idris-ipkg-keywords))))

;;; Inserting fields
(defun idris-ipkg-insert-field ()
  "Insert one of the ipkg fields."
  (interactive)
  (let ((field (completing-read "Field: " (remove "package" idris-ipkg-keywords) nil t)))
    (beginning-of-line)
    (while (and (not (looking-at-p "^\\s-*$")) (= (forward-line) 0)))
    (beginning-of-line)
    (when (not (looking-at-p "^\\s-*$")) ;; end of buffer had stuff
      (goto-char (point-max))
      (newline))
    (newline)
    (insert field " = ")
    (let ((p (point)))
      (newline)
      (goto-char p))))

;;; Clickable modules

(defun idris-ipkg-make-files-clickable ()
  "Make all modules with existing files clickable, where clicking opens them."
  (interactive)
  (idris-clear-file-link-overlays 'idris-ipkg-mode)
  (let ((src-dir (idris-ipkg-buffer-src-dir (file-name-directory (buffer-file-name)))))
    ;; Make the sourcedir clickable
    (save-excursion
      (goto-char (point-min))
      (when (and (file-exists-p src-dir)
                 (file-directory-p src-dir)
                 (re-search-forward idris-ipkg-sourcedir-re nil t))
        (let ((start (match-beginning 1))
              (end (match-end 1))
              (map (make-sparse-keymap)))
          (define-key map [mouse-2] #'(lambda ()
                                        (interactive)
                                        (dired src-dir)))
          (idris-make-file-link-overlay start end map
                                        (concat "mouse-2: dired " src-dir)))))
    ;; Make the modules clickable
    (save-excursion
      (goto-char (point-min))
      (cl-flet ((mod-link ()
                  (re-search-forward "[a-zA-Z0-9\\.]+" nil t)
                  (let ((beg (match-beginning 0))
                        (end (match-end 0)))
                    (idris-make-module-link beg end src-dir))))
        (when (re-search-forward "^modules\\s-*=\\s-*" nil t)
          (cl-loop initially (mod-link)
                   while (looking-at-p "\\s-*,\\s-*")
                   do (progn (skip-chars-forward " ,\n")
                             (mod-link))))))
    ;; Make the Makefile clickable
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward "^makefile\\s-*=\\s-*\\([a-zA-Z/0-9]+\\)" nil t)
        (let ((start (match-beginning 1))
              (end (match-end 1))
              (makefile (concat (file-name-as-directory src-dir) (match-string 1))))
        (when (file-exists-p makefile)
          (let ((map (make-sparse-keymap)))
            (define-key map [mouse-2] #'(lambda ()
                                          (interactive)
                                          (find-file makefile)))
            (idris-make-file-link-overlay start end map  "mouse-2: edit makefile"))))))))


(defun idris-ipkg-enable-clickable-files ()
  "Enable setting up clickable modules and makefiles on idle Emacs."
  (interactive)
  (add-hook 'after-save-hook 'idris-ipkg-make-files-clickable)
  (idris-ipkg-make-files-clickable))

;;; finding ipkg files

;; Based on http://www.emacswiki.org/emacs/EmacsTags section "Finding tags files"
;; That page is GPL, so this is OK to include
(defun idris-find-file-upwards (suffix &optional allow-hidden)
  "Recursively searches each parent directory starting from the
directory of the current buffer filename or from
`default-directory' if that's not found, looking for a file with
name ending in SUFFIX.  Returns the paths to the matching files,
or nil if not found."
  (cl-labels
      ((find-file-r (path)
                    (let* ((parent (file-name-directory path))
                           (matching (if parent
                                         (idris-try-directory-files parent t (concat "\\\." suffix "$"))
                                       nil)))
                      (cond
                       (matching matching)
                       ;; The parent of ~ is nil and the parent of / is itself.
                       ;; Thus the terminating condition for not finding the file
                       ;; accounts for both.
                       ((or (null parent) (equal parent (directory-file-name parent))) nil) ; Not found
                       (t (find-file-r (directory-file-name parent))))))) ; Continue
    (let* ((file (buffer-file-name (current-buffer)))
           (dir (if file (file-name-directory file) default-directory)))
      (when dir
        (cl-remove-if #'(lambda (f)
                          (and (not allow-hidden)
                               (string-prefix-p "." (file-name-nondirectory f))))
                      (find-file-r dir))))))

(defun idris-try-directory-files (directory &optional full match nosort)
  "Call `directory-files' with arguments DIRECTORY, FULL, MATCH and NOSORT.
Return the empty list on failure instead of throwing an error.

See the docstring for `directory-files' for the meaning of the
arguments."
  ;; This wrapper is useful because some users can't read all the
  ;; directories above the current working directory. In particular,
  ;; /home is sometimes not readable.
  (condition-case nil
      (directory-files directory full match nosort)
    (error nil)))

(defvar idris-ipkg-build-buffer-name "*idris-build*")

(defun idris-ipkg--compilation-buffer-name-function (_mode)
  "Compute a buffer name for the `idris-mode' compilation buffer."
  idris-ipkg-build-buffer-name)

(defun idris-ipkg--ansi-compile-filter (start)
  "Apply ANSI formatting to the region of the buffer from START to point."
  (save-excursion
    (let ((buffer-read-only nil))
      (ansi-color-apply-on-region start (point)))))

(defun idris-ipkg-command (ipkg-file command)
  "Run a command on IPKG-FILE. The COMMAND can be build, install, or clean."
  ;; Idris must have its working directory in the same place as the ipkg file
  (let ((dir (file-name-directory ipkg-file))
        (file (file-name-nondirectory ipkg-file))
        (opt (cond ((equal command 'build) "--build")
                   ((equal command 'install) "--install")
                   ((equal command 'clean) "--clean")
                   (t (error "Invalid command name %s" command)))))
    (unless dir
      (error "Unable to determine directory for filename '%s'" ipkg-file))
    (let* ((default-directory dir) ; default-directory is a special variable - this starts idris in dir
           (compilation-buffer-name-function
            'idris-ipkg--compilation-buffer-name-function)
           (command (concat idris-interpreter-path " " opt " " file))
           (compilation-filter-hook
            (cons 'idris-ipkg--ansi-compile-filter compilation-filter-hook)))
      (compile command))))

(defun idris-ipkg-build (ipkg-file)
  (interactive (list
                (let ((ipkg-default (idris-find-file-upwards "ipkg")))
                  (if ipkg-default
                      (read-file-name "Package file to build: "
                                      (file-name-directory (car ipkg-default))
                                      (car ipkg-default)
                                      t
                                      (file-name-nondirectory (car ipkg-default)))
                    (read-file-name "Package file to build: " nil nil nil t)))))
  (idris-ipkg-command ipkg-file 'build))

(defun idris-ipkg-install (ipkg-file)
  (interactive (list
                (let ((ipkg-default (idris-find-file-upwards "ipkg")))
                  (if ipkg-default
                      (read-file-name "Package file to install: "
                                      (file-name-directory (car ipkg-default))
                                      (car ipkg-default)
                                      t
                                      (file-name-nondirectory (car ipkg-default)))
                    (read-file-name "Package file to install: " nil nil nil t)))))
  (idris-ipkg-command ipkg-file 'install))

(defun idris-ipkg-clean (ipkg-file)
  (interactive (list
                (let ((ipkg-default (idris-find-file-upwards "ipkg")))
                  (if ipkg-default
                      (r
Download .txt
gitextract_dxhrkfoy/

├── .github/
│   └── workflows/
│       ├── idris1.yml
│       └── idris2.yml
├── .gitignore
├── .travis.yml
├── .travis_install.sh
├── CHANGES.markdown
├── CONTRIBUTING.md
├── CONTRIBUTORS
├── COPYING
├── Makefile
├── docs/
│   └── documentation.tex
├── flycheck-idris.el
├── idris-commands.el
├── idris-common-utils.el
├── idris-compat.el
├── idris-core.el
├── idris-events.el
├── idris-highlight-input.el
├── idris-hole-list.el
├── idris-info.el
├── idris-ipkg-mode.el
├── idris-keys.el
├── idris-log.el
├── idris-mode.el
├── idris-navigate.el
├── idris-prover.el
├── idris-repl.el
├── idris-settings.el
├── idris-simple-indent.el
├── idris-syntax.el
├── idris-tree-info.el
├── idris-warnings-tree.el
├── idris-warnings.el
├── idris-xref.el
├── inferior-idris.el
├── readme.markdown
└── test/
    ├── idris-commands-test.el
    ├── idris-info-test.el
    ├── idris-navigate-test.el
    ├── idris-repl-test.el
    ├── idris-test-utils.el
    ├── idris-tests.el
    ├── idris-xref-test.el
    └── test-data/
        ├── AddClause.idr
        ├── AddMissing.idr
        ├── CaseSplit.idr
        ├── Empty.idr
        ├── Flycheck.idr
        ├── GenerateDef.idr
        ├── Literate.lidr
        ├── MakeLemma.idr
        ├── MakeWithBlock.idr
        ├── MetavarTest.idr
        ├── ProofSearch.idr
        ├── Refine.idr
        ├── TypeAtPoint.idr
        ├── TypeError.idr
        ├── cmdline/
        │   ├── commandlinetest.ipkg
        │   └── src/
        │       └── Command/
        │           └── Line/
        │               └── Test.idr
        └── package-test/
            ├── Packaging.idr
            └── test.ipkg
Condensed preview — 61 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (480K chars).
[
  {
    "path": ".github/workflows/idris1.yml",
    "chars": 2971,
    "preview": "name: Idris1 on Ubuntu\n\non:\n  push:\n    branches:\n      - '*'\n    tags:\n      - '*'\n  pull_request:\n    branches:\n      "
  },
  {
    "path": ".github/workflows/idris2.yml",
    "chars": 1719,
    "preview": "## Adapted from The Frex Project.\n\nname: Idris2 on Ubuntu\n\n# -- [ When to Act]\n\non:\n  push:\n    branches:\n      - '*'\n  "
  },
  {
    "path": ".gitignore",
    "chars": 244,
    "preview": "*~\n*.elc\ndocumentation.aux\ndocumentation.log\ndocumentation.pdf\ntest-data/build/\ntest-data/*.ibc\ntest-data/idris2-history"
  },
  {
    "path": ".travis.yml",
    "chars": 1615,
    "preview": "# Based on https://docs.haskellstack.org/en/stable/travis_ci/\n#\n# Copy these contents into the root directory of your Gi"
  },
  {
    "path": ".travis_install.sh",
    "chars": 459,
    "preview": "#! /usr/bin/env bash\n\nset -ev\n\ncase $IDRIS_VERSION in\n     git)\n         pushd .\n         git clone https://github.com/i"
  },
  {
    "path": "CHANGES.markdown",
    "chars": 8493,
    "preview": "# Changes\n\nThis file documents the user-interface changes in idris-mode, starting\nwith release 0.9.19.\n\n## master (unrel"
  },
  {
    "path": "CONTRIBUTING.md",
    "chars": 4524,
    "preview": "# Contributing to Idris-Mode\n\nContributions are always welcome to `idris-mode`.\nHere we describe how you can best contri"
  },
  {
    "path": "CONTRIBUTORS",
    "chars": 823,
    "preview": "# Contributors\n\nOver the years many people have contributed to the development of idris-mode.\nWe thanks the following fo"
  },
  {
    "path": "COPYING",
    "chars": 35147,
    "preview": "                    GNU GENERAL PUBLIC LICENSE\n                       Version 3, 29 June 2007\n\n Copyright (C) 2007 Free "
  },
  {
    "path": "Makefile",
    "chars": 2062,
    "preview": "# Makefile for idris-mode, to run tests and ensure dependencies are in order\n# Portions based on the Makefile for Proof "
  },
  {
    "path": "docs/documentation.tex",
    "chars": 19089,
    "preview": "\\documentclass{article}\n\\usepackage{amsmath}\n\\usepackage{tikz}\n\\usetikzlibrary{positioning}\n\n\\title{idris-mode: Idris in"
  },
  {
    "path": "flycheck-idris.el",
    "chars": 3440,
    "preview": ";;; flycheck-idris.el --- Major mode for editing Idris code -*- lexical-binding: t -*-\n\n;; Copyright (C) 2022\n\n;; Author"
  },
  {
    "path": "idris-commands.el",
    "chars": 59986,
    "preview": ";;; idris-commands.el --- Commands for Emacs passed to Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Me"
  },
  {
    "path": "idris-common-utils.el",
    "chars": 19825,
    "preview": ";;; idris-common-utils.el --- Useful utilities -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013-2015 Hannes Mehnert and"
  },
  {
    "path": "idris-compat.el",
    "chars": 2853,
    "preview": ";;; idris-compat.el --- compatibility functions for Emacs 24.1 -*- lexical-binding: t -*-\n\n;;; Commentary:\n;; This file "
  },
  {
    "path": "idris-core.el",
    "chars": 1338,
    "preview": ";;; idris-core.el --- Core functionality -*- lexical-binding: t -*-\n;; Copyright (C) 2013 Hannes Mehnert\n\n;; Authors: Ha"
  },
  {
    "path": "idris-events.el",
    "chars": 2702,
    "preview": ";;; idris-events.el --- Logging of events in inferior Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Meh"
  },
  {
    "path": "idris-highlight-input.el",
    "chars": 6751,
    "preview": ";;; idris-highlight-input.el --- Compiler-driven highlighting of user input  -*- lexical-binding: t; -*-\n\n;; Copyright ("
  },
  {
    "path": "idris-hole-list.el",
    "chars": 8931,
    "preview": ";;; idris-hole-list.el --- List Idris holes in a buffer -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 David Raymond "
  },
  {
    "path": "idris-info.el",
    "chars": 3628,
    "preview": ";;; idris-info.el --- Facilities for showing Idris help information -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014  D"
  },
  {
    "path": "idris-ipkg-mode.el",
    "chars": 16299,
    "preview": ";;; idris-ipkg-mode.el --- Major mode for editing Idris package files -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014\n"
  },
  {
    "path": "idris-keys.el",
    "chars": 5480,
    "preview": ";;; idris-keys.el --- Hooks to define Idris keybindings -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 David Raymond "
  },
  {
    "path": "idris-log.el",
    "chars": 4638,
    "preview": ";;; idris-log.el --- Logging of Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013-2014 Hannes Mehnert and David Ra"
  },
  {
    "path": "idris-mode.el",
    "chars": 6979,
    "preview": ";;; idris-mode.el --- Major mode for editing Idris code -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013\n\n;; Author:\n;;"
  },
  {
    "path": "idris-navigate.el",
    "chars": 36274,
    "preview": ";;; idris-navigate.el --- navigate in Idris code     -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2020  Andreas Röhler\n"
  },
  {
    "path": "idris-prover.el",
    "chars": 20109,
    "preview": ";;; idris-prover.el --- Prover mode for Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013-2014, Hannes Mehnert and"
  },
  {
    "path": "idris-repl.el",
    "chars": 24505,
    "preview": ";;; idris-repl.el --- Run an Idris interpreter using S-Expression communication protocol.-*- lexical-binding: t -*-\n\n;; "
  },
  {
    "path": "idris-settings.el",
    "chars": 11232,
    "preview": ";;; idris-settings.el --- Contains settings for idris-mode  -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Meh"
  },
  {
    "path": "idris-simple-indent.el",
    "chars": 9458,
    "preview": ";;; idris-simple-indent.el --- Simple indentation module for Idris Mode -*- lexical-binding: t -*-\n\n;; Copyright (C) 199"
  },
  {
    "path": "idris-syntax.el",
    "chars": 10378,
    "preview": ";; idris-syntax.el --- idris syntax highlighting -*- lexical-binding: t -*-\n;;\n;; Copyright (C) 2013 tim dixon, David Ra"
  },
  {
    "path": "idris-tree-info.el",
    "chars": 4514,
    "preview": ";;; idris-info.el --- Facilities for showing Idris help information -*- lexical-binding: t -*-\n\n;; Copyright (C) 2015  D"
  },
  {
    "path": "idris-warnings-tree.el",
    "chars": 11565,
    "preview": ";;; idris-warnings-tree.el --- Tree view of warnings reported by Idris in buffers -*- lexical-binding: t -*-\n\n;; Copyrig"
  },
  {
    "path": "idris-warnings.el",
    "chars": 5541,
    "preview": ";;; idris-warnings.el --- Mark warnings reported by Idris in buffers -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 H"
  },
  {
    "path": "idris-xref.el",
    "chars": 5897,
    "preview": ";;; idris-xref.el --- Xref backend for Idris  -*- lexical-binding: t -*-\n;; Copyright (C) 2022  Marek L.\n\n;; Author: Mar"
  },
  {
    "path": "inferior-idris.el",
    "chars": 15825,
    "preview": ";;; inferior-idris.el --- Run an Idris interpreter using S-Expression communication protocol -*- lexical-binding: t -*-\n"
  },
  {
    "path": "readme.markdown",
    "chars": 19017,
    "preview": "[![MELPA Stable](http://stable.melpa.org/packages/idris-mode-badge.svg)](http://stable.melpa.org/#/idris-mode) [![MELPA]"
  },
  {
    "path": "test/idris-commands-test.el",
    "chars": 22547,
    "preview": ";;; idris-commands-test.el --- Tests for interactive commands  -*- lexical-binding: t -*-\n\n;; Keywords: languages\n\n;; Th"
  },
  {
    "path": "test/idris-info-test.el",
    "chars": 2779,
    "preview": ";;; idris-info-test.el --- Tests related to Idris info buffer  -*- lexical-binding: t -*-\n;; Copyright (C) 2022  Marek L"
  },
  {
    "path": "test/idris-navigate-test.el",
    "chars": 10485,
    "preview": ";;; idris-navigate-test.el --- Tests for idris-navigate  -*- lexical-binding: t -*-\n\n(require 'idris-mode)\n(require 'idr"
  },
  {
    "path": "test/idris-repl-test.el",
    "chars": 3259,
    "preview": ";;; idris-repl-test.el --- Tests for idris-repl  -*- lexical-binding: t -*-\n\n(require 'ert)\n(require 'idris-repl)\n\n;; in"
  },
  {
    "path": "test/idris-test-utils.el",
    "chars": 4902,
    "preview": ";;; idris-test-utils.el --- Tests utility for idris-mode  -*- lexical-binding: t -*-\n\n;; Copyright (C) 2021 Yasuhiko Wat"
  },
  {
    "path": "test/idris-tests.el",
    "chars": 7464,
    "preview": ";;; idris-tests.el --- Tests for idris-mode  -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014  David Raymond Christians"
  },
  {
    "path": "test/idris-xref-test.el",
    "chars": 12288,
    "preview": ";;; idris-xref-test.el --- Tests for Idris Xref backend  -*- lexical-binding: t -*-\n;; Copyright (C) 2022  Marek L.\n\n;; "
  },
  {
    "path": "test/test-data/AddClause.idr",
    "chars": 238,
    "preview": "module AddClause\n\ndata Test = A | B\n\n--++++++++++++++++\ntest : Test -> Int\n\n-- Regression test for:\n-- idris-add-clause "
  },
  {
    "path": "test/test-data/AddMissing.idr",
    "chars": 122,
    "preview": "module AddMissing\n-- (idris-test-run-goto-char #'idris-add-missing)\ndata Test = A | B\n\ntest : Test -> Int\n--++\ntest A = "
  },
  {
    "path": "test/test-data/CaseSplit.idr",
    "chars": 202,
    "preview": "module CaseSplit\n-- (idris-test-run-goto-char #'idris-case-split)\n-- (idris-test-run-goto-char #'idris-case-dwim)\ndata C"
  },
  {
    "path": "test/test-data/Empty.idr",
    "chars": 0,
    "preview": ""
  },
  {
    "path": "test/test-data/Flycheck.idr",
    "chars": 132,
    "preview": "plus : Nat -> Nat -> Nat\nplus x y = plus x \"w\"\n\ndata Foo : Nat -> Type where\n  F : Foo plus\n\ndouble : Nat -> Nat\ndouble "
  },
  {
    "path": "test/test-data/GenerateDef.idr",
    "chars": 639,
    "preview": "module GenerateDef\n\n-- (idris-test-run-goto-char #'idris-generate-def)\ndata Test = A | B\n--++\ntest : Test -> Int\n\n{-\nC-c"
  },
  {
    "path": "test/test-data/Literate.lidr",
    "chars": 173,
    "preview": "> module Literate\n>\n> data Test = A | B\n>\n> test : Test -> Int\n>\n> myReverse : List a -> List a\n> myReverse xs = revAcc "
  },
  {
    "path": "test/test-data/MakeLemma.idr",
    "chars": 170,
    "preview": "module MakeLemma\n\n-- (idris-test-run-goto-char #'idris-make-lemma)\ndata Test = A | B\n\nmy_lemmaTest : Test -> Test\n--    "
  },
  {
    "path": "test/test-data/MakeWithBlock.idr",
    "chars": 77,
    "preview": "module MakeWithBlock\n\n-- (idris-test-run-goto-char #'idris-make-with-block)\n\n"
  },
  {
    "path": "test/test-data/MetavarTest.idr",
    "chars": 154,
    "preview": "module MetavarTest\n\nplusComm : plus n m = plus m n\nplusComm = ?plusComm_rhs\n\nplusAssoc : plus x (plus y z) = plus (plus "
  },
  {
    "path": "test/test-data/ProofSearch.idr",
    "chars": 57,
    "preview": "module ProofSearch\n\nprf : 5 `LTE` 20\nprf = ?search_here\n\n"
  },
  {
    "path": "test/test-data/Refine.idr",
    "chars": 134,
    "preview": "module Refine\n\n-- (idris-test-run-goto-char #'idris-refine \"f\")\n\ndata Test = A | B\n\nf : Test -> Test\nf = const A\n\ntest :"
  },
  {
    "path": "test/test-data/TypeAtPoint.idr",
    "chars": 138,
    "preview": "module TypeAtPoint\n\n-- (idris-test-run-goto-char #'idris-type-at-point)\n\ntest : Int -> Integer\n\ntest2 : Int -> Integer\n-"
  },
  {
    "path": "test/test-data/TypeError.idr",
    "chars": 44,
    "preview": "module TypeError\n\nfoo : Nat\nfoo = \"fnord\"\n\n\n"
  },
  {
    "path": "test/test-data/cmdline/commandlinetest.ipkg",
    "chars": 144,
    "preview": "package commandlinetest\n\n-- Command line test\n-- by David Raymond Christiansen\n\nopts = \"-p effects\"\nsourcedir = src\nmodu"
  },
  {
    "path": "test/test-data/cmdline/src/Command/Line/Test.idr",
    "chars": 25,
    "preview": "module Command.Line.Test\n"
  },
  {
    "path": "test/test-data/package-test/Packaging.idr",
    "chars": 18,
    "preview": "module Packaging\n\n"
  },
  {
    "path": "test/test-data/package-test/test.ipkg",
    "chars": 51,
    "preview": "package test\n\npkgs = recursion_schemes, idris-free\n"
  }
]

About this extraction

This page contains the full source code of the idris-hackers/idris-mode GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 61 files (449.8 KB), approximately 114.2k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.

Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.

Copied to clipboard!