[ { "path": ".github/workflows/idris1.yml", "content": "name: Idris1 on Ubuntu\n\non:\n push:\n branches:\n - '*'\n tags:\n - '*'\n pull_request:\n branches:\n - main\n\njobs:\n# -- [ Build ]\n build:\n\n# ---- [ Initialise Build Environment ]\n runs-on: ubuntu-latest\n timeout-minutes: 60\n strategy:\n matrix:\n emacs: [30.2]\n idris: [git]\n env:\n EMACS_VERSION: ${{ matrix.emacs }}\n IDRIS_VERSION: ${{ matrix.idris }}\n\n# ---- [ Steps to Run ]\n steps:\n\n# ----- [ Steps Dependencies ]\n - name: Fetch Dependencies\n run: sudo apt install -y libgc-dev libgif-dev libxaw7-dev openssl\n\n# ----- [ Initialise Variables ]\n\n - name: Initialise variables\n run: |\n mkdir -p $HOME/.local/bin\n echo \"$HOME/.local/bin\" >> $GITHUB_PATH\n\n# ----- [ Emacs ]\n\n - name: Fetch Emacs\n uses: purcell/setup-emacs@master\n with:\n version: ${{ matrix.emacs }}\n\n# ----- [ Caches ]\n\n - name: Cache stack global package-db\n id: stack-global\n uses: actions/cache@v3\n with:\n path: ~/.stack\n key: ${{ runner.os }}-stack-global-${{ matrix.idris }}\n restore-keys: |\n ${{ runner.os }}-stack-global-${{ matrix.idris }}\n\n - name: Cache stack-installed programs in ~/.local/bin\n id: stack-programs\n uses: actions/cache@v3\n with:\n path: ~/.local/bin\n key: ${{ runner.os }}-stack-programs-${{ matrix.idris }}\n restore-keys: |\n ${{ runner.os }}-stack-programs-${{ matrix.idris }}\n\n - name: Cache .stack-work\n uses: actions/cache@v3\n with:\n path: .stack-work\n key: ${{ runner.os }}-stack-work-${{ matrix.idris }}\n restore-keys: |\n ${{ runner.os }}-stack-work-${{ matrix.idris }}\n\n\n - name: Cache idris-dev-git/\n if: matrix.idris == 'git'\n id: idris-dev-git\n uses: actions/cache@v3\n with:\n path: ~/idris-dev-git/\n key: ${{ runner.os }}-idris-dev-stack-work-${{ matrix.idris }}\n restore-keys: |\n ${{ runner.os }}-idris-dev-stack-work-${{ matrix.idris }}\n\n# ----- [ Idris from GIT ]\n - name: Install Idris from GIT\n if: matrix.idris == 'git' && steps.idris-dev-git.outputs.cache-hit != 'true'\n run: |\n pushd .\n git clone https://github.com/idris-lang/Idris-dev.git ~/idris-dev-git\n cd ~/idris-dev-git\n stack --no-terminal install --flag idris:-FFI --flag idris:-GMP\n popd\n idris --info\n\n# ----- [ Idris from Stack ]\n - name: Install Idris from Stackage\n if: matrix.idris == 'stackage' && steps.stack-program.outputs.cache-hit != 'true'\n run: |\n stack install --resolver lts-12.26 idris\n\n# ----- [ Checkout and Run]\n - name: Checkout\n uses: actions/checkout@v3\n\n - name: Run Tests\n run: |\n make clean\n make build\n make test\n\n# -- EOF\n" }, { "path": ".github/workflows/idris2.yml", "content": "## Adapted from The Frex Project.\n\nname: Idris2 on Ubuntu\n\n# -- [ When to Act]\n\non:\n push:\n branches:\n - '*'\n tags:\n - '*'\n pull_request:\n branches:\n - main\n\n# -- [ ENV Variables ]\n\nenv:\n SCHEME: scheme\n\n# -- [ Jobs ]\njobs:\n\n## -- [ Initialise Build Environment ]\n build:\n runs-on: ubuntu-latest\n\n timeout-minutes: 60\n\n strategy:\n matrix:\n emacs: [28.2, 29.4, 30.2]\n\n env:\n EMACS_VERSION: ${{ matrix.emacs }}\n\n## -- [ Steps To Run ]\n steps:\n\n### -- [ Initialise Variables ]\n\n - name: Initialise variables\n run: |\n # Only deploy if the build follows from pushing to main\n echo \"$HOME/.idris2/bin\" >> $GITHUB_PATH\n\n### -- [ Cache Idris2 ]\n\n - name: Cache Idris2\n uses: actions/cache@v3\n id: cache-idris2\n with:\n path: |\n ~/.idris2\n key: ${{ runner.os }}-idris2\n\n### -- [ Fetch Dependencies ]\n\n#### -- [ Chez Scheme ]\n\n - name: Install Chez\n run: |\n sudo apt-get update\n sudo apt-get install -y chezscheme\n\n#### -- [ Idris2 ]\n\n - name: Install Idris2\n if: steps.cache-idris2.outputs.cache-hit != 'true'\n run: |\n pushd .\n git clone https://github.com/idris-lang/idris2\n cd idris2\n make bootstrap && make install\n popd\n\n#### -- [ Emacs ]\n\n - name: Fetch Emacs\n uses: purcell/setup-emacs@master\n with:\n version: ${{ matrix.emacs }}\n\n### -- [ Checkout the test ]\n\n - name: Checkout\n uses: actions/checkout@v3\n\n### -- [ Test ]\n\n - name: Build and Run\n run: |\n make clean\n make build\n make test2\n\n# -- [ EOF ]\n" }, { "path": ".gitignore", "content": "*~\n*.elc\ndocumentation.aux\ndocumentation.log\ndocumentation.pdf\ntest-data/build/\ntest-data/*.ibc\ntest-data/idris2-history.eld\ntest-data/Empty.idr\n\ndocs/*.aux\ndocs/*.log\ndocs/*.pdf\ndocs/auto/\ndocs/*.fdb_latexmk\ndocs/*.fls\ndocs/*.xdv\n\n*.ttc\n*.ttm\n" }, { "path": ".travis.yml", "content": "# Based on https://docs.haskellstack.org/en/stable/travis_ci/\n#\n# Copy these contents into the root directory of your Github project in a file\n# named .travis.yml\n\n# choose a build environment\ndist: xenial\n\n# Use new container infrastructure to enable caching\nsudo: false\n\n# Do not choose a language; we provide our own build tools.\nlanguage: generic\n\nmatrix:\n include:\n - env: EMACS_VERSION=24.5 IDRIS_VERSION=git\n - env: EMACS_VERSION=24.5 IDRIS_VERSION=stackage\n - env: EMACS_VERSION=25.3 IDRIS_VERSION=git\n - env: EMACS_VERSION=25.3 IDRIS_VERSION=stackage\n - env: EMACS_VERSION=26.1 IDRIS_VERSION=git\n - env: EMACS_VERSION=26.1 IDRIS_VERSION=stackage\n\n# Caching so the next build will be fast too.\ncache:\n directories:\n - $HOME/.stack\n\n# Ensure necessary system libraries are present\naddons:\n apt:\n packages:\n - libgc-dev\n\nbefore_install:\n # Download and unpack the stack executable\n - mkdir -p ~/.local/bin\n - export PATH=$HOME/.local/bin:$PATH\n - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'\n\n ## Emacs\n - sudo apt-get install -y libgif-dev libxaw7-dev\n - wget http://ftpmirror.gnu.org/emacs/emacs-${EMACS_VERSION}.tar.xz\n - tar -xf emacs-${EMACS_VERSION}.tar.xz\n - cd emacs-${EMACS_VERSION}\n - ./configure --prefix=/usr/local/emacs-${EMACS_VERSION} --with-gnutls=no\n - make\n - sudo make install\n - cd ..\n\n# Install Idris\ninstall: . ./.travis_install.sh\n\nbefore_script: true\n\nscript:\n - make clean\n - make build\n - make test EMACS=/usr/local/emacs-${EMACS_VERSION}/bin/emacs\n" }, { "path": ".travis_install.sh", "content": "#! /usr/bin/env bash\n\nset -ev\n\ncase $IDRIS_VERSION in\n git)\n pushd .\n git clone https://github.com/idris-lang/Idris-dev.git /tmp/Idris-dev\n cd /tmp/Idris-dev\n stack --no-terminal --install-ghc install --flag idris:-FFI --flag idris:-GMP\n popd\n ;;\n stackage)\n travis_wait 30 stack install --resolver lts-12.26 idris\n ;;\n *)\n echo '$IDRIS_VERSION unspecified'\n ;;\nesac\n" }, { "path": "CHANGES.markdown", "content": "# Changes\n\nThis file documents the user-interface changes in idris-mode, starting\nwith release 0.9.19.\n\n## master (unreleased)\n\n### New features\n\n+ [cab781537f](https://github.com/idris-hackers/idris-mode/commit/cab781537f): Improved flycheck integration for Idris1 and Idris2.\n+ [c9b2a4bee6](https://github.com/idris-hackers/idris-mode/commit/c9b2a4bee6): Xref integration to support \"jump to definition\" features.\n+ [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.\n It is opposite of `M-x idris-switch-to-repl` and uses same key binding by default (`C-c C-z`).\n+ [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.\n+ [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\n+ [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\n+ [3cce2336b7](https://github.com/idris-hackers/idris-mode/commit/3cce2336b7): More granular configuration for enabling semantic source highlighting.\n\n### Changes\n\n+ [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.\n+ [d1a9171fd7](https://github.com/idris-hackers/idris-mode/commit/d1a9171fd7): Jump to last Idris Code buffer when we quit buffer\n+ [cd734fdc7a](https://github.com/idris-hackers/idris-mode/commit/cd734fdc7a): Write Idris repl history file to `~/.idris2/` directory.\n+ [8329b73be8](https://github.com/idris-hackers/idris-mode/commit/8329b73be8): Move \"words of encouragement\" from mini-buffer to Idris repl banner.\n+ [71ab6a35e3](https://github.com/idris-hackers/idris-mode/commit/71ab6a35e3): Update semantic source highlighting file only in changed code parts reducing buffer \"flickering\".\n+ [e5ef933366](https://github.com/idris-hackers/idris-mode/commit/e5ef933366): Only display Idris repl buffer on load without moving the point.\n+ [9e931bf1ff](https://github.com/idris-hackers/idris-mode/commit/9e931bf1ff): Make `idris-list-holes-on-load` obsolete in favour of `idris-list-holes` command.\n+ [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`\n+ [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.\n+ [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`.\n+ [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.\n\n### Bug fixes\n\n+ Fix `idris-identifier-face` looking wrong in `org-mode` blocks and the like.\n+ [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.\n+ [62c3ad2b0d](https://github.com/idris-hackers/idris-mode/commit/62c3ad2b0d): Do not display unnecessary `*idris-process*` buffer when loading file.\n+ [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.\n+ [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.\n+ [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\n+ [216945f4a6](https://github.com/idris-hackers/idris-mode/commit/216945f4a6): Fix \"off-by-one\" source code highlighting in Idris 1.\n+ [928f785bb7](https://github.com/idris-hackers/idris-mode/commit/928f785bb7): Allow loading multiple files with identical name but in different directories.\n+ [ac029bc67e](https://github.com/idris-hackers/idris-mode/commit/ac029bc67e): Remove extra white-space included by Idris2 on `idris-add-clause` command.\n+ [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\n+ [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.\n+ [3e7cbb331f](https://github.com/idris-hackers/idris-mode/commit/3e7cbb331f): Improve compatibility with Idris2\n+ [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\n\n## 1.1\n\n+ New customisation settings:\n + `idris-display-words-of-encouragement` toggles showing words of encouragement.\n + `idris-completion-via-compiler` toggles use of the Idris compiler to provide completion.\n + Tab in the repl still uses `completion-at-point`.\n+ Improvements to testing harness, with support for testing against Idris2.\n+ Migration of CI from Travis to GitHub Actions\n + Deprecation of older emacs for testing.\n+ More support for IDE Protocol Version2 (i.e. Idris2).\n+ Upstream changes as contributed to the Idris2-Mode on idris-community.\n + Improvements to Makefile\n + Changes to semantic faces\n\n## 1.0\n\n+ Idris mode has been brought uptodate with Idris1\n+ Basic navigation commands added\n\n### Fixes\n\n+ Fix regular expression when matching on `.ipkg` extensions\n+ Prevent completion-error when identifier is at beginning of buffer\n+ Internal code changes\n+ Better development testing with travis\n\n### UX\n\n+ `C-u C-c C-l` flags the buffer as dirty\n+ Add images back into the repl\n+ Disable the Idris event log by default\n+ When Idris returns no proof search, do not delete the metavas\n+ Remove references to idris-event-buffer-name when idris-log-events is nil\n+ Fix idris-simple-indent-backtab\n+ Give operator chars \".\" syntax and improve idris-thing-at-point\n+ Conditional semantic faces for light/dark backgrounds\n\n### Documentation\n\n+ General fix ups\n+ Document a way of reducing excessive frames\n\n\n## 2016 Feb 29\n\n * It is possible to customize what happens to the focus of the current\n window when the type checking is performed and type errors are detected,\n now the user can choose between two options: 1) the current window stays\n focused or 2) the focus goes to the `*idris-notes*` buffer.\n The true or false value of the variable\n `idris-stay-in-current-window-on-compiler-error` controls this behaviour.\n\n## 0.9.19\n\n * The variable `idris-packages` has been renamed to\n `idris-load-packages`. If you have this as a file variable, please\n rename it.\n * The faces `idris-quasiquotation-face` and\n `idris-antiquotation-face` have been added, for compiler-supported\n highlighting of quotations. They are, by default, without\n properties, but they can be customized if desired.\n * Active terms can now be right-clicked. The old \"show term widgets\"\n command is no longer necessary, and will be removed in an upcoming\n release.\n * The case split command can be run on a hole, causing it to be filled\n with a prototype for a case split expression. Case-splitting a pattern\n variable has the same effect as before.\n * There is support for the interactive elaborator, which may replace\n the interactive prover in a future release. To use this, set\n `idris-enable-elab-prover` to non-`nil`.\n" }, { "path": "CONTRIBUTING.md", "content": "# Contributing to Idris-Mode\n\nContributions are always welcome to `idris-mode`.\nHere we describe how you can best contribute to `idris-mode`.\n\nMuch like Idris itself, `idris-mode` is run by volunteers and there are no full-time maintainers.\nOur time is limited and we must take care to ensure that the demands of our day job take priority.\nThus, we must take care in ensure that *we* can maintain `idris-mode` itself.\n\n## Tests\n\nBefore 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:\n\n1. 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.\n\n2. There is a test suite that can be invoked with `make test`. It requires a functioning `idris` executable.\n\n## General Comments\n\nWe 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.\nWhile `idris-mode` does not pertain to any general philosophy we make one thing clear:\n\n> 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.\n\nThus `idris-mode` must support *all* versions of the protocol associated with Idris1 and Idris2.\n\nThe `idris-mode` has simple test suite and some documentation.\nPlease try to ensure that contributions to the project keeps those in sync.\n\nWe do not prescribe to any coding style wrt to emacs lisp; this may change.\nPlease try to remember to keep the code styling consistent with how you found it.\nA good rule to follow is that of the 'CampSite Rule': Leave the code tidier than you found it.\n\nPlease remember to update `CHANGELOG.md`, and if it's your first contribution you can add yourself to `CONTRIBUTORS`.\n\nWhen submitting a pull request to the project, please try to adhere to good commit practises.\n\n+ Lead the commit with a short description that explains it purpose;\n+ optionally prepending the description with descriptive tags enclosed in square brackets;\n+ If necessary provide a longer description after the brief.\n\nGitHub will populate the description of a PR with the HEAD's commit message.\nWhile convenient it may mean that the entire purpose of the PR is lost.\nPlease try to ensure that the PR description sufficiently describes the PR and not just the HERAD commit.\nSimilarly, try to ensure that the GitHub description does not contain information that should be in the commits.\nWe may end up moving from GitHub and we want to retain as much of the development history as possible.\n\nIn 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.\nWe want to ensure that people do not waste their time on things we will not accept.\nWe will endeavour to keep track in the code-base larger discussions that are closed.\n\n## Things we welcome\n\n+ New features;\n+ Fixes for the issue tracker;\n+ Support for Version 2 of the IDE-Protoccol;\n+ Documentation;\n+ More tests;\n\n## Things we want to discuss first\n\n+ major code refactorings;\n+ changes to the core operations;\n+ anything that makes deep changes to how `idris-mode` operates;\n\n## Things we are hesitent about\n\n+ 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;\n\n## Things we will not welcome\n\n+ Dropping of support for older versions of the protocol;\n\n\n## Other possible contributions\n\nIf you have any other ideas on how to improve `idris-mode`, that is not covered above, please do get in touch.\nWe can discuss your idea and see how well it would fit in to the project as a whole.\n\n## Where to talk.\n\nThe maintainers of `idris-mode` are embedded within the larger Idris project, you can find us hanging around there.\nGood places to discuss possible contributions are:\n\n The mailing list _.\n The Idris community on Discord (Invite link) _\n The issue tracker (in this case, please make your proposal as concrete as possible).\n\n\n" }, { "path": "CONTRIBUTORS", "content": "# Contributors\n\nOver the years many people have contributed to the development of idris-mode.\nWe thanks the following for their contributions:\n\nAhmad Salim Al-Sibahi\nAlex Segura\nAlyssa Carter\nAndreas Roehler\nArnaud Bailly\nBartosz Przygoda\nBrendan Zabarauskas\nDaniel Kimbel\nDavid Christiansen\nDavid Raymond Christiansen\nDavid Thrane Christiansen\nEldar Gabdullin\nGuillaume ALLAIS\nHannes Mehnert\nHardy Jones\nHugh FD Jackson\nJan de Muijnck-Hughes\nJefferson Carpenter\nJeremy Yallop\nJohn Soo\nJosh\nJozsef Hegedus\nJuergen Hoetzel\nMario Rodas\nMarek L.\nMark Laws\nMatti Hanninen\nMicah Werbitt\nMichael Morgan\nMort Yao\nNicolas Dudebout\nOhad Kammar\nPaul Dempster\nPeter Harpending\nSamuel Memmel\nSimon Pelchat\nSteve Purcell\nSteven Shaw\nSyohei YOSHIDA\nTaru Karttunen\nTassilo Horn\nTim Humphries\nYasu Watanabe\ndefanor\nstartling\nκeen\nidentity\n" }, { "path": "COPYING", "content": " GNU GENERAL PUBLIC LICENSE\n Version 3, 29 June 2007\n\n Copyright (C) 2007 Free Software Foundation, Inc. \n Everyone is permitted to copy and distribute verbatim copies\n of this license document, but changing it is not allowed.\n\n Preamble\n\n The GNU General Public License is a free, copyleft license for\nsoftware and other kinds of works.\n\n The licenses for most software and other practical works are designed\nto take away your freedom to share and change the works. By contrast,\nthe GNU General Public License is intended to guarantee your freedom to\nshare and change all versions of a program--to make sure it remains free\nsoftware for all its users. We, the Free Software Foundation, use the\nGNU General Public License for most of our software; it applies also to\nany other work released this way by its authors. You can apply it to\nyour programs, too.\n\n When we speak of free software, we are referring to freedom, not\nprice. Our General Public Licenses are designed to make sure that you\nhave the freedom to distribute copies of free software (and charge for\nthem if you wish), that you receive source code or can get it if you\nwant it, that you can change the software or use pieces of it in new\nfree programs, and that you know you can do these things.\n\n To protect your rights, we need to prevent others from denying you\nthese rights or asking you to surrender the rights. Therefore, you have\ncertain responsibilities if you distribute copies of the software, or if\nyou modify it: responsibilities to respect the freedom of others.\n\n For example, if you distribute copies of such a program, whether\ngratis or for a fee, you must pass on to the recipients the same\nfreedoms that you received. You must make sure that they, too, receive\nor can get the source code. And you must show them these terms so they\nknow their rights.\n\n Developers that use the GNU GPL protect your rights with two steps:\n(1) assert copyright on the software, and (2) offer you this License\ngiving you legal permission to copy, distribute and/or modify it.\n\n For the developers' and authors' protection, the GPL clearly explains\nthat there is no warranty for this free software. For both users' and\nauthors' sake, the GPL requires that modified versions be marked as\nchanged, so that their problems will not be attributed erroneously to\nauthors of previous versions.\n\n Some devices are designed to deny users access to install or run\nmodified versions of the software inside them, although the manufacturer\ncan do so. This is fundamentally incompatible with the aim of\nprotecting users' freedom to change the software. The systematic\npattern of such abuse occurs in the area of products for individuals to\nuse, which is precisely where it is most unacceptable. Therefore, we\nhave designed this version of the GPL to prohibit the practice for those\nproducts. If such problems arise substantially in other domains, we\nstand ready to extend this provision to those domains in future versions\nof the GPL, as needed to protect the freedom of users.\n\n Finally, every program is threatened constantly by software patents.\nStates should not allow patents to restrict development and use of\nsoftware on general-purpose computers, but in those that do, we wish to\navoid the special danger that patents applied to a free program could\nmake it effectively proprietary. To prevent this, the GPL assures that\npatents cannot be used to render the program non-free.\n\n The precise terms and conditions for copying, distribution and\nmodification follow.\n\n TERMS AND CONDITIONS\n\n 0. Definitions.\n\n \"This License\" refers to version 3 of the GNU General Public License.\n\n \"Copyright\" also means copyright-like laws that apply to other kinds of\nworks, such as semiconductor masks.\n\n \"The Program\" refers to any copyrightable work licensed under this\nLicense. Each licensee is addressed as \"you\". \"Licensees\" and\n\"recipients\" may be individuals or organizations.\n\n To \"modify\" a work means to copy from or adapt all or part of the work\nin a fashion requiring copyright permission, other than the making of an\nexact copy. The resulting work is called a \"modified version\" of the\nearlier work or a work \"based on\" the earlier work.\n\n A \"covered work\" means either the unmodified Program or a work based\non the Program.\n\n To \"propagate\" a work means to do anything with it that, without\npermission, would make you directly or secondarily liable for\ninfringement under applicable copyright law, except executing it on a\ncomputer or modifying a private copy. Propagation includes copying,\ndistribution (with or without modification), making available to the\npublic, and in some countries other activities as well.\n\n To \"convey\" a work means any kind of propagation that enables other\nparties to make or receive copies. Mere interaction with a user through\na computer network, with no transfer of a copy, is not conveying.\n\n An interactive user interface displays \"Appropriate Legal Notices\"\nto the extent that it includes a convenient and prominently visible\nfeature that (1) displays an appropriate copyright notice, and (2)\ntells the user that there is no warranty for the work (except to the\nextent that warranties are provided), that licensees may convey the\nwork under this License, and how to view a copy of this License. If\nthe interface presents a list of user commands or options, such as a\nmenu, a prominent item in the list meets this criterion.\n\n 1. Source Code.\n\n The \"source code\" for a work means the preferred form of the work\nfor making modifications to it. \"Object code\" means any non-source\nform of a work.\n\n A \"Standard Interface\" means an interface that either is an official\nstandard defined by a recognized standards body, or, in the case of\ninterfaces specified for a particular programming language, one that\nis widely used among developers working in that language.\n\n The \"System Libraries\" of an executable work include anything, other\nthan the work as a whole, that (a) is included in the normal form of\npackaging a Major Component, but which is not part of that Major\nComponent, and (b) serves only to enable use of the work with that\nMajor Component, or to implement a Standard Interface for which an\nimplementation is available to the public in source code form. A\n\"Major Component\", in this context, means a major essential component\n(kernel, window system, and so on) of the specific operating system\n(if any) on which the executable work runs, or a compiler used to\nproduce the work, or an object code interpreter used to run it.\n\n The \"Corresponding Source\" for a work in object code form means all\nthe source code needed to generate, install, and (for an executable\nwork) run the object code and to modify the work, including scripts to\ncontrol those activities. However, it does not include the work's\nSystem Libraries, or general-purpose tools or generally available free\nprograms which are used unmodified in performing those activities but\nwhich are not part of the work. For example, Corresponding Source\nincludes interface definition files associated with source files for\nthe work, and the source code for shared libraries and dynamically\nlinked subprograms that the work is specifically designed to require,\nsuch as by intimate data communication or control flow between those\nsubprograms and other parts of the work.\n\n The Corresponding Source need not include anything that users\ncan regenerate automatically from other parts of the Corresponding\nSource.\n\n The Corresponding Source for a work in source code form is that\nsame work.\n\n 2. Basic Permissions.\n\n All rights granted under this License are granted for the term of\ncopyright on the Program, and are irrevocable provided the stated\nconditions are met. This License explicitly affirms your unlimited\npermission to run the unmodified Program. The output from running a\ncovered work is covered by this License only if the output, given its\ncontent, constitutes a covered work. This License acknowledges your\nrights of fair use or other equivalent, as provided by copyright law.\n\n You may make, run and propagate covered works that you do not\nconvey, without conditions so long as your license otherwise remains\nin force. You may convey covered works to others for the sole purpose\nof having them make modifications exclusively for you, or provide you\nwith facilities for running those works, provided that you comply with\nthe terms of this License in conveying all material for which you do\nnot control copyright. Those thus making or running the covered works\nfor you must do so exclusively on your behalf, under your direction\nand control, on terms that prohibit them from making any copies of\nyour copyrighted material outside their relationship with you.\n\n Conveying under any other circumstances is permitted solely under\nthe conditions stated below. Sublicensing is not allowed; section 10\nmakes it unnecessary.\n\n 3. Protecting Users' Legal Rights From Anti-Circumvention Law.\n\n No covered work shall be deemed part of an effective technological\nmeasure under any applicable law fulfilling obligations under article\n11 of the WIPO copyright treaty adopted on 20 December 1996, or\nsimilar laws prohibiting or restricting circumvention of such\nmeasures.\n\n When you convey a covered work, you waive any legal power to forbid\ncircumvention of technological measures to the extent such circumvention\nis effected by exercising rights under this License with respect to\nthe covered work, and you disclaim any intention to limit operation or\nmodification of the work as a means of enforcing, against the work's\nusers, your or third parties' legal rights to forbid circumvention of\ntechnological measures.\n\n 4. Conveying Verbatim Copies.\n\n You may convey verbatim copies of the Program's source code as you\nreceive it, in any medium, provided that you conspicuously and\nappropriately publish on each copy an appropriate copyright notice;\nkeep intact all notices stating that this License and any\nnon-permissive terms added in accord with section 7 apply to the code;\nkeep intact all notices of the absence of any warranty; and give all\nrecipients a copy of this License along with the Program.\n\n You may charge any price or no price for each copy that you convey,\nand you may offer support or warranty protection for a fee.\n\n 5. Conveying Modified Source Versions.\n\n You may convey a work based on the Program, or the modifications to\nproduce it from the Program, in the form of source code under the\nterms of section 4, provided that you also meet all of these conditions:\n\n a) The work must carry prominent notices stating that you modified\n it, and giving a relevant date.\n\n b) The work must carry prominent notices stating that it is\n released under this License and any conditions added under section\n 7. This requirement modifies the requirement in section 4 to\n \"keep intact all notices\".\n\n c) You must license the entire work, as a whole, under this\n License to anyone who comes into possession of a copy. This\n License will therefore apply, along with any applicable section 7\n additional terms, to the whole of the work, and all its parts,\n regardless of how they are packaged. This License gives no\n permission to license the work in any other way, but it does not\n invalidate such permission if you have separately received it.\n\n d) If the work has interactive user interfaces, each must display\n Appropriate Legal Notices; however, if the Program has interactive\n interfaces that do not display Appropriate Legal Notices, your\n work need not make them do so.\n\n A compilation of a covered work with other separate and independent\nworks, which are not by their nature extensions of the covered work,\nand which are not combined with it such as to form a larger program,\nin or on a volume of a storage or distribution medium, is called an\n\"aggregate\" if the compilation and its resulting copyright are not\nused to limit the access or legal rights of the compilation's users\nbeyond what the individual works permit. Inclusion of a covered work\nin an aggregate does not cause this License to apply to the other\nparts of the aggregate.\n\n 6. Conveying Non-Source Forms.\n\n You may convey a covered work in object code form under the terms\nof sections 4 and 5, provided that you also convey the\nmachine-readable Corresponding Source under the terms of this License,\nin one of these ways:\n\n a) Convey the object code in, or embodied in, a physical product\n (including a physical distribution medium), accompanied by the\n Corresponding Source fixed on a durable physical medium\n customarily used for software interchange.\n\n b) Convey the object code in, or embodied in, a physical product\n (including a physical distribution medium), accompanied by a\n written offer, valid for at least three years and valid for as\n long as you offer spare parts or customer support for that product\n model, to give anyone who possesses the object code either (1) a\n copy of the Corresponding Source for all the software in the\n product that is covered by this License, on a durable physical\n medium customarily used for software interchange, for a price no\n more than your reasonable cost of physically performing this\n conveying of source, or (2) access to copy the\n Corresponding Source from a network server at no charge.\n\n c) Convey individual copies of the object code with a copy of the\n written offer to provide the Corresponding Source. This\n alternative is allowed only occasionally and noncommercially, and\n only if you received the object code with such an offer, in accord\n with subsection 6b.\n\n d) Convey the object code by offering access from a designated\n place (gratis or for a charge), and offer equivalent access to the\n Corresponding Source in the same way through the same place at no\n further charge. You need not require recipients to copy the\n Corresponding Source along with the object code. If the place to\n copy the object code is a network server, the Corresponding Source\n may be on a different server (operated by you or a third party)\n that supports equivalent copying facilities, provided you maintain\n clear directions next to the object code saying where to find the\n Corresponding Source. Regardless of what server hosts the\n Corresponding Source, you remain obligated to ensure that it is\n available for as long as needed to satisfy these requirements.\n\n e) Convey the object code using peer-to-peer transmission, provided\n you inform other peers where the object code and Corresponding\n Source of the work are being offered to the general public at no\n charge under subsection 6d.\n\n A separable portion of the object code, whose source code is excluded\nfrom the Corresponding Source as a System Library, need not be\nincluded in conveying the object code work.\n\n A \"User Product\" is either (1) a \"consumer product\", which means any\ntangible personal property which is normally used for personal, family,\nor household purposes, or (2) anything designed or sold for incorporation\ninto a dwelling. In determining whether a product is a consumer product,\ndoubtful cases shall be resolved in favor of coverage. For a particular\nproduct received by a particular user, \"normally used\" refers to a\ntypical or common use of that class of product, regardless of the status\nof the particular user or of the way in which the particular user\nactually uses, or expects or is expected to use, the product. A product\nis a consumer product regardless of whether the product has substantial\ncommercial, industrial or non-consumer uses, unless such uses represent\nthe only significant mode of use of the product.\n\n \"Installation Information\" for a User Product means any methods,\nprocedures, authorization keys, or other information required to install\nand execute modified versions of a covered work in that User Product from\na modified version of its Corresponding Source. The information must\nsuffice to ensure that the continued functioning of the modified object\ncode is in no case prevented or interfered with solely because\nmodification has been made.\n\n If you convey an object code work under this section in, or with, or\nspecifically for use in, a User Product, and the conveying occurs as\npart of a transaction in which the right of possession and use of the\nUser Product is transferred to the recipient in perpetuity or for a\nfixed term (regardless of how the transaction is characterized), the\nCorresponding Source conveyed under this section must be accompanied\nby the Installation Information. But this requirement does not apply\nif neither you nor any third party retains the ability to install\nmodified object code on the User Product (for example, the work has\nbeen installed in ROM).\n\n The requirement to provide Installation Information does not include a\nrequirement to continue to provide support service, warranty, or updates\nfor a work that has been modified or installed by the recipient, or for\nthe User Product in which it has been modified or installed. Access to a\nnetwork may be denied when the modification itself materially and\nadversely affects the operation of the network or violates the rules and\nprotocols for communication across the network.\n\n Corresponding Source conveyed, and Installation Information provided,\nin accord with this section must be in a format that is publicly\ndocumented (and with an implementation available to the public in\nsource code form), and must require no special password or key for\nunpacking, reading or copying.\n\n 7. Additional Terms.\n\n \"Additional permissions\" are terms that supplement the terms of this\nLicense by making exceptions from one or more of its conditions.\nAdditional permissions that are applicable to the entire Program shall\nbe treated as though they were included in this License, to the extent\nthat they are valid under applicable law. If additional permissions\napply only to part of the Program, that part may be used separately\nunder those permissions, but the entire Program remains governed by\nthis License without regard to the additional permissions.\n\n When you convey a copy of a covered work, you may at your option\nremove any additional permissions from that copy, or from any part of\nit. (Additional permissions may be written to require their own\nremoval in certain cases when you modify the work.) You may place\nadditional permissions on material, added by you to a covered work,\nfor which you have or can give appropriate copyright permission.\n\n Notwithstanding any other provision of this License, for material you\nadd to a covered work, you may (if authorized by the copyright holders of\nthat material) supplement the terms of this License with terms:\n\n a) Disclaiming warranty or limiting liability differently from the\n terms of sections 15 and 16 of this License; or\n\n b) Requiring preservation of specified reasonable legal notices or\n author attributions in that material or in the Appropriate Legal\n Notices displayed by works containing it; or\n\n c) Prohibiting misrepresentation of the origin of that material, or\n requiring that modified versions of such material be marked in\n reasonable ways as different from the original version; or\n\n d) Limiting the use for publicity purposes of names of licensors or\n authors of the material; or\n\n e) Declining to grant rights under trademark law for use of some\n trade names, trademarks, or service marks; or\n\n f) Requiring indemnification of licensors and authors of that\n material by anyone who conveys the material (or modified versions of\n it) with contractual assumptions of liability to the recipient, for\n any liability that these contractual assumptions directly impose on\n those licensors and authors.\n\n All other non-permissive additional terms are considered \"further\nrestrictions\" within the meaning of section 10. If the Program as you\nreceived it, or any part of it, contains a notice stating that it is\ngoverned by this License along with a term that is a further\nrestriction, you may remove that term. If a license document contains\na further restriction but permits relicensing or conveying under this\nLicense, you may add to a covered work material governed by the terms\nof that license document, provided that the further restriction does\nnot survive such relicensing or conveying.\n\n If you add terms to a covered work in accord with this section, you\nmust place, in the relevant source files, a statement of the\nadditional terms that apply to those files, or a notice indicating\nwhere to find the applicable terms.\n\n Additional terms, permissive or non-permissive, may be stated in the\nform of a separately written license, or stated as exceptions;\nthe above requirements apply either way.\n\n 8. Termination.\n\n You may not propagate or modify a covered work except as expressly\nprovided under this License. Any attempt otherwise to propagate or\nmodify it is void, and will automatically terminate your rights under\nthis License (including any patent licenses granted under the third\nparagraph of section 11).\n\n However, if you cease all violation of this License, then your\nlicense from a particular copyright holder is reinstated (a)\nprovisionally, unless and until the copyright holder explicitly and\nfinally terminates your license, and (b) permanently, if the copyright\nholder fails to notify you of the violation by some reasonable means\nprior to 60 days after the cessation.\n\n Moreover, your license from a particular copyright holder is\nreinstated permanently if the copyright holder notifies you of the\nviolation by some reasonable means, this is the first time you have\nreceived notice of violation of this License (for any work) from that\ncopyright holder, and you cure the violation prior to 30 days after\nyour receipt of the notice.\n\n Termination of your rights under this section does not terminate the\nlicenses of parties who have received copies or rights from you under\nthis License. If your rights have been terminated and not permanently\nreinstated, you do not qualify to receive new licenses for the same\nmaterial under section 10.\n\n 9. Acceptance Not Required for Having Copies.\n\n You are not required to accept this License in order to receive or\nrun a copy of the Program. Ancillary propagation of a covered work\noccurring solely as a consequence of using peer-to-peer transmission\nto receive a copy likewise does not require acceptance. However,\nnothing other than this License grants you permission to propagate or\nmodify any covered work. These actions infringe copyright if you do\nnot accept this License. Therefore, by modifying or propagating a\ncovered work, you indicate your acceptance of this License to do so.\n\n 10. Automatic Licensing of Downstream Recipients.\n\n Each time you convey a covered work, the recipient automatically\nreceives a license from the original licensors, to run, modify and\npropagate that work, subject to this License. You are not responsible\nfor enforcing compliance by third parties with this License.\n\n An \"entity transaction\" is a transaction transferring control of an\norganization, or substantially all assets of one, or subdividing an\norganization, or merging organizations. If propagation of a covered\nwork results from an entity transaction, each party to that\ntransaction who receives a copy of the work also receives whatever\nlicenses to the work the party's predecessor in interest had or could\ngive under the previous paragraph, plus a right to possession of the\nCorresponding Source of the work from the predecessor in interest, if\nthe predecessor has it or can get it with reasonable efforts.\n\n You may not impose any further restrictions on the exercise of the\nrights granted or affirmed under this License. For example, you may\nnot impose a license fee, royalty, or other charge for exercise of\nrights granted under this License, and you may not initiate litigation\n(including a cross-claim or counterclaim in a lawsuit) alleging that\nany patent claim is infringed by making, using, selling, offering for\nsale, or importing the Program or any portion of it.\n\n 11. Patents.\n\n A \"contributor\" is a copyright holder who authorizes use under this\nLicense of the Program or a work on which the Program is based. The\nwork thus licensed is called the contributor's \"contributor version\".\n\n A contributor's \"essential patent claims\" are all patent claims\nowned or controlled by the contributor, whether already acquired or\nhereafter acquired, that would be infringed by some manner, permitted\nby this License, of making, using, or selling its contributor version,\nbut do not include claims that would be infringed only as a\nconsequence of further modification of the contributor version. For\npurposes of this definition, \"control\" includes the right to grant\npatent sublicenses in a manner consistent with the requirements of\nthis License.\n\n Each contributor grants you a non-exclusive, worldwide, royalty-free\npatent license under the contributor's essential patent claims, to\nmake, use, sell, offer for sale, import and otherwise run, modify and\npropagate the contents of its contributor version.\n\n In the following three paragraphs, a \"patent license\" is any express\nagreement or commitment, however denominated, not to enforce a patent\n(such as an express permission to practice a patent or covenant not to\nsue for patent infringement). To \"grant\" such a patent license to a\nparty means to make such an agreement or commitment not to enforce a\npatent against the party.\n\n If you convey a covered work, knowingly relying on a patent license,\nand the Corresponding Source of the work is not available for anyone\nto copy, free of charge and under the terms of this License, through a\npublicly available network server or other readily accessible means,\nthen you must either (1) cause the Corresponding Source to be so\navailable, or (2) arrange to deprive yourself of the benefit of the\npatent license for this particular work, or (3) arrange, in a manner\nconsistent with the requirements of this License, to extend the patent\nlicense to downstream recipients. \"Knowingly relying\" means you have\nactual knowledge that, but for the patent license, your conveying the\ncovered work in a country, or your recipient's use of the covered work\nin a country, would infringe one or more identifiable patents in that\ncountry that you have reason to believe are valid.\n\n If, pursuant to or in connection with a single transaction or\narrangement, you convey, or propagate by procuring conveyance of, a\ncovered work, and grant a patent license to some of the parties\nreceiving the covered work authorizing them to use, propagate, modify\nor convey a specific copy of the covered work, then the patent license\nyou grant is automatically extended to all recipients of the covered\nwork and works based on it.\n\n A patent license is \"discriminatory\" if it does not include within\nthe scope of its coverage, prohibits the exercise of, or is\nconditioned on the non-exercise of one or more of the rights that are\nspecifically granted under this License. You may not convey a covered\nwork if you are a party to an arrangement with a third party that is\nin the business of distributing software, under which you make payment\nto the third party based on the extent of your activity of conveying\nthe work, and under which the third party grants, to any of the\nparties who would receive the covered work from you, a discriminatory\npatent license (a) in connection with copies of the covered work\nconveyed by you (or copies made from those copies), or (b) primarily\nfor and in connection with specific products or compilations that\ncontain the covered work, unless you entered into that arrangement,\nor that patent license was granted, prior to 28 March 2007.\n\n Nothing in this License shall be construed as excluding or limiting\nany implied license or other defenses to infringement that may\notherwise be available to you under applicable patent law.\n\n 12. No Surrender of Others' Freedom.\n\n If conditions are imposed on you (whether by court order, agreement or\notherwise) that contradict the conditions of this License, they do not\nexcuse you from the conditions of this License. If you cannot convey a\ncovered work so as to satisfy simultaneously your obligations under this\nLicense and any other pertinent obligations, then as a consequence you may\nnot convey it at all. For example, if you agree to terms that obligate you\nto collect a royalty for further conveying from those to whom you convey\nthe Program, the only way you could satisfy both those terms and this\nLicense would be to refrain entirely from conveying the Program.\n\n 13. Use with the GNU Affero General Public License.\n\n Notwithstanding any other provision of this License, you have\npermission to link or combine any covered work with a work licensed\nunder version 3 of the GNU Affero General Public License into a single\ncombined work, and to convey the resulting work. The terms of this\nLicense will continue to apply to the part which is the covered work,\nbut the special requirements of the GNU Affero General Public License,\nsection 13, concerning interaction through a network will apply to the\ncombination as such.\n\n 14. Revised Versions of this License.\n\n The Free Software Foundation may publish revised and/or new versions of\nthe GNU General Public License from time to time. Such new versions will\nbe similar in spirit to the present version, but may differ in detail to\naddress new problems or concerns.\n\n Each version is given a distinguishing version number. If the\nProgram specifies that a certain numbered version of the GNU General\nPublic License \"or any later version\" applies to it, you have the\noption of following the terms and conditions either of that numbered\nversion or of any later version published by the Free Software\nFoundation. If the Program does not specify a version number of the\nGNU General Public License, you may choose any version ever published\nby the Free Software Foundation.\n\n If the Program specifies that a proxy can decide which future\nversions of the GNU General Public License can be used, that proxy's\npublic statement of acceptance of a version permanently authorizes you\nto choose that version for the Program.\n\n Later license versions may give you additional or different\npermissions. However, no additional obligations are imposed on any\nauthor or copyright holder as a result of your choosing to follow a\nlater version.\n\n 15. Disclaimer of Warranty.\n\n THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY\nAPPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT\nHOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY\nOF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,\nTHE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR\nPURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM\nIS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF\nALL NECESSARY SERVICING, REPAIR OR CORRECTION.\n\n 16. Limitation of Liability.\n\n IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING\nWILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS\nTHE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY\nGENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE\nUSE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF\nDATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD\nPARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),\nEVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF\nSUCH DAMAGES.\n\n 17. Interpretation of Sections 15 and 16.\n\n If the disclaimer of warranty and limitation of liability provided\nabove cannot be given local legal effect according to their terms,\nreviewing courts shall apply local law that most closely approximates\nan absolute waiver of all civil liability in connection with the\nProgram, unless a warranty or assumption of liability accompanies a\ncopy of the Program in return for a fee.\n\n END OF TERMS AND CONDITIONS\n\n How to Apply These Terms to Your New Programs\n\n If you develop a new program, and you want it to be of the greatest\npossible use to the public, the best way to achieve this is to make it\nfree software which everyone can redistribute and change under these terms.\n\n To do so, attach the following notices to the program. It is safest\nto attach them to the start of each source file to most effectively\nstate the exclusion of warranty; and each file should have at least\nthe \"copyright\" line and a pointer to where the full notice is found.\n\n \n Copyright (C) \n\n This program is free software: you can redistribute it and/or modify\n it under the terms of the GNU General Public License as published by\n the Free Software Foundation, either version 3 of the License, or\n (at your option) any later version.\n\n This program is distributed in the hope that it will be useful,\n but WITHOUT ANY WARRANTY; without even the implied warranty of\n MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n GNU General Public License for more details.\n\n You should have received a copy of the GNU General Public License\n along with this program. If not, see .\n\nAlso add information on how to contact you by electronic and paper mail.\n\n If the program does terminal interaction, make it output a short\nnotice like this when it starts in an interactive mode:\n\n Copyright (C) \n This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\n This is free software, and you are welcome to redistribute it\n under certain conditions; type `show c' for details.\n\nThe hypothetical commands `show w' and `show c' should show the appropriate\nparts of the General Public License. Of course, your program's commands\nmight be different; for a GUI interface, you would use an \"about box\".\n\n You should also get your employer (if you work as a programmer) or school,\nif any, to sign a \"copyright disclaimer\" for the program, if necessary.\nFor more information on this, and how to apply and follow the GNU GPL, see\n.\n\n The GNU General Public License does not permit incorporating your program\ninto proprietary programs. If your program is a subroutine library, you\nmay consider it more useful to permit linking proprietary applications with\nthe library. If this is what you want to do, use the GNU Lesser General\nPublic License instead of this License. But first, please read\n.\n" }, { "path": "Makefile", "content": "# Makefile for idris-mode, to run tests and ensure dependencies are in order\n# Portions based on the Makefile for Proof General\n\nEMACS ?= emacs\n\nNEED_PKGS=prop-menu flycheck\n\nBATCHEMACS=$(EMACS) --batch --no-site-file -q \\\n\t-eval '(add-to-list (quote load-path) \"${PWD}/\")' \\\n\t-eval '(require (quote package))' \\\n\t-eval '(add-to-list (quote package-archives) (quote (\"melpa\" . \"http://melpa.org/packages/\")) t)' \\\n\t-eval '(package-initialize)'\n\nBYTECOMP = $(BATCHEMACS) \\\n\t-eval '(require (quote bytecomp))' \\\n\t-eval '(setq byte-compile-warnings t)' \\\n\t-eval '(setq byte-compile-error-on-warn t)' \\\n\t-f batch-byte-compile\n\nOBJS =\tidris-commands.elc\t\t\\\n\tidris-common-utils.elc\t\t\\\n\tidris-compat.elc\t\t\\\n\tidris-core.elc\t\t\t\\\n\tidris-events.elc\t\t\\\n\tidris-highlight-input.elc\t\\\n\tidris-info.elc\t\t\t\\\n\tidris-ipkg-mode.elc\t\t\\\n\tidris-keys.elc\t\t\t\\\n\tidris-log.elc\t\t\t\\\n\tidris-hole-list.elc\t\t\\\n\tidris-mode.elc\t\t\t\\\n\tidris-prover.elc\t\t\\\n\tidris-repl.elc\t\t\t\\\n\tidris-settings.elc\t\t\\\n\tidris-simple-indent.elc\t\t\\\n\tidris-tree-info.elc \\\n\tidris-syntax.elc\t\t\\\n\tidris-warnings.elc\t\t\\\n\tidris-warnings-tree.elc\t\t\\\n\tidris-xref.elc \\\n\tinferior-idris.elc \\\n\tflycheck-idris.elc\n\n.el.elc:\n\t$(BYTECOMP) $<\n\nbuild: getdeps $(OBJS)\n\ntest: getdeps build\n\t$(BATCHEMACS) -L . -l ert -l test/idris-tests.el -f ert-run-tests-batch-and-exit\n\ntest2: getdeps build\n\t$(BATCHEMACS) -L . \\\n\t\t-eval '(setq idris-interpreter-path (executable-find \"idris2\"))' \\\n\t\t-l ert -l test/idris-tests.el -f ert-run-tests-batch-and-exit\n\nclean:\n\t-${RM} -f $(OBJS)\n\t-${RM} -f test/test-data/*ibc\n\t-${RM} -rf test/test-data/build/\n\t-${RM} -r docs/auto docs/*.aux docs/*.log docs/*.pdf\ngetdeps:\n\t$(BATCHEMACS) -eval \\\n\t\t\"(let* \\\n\t\t\t\t((need-pkgs '($(NEED_PKGS))) \\\n\t\t\t\t (want-pkgs (seq-remove #'package-installed-p need-pkgs))) \\\n\t\t\t(unless (null want-pkgs) \\\n\t\t\t\t(package-initialize) \\\n\t\t\t\t(package-refresh-contents) \\\n\t\t\t\t(mapcar #'package-install want-pkgs)))\"\n\ndocs: docs/documentation.tex\n\t-@( cd docs/ && latexmk -xelatex documentation.tex )\n\n.PHONY: clean build test getdeps docs\n" }, { "path": "docs/documentation.tex", "content": "\\documentclass{article}\n\\usepackage{amsmath}\n\\usepackage{tikz}\n\\usetikzlibrary{positioning}\n\n\\title{idris-mode: Idris interaction with emacs}\n\\author{Hannes Mehnert\\\\\\texttt{hannes@mehnert.org}}\n\\begin{document}\n\\sloppy\n\\maketitle\n\n\\begin{abstract}\nThis document describes the interaction of the Idris compiler with the editor emacs, to facilitate a lightweight development environment for Idris programs in emacs.\n\nThe 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.\n\\end{abstract}\n\n\\section{Introduction}\nGetting dependently typed programs right is harder than usual statically typed programs, since the type system is more expressive.\nActually, the type checker of a dependently typed programming language can assist the programmer to develop a type correct program.\n\nIn this document we explain the interaction between Idris and emacs, this not a user guide for idris-mode.\nThe goal is to enable developers to extend idris-mode, as well as use Idris's IDE mode for other editors or tools.\n\nThe motivation for IDE mode is to provide an interface for Idris with structured input and output.\nThe motivation for idris-mode is to have a lightweight development environment for Idris within emacs.\n\nA 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 ;)}.\nThe communication protocol is of asynchronous request-reply style: a single request from emacs is handled by Idris at a time.\nIdris waits busily for a request on its standard input stream, and outputs the answer to standard output.\nThe result of a request can be either success or failure, and furthermore, before the result is delivered there might be informal messages.\nSince 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.\n\n\\section{Features}\nThe idris-mode provides basic syntax highlighting for Idris, located in \\texttt{idris-syntax.el} (not in scope of this document).\nAlso indentation is handled in idris-mode, implemented in \\texttt{idris-simple-indent.el}.\n\nThe 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.\n\nThe REPL is useful on its own, and can be started by \\textsf{M-x idris-repl}.\nThis creates a new buffer \\emph{*idris-repl*}, whose interaction is very similar to the command-line REPL.\nA history, available via C-down and C-up, of previous entered statements is present.\nThe search in the history uses the currently entered string for its prefix search to find available items.\nAutomatic completion of available commands is available via tab.\n\nWhen 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.\nAlso, 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.\n\nThe 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.\nEach feature is bound to a key in the idris-mode keymap.\n\nInspiration 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.\nThe proof mode consists of three buffers, one shows the proof obligation, another the proof script, and the third the proof shell.\nThe proof script buffer highlights the processed parts of the proof script.\nThere are keybindings available to step forward and backwards over the proof script, namely C-n and C-p.\nAdditionally, completion of partially written proof script is supported and bound to the key tab.\nTo get into proof mode, start proving a hole by typing \\textsf{:p hole} at the REPL.\n\nHelp for the current modes is available, as usual, by C-h m.\n\n\\section{Communication}\\label{sec:protocol}\nThe request-reply communication uses the standard input and standard output stream of Idris.\nA 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''.\n\nThe wire format is the length of the messages, encoded in 6 characters hexadecimal, followed by the message encoded as S-expression (sexp).\nAdditionally, each request includes a unique integer (counting upwards), which is repeated in all messages corresponding to that request.\n\nAn example interaction from loading the file \\texttt{/home/hannes/empty.idr} looks as follows on the wire:\n\\begin{verbatim}\n00002a((:load-file \"/home/hannes/empty.idr\") 1)\n000039(:write-string \"Type checking /home/hannes/empty.idr\" 1)\n000026(:set-prompt \"*/home/hannes/empty\" 1)\n000032(:return (:ok \"loaded /home/hannes/empty.idr\") 1)\n\\end{verbatim}\n\nThe 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).\nThe request identifier is set to 1.\nThe 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''.\nThe answer, starting with \\texttt{:return} is \\texttt{ok}, and additional information is that the file was loaded.\n\nThere are three atoms in the wire language: numbers, strings, and symbols.\nThe only compound object is a list, which is surrounded by parenthesis.\nThe syntax is given in Figure~\\ref{fig:syntax}.\n\n\\begin{figure}\n\\centering\n\\begin{align*}\n\\mathcal{A}{~::=~}&\\mathit{Num} \\mid \\texttt{\"} \\mathit{Alpha*} \\texttt{\"} \\mid \\texttt{:}\\mathit{Alpha*}\\\\\n\\mathcal{S}{~::=~}&\\mathcal{A} \\mid \\texttt{(} S \\texttt{)} \\mid \\texttt{nil}\n\\end{align*}\n\\caption{Syntax of the wire language, where Num is a positive integer and Alpha is a character, nil is reserved for the empty list}\n\\label{fig:syntax}\n\\end{figure}\n\nThe state of the Idris process is mainly the active file, which needs to be kept synchronized between the editor and Idris.\nThis is achieved by the already seen \\emph{LoadFile} command.\n\nThe full list of supported commands is the data structure \\emph{IdeModeCommand} in \\texttt{Idris/IdeMode.hs}, and explained in further detail in the following.\n\n\\begin{verbatim}\ndata IdeModeCommand = REPLCompletions String\n | Interpret String\n | TypeOf String\n | CaseSplit Int String\n | AddClause Int String\n | AddProofClause Int String\n | AddMissing Int String\n | MakeWithBlock Int String\n | ProofSearch Int String [String]\n | LoadFile String\n\\end{verbatim}\n\n\\paragraph{REPLCompletions} returns all possible commands for the given partial string by using the Haskeline completions (\\emph{replCompletion} in \\texttt{Completion.hs}).\n\n\\paragraph{Interpret} interprets the given string as a REPL command.\n\n\\paragraph{TypeOf} returns the type of the given top-level name.\n\n\\paragraph{CaseSplit} returns the cases for the given name.\n\n\\paragraph{AddClause} returns the definition for the given type.\n\n\\paragraph{AddProofClause} returns the proof clause for the given name.\n\n\\paragraph{AddMissing} returns the missing cases for the given name.\n\n\\paragraph{MakeWithBlock} returns a with block for the given name.\n\n\\paragraph{ProofSearch} returns a proof for the given name.\n\n\\paragraph{LoadFile} loads the given file.\n\nPossible replies include a normal reply:\n\\begin{verbatim}\n:return (:ok SEXP)\n:return (:error String)\n\\end{verbatim}\n\nInformational and abnormal replies\n\\begin{verbatim}\n:write-string String\n:set-prompt String\n:warning (FilePath, Int, String)\n\\end{verbatim}\n\nSpecially for proof mode\n\\begin{verbatim}\n:start-proof-mode\n:write-proof-state [String]\n:end-proof-mode\n:write-goal String\n\\end{verbatim}\n\n\\section{Implementation}\nThe implementation of these features are twofold: the emacs side and the Idris side.\n\n\\subsection{Idris side}\nOn the Idris side, the marshaling and unmarshaling of sexps is done in \\texttt{IdeMode.hs}.\nThe main entry point is \\emph{idemodeStart}, called by \\emph{idrisMain} (both in \\texttt{REPL.hs}).\nAlso, 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}).\n\nIn 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 ()}.\nThis 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.\n\nTo display a result for a command, \\emph{ihPrintError} and \\emph{ihPrintResult} are available (for failure and success).\nFurthermore, the function \\emph{ihWarn} produces a warning message, given a source location (\\emph{FC} from \\texttt{Core/TT.hs}) and a message.\n\nMost 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.\nAlso 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.\n\n\\subsection{Emacs side}\nThe 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.\nA dependency diagram of the various emacs lisp files is shown in Figure~\\ref{fig:elisp-deps}.\n\n\\begin{figure}\n\\centering\n\\begin{tikzpicture}\n \\tikzstyle{every node}=[draw]\n \\node (im) {idris-mode.el};\n\n \\node (commands) [below=of im] {idris-commands.el};\n\n \\node (repl) [below right=of commands] {idris-repl.el};\n\n \\node (inferior) [below left=of repl] {inferior-idris.el};\n \\node (completion) [right=of inferior] {idris-completion.el};\n\n \\node (prover) [below left=of inferior] {idris-prover.el};\n \\node (log) [right=of prover] {idris-log.el};\n \\node (events) [right=of log] {idris-events.el};\n\n \\node (warnings) [below=of prover] {idris-warnings.el};\n\n \\node (common) [below=of events] {idris-common-utils.el};\n \\node (compat) [left=of commands] {idris-compat.el};\n \\node (syntax) [right=of commands] {idris-syntax.el};\n \\node (indentation) [right=of syntax] {idris-simple-indent.el};\n\n \\draw [->] (im) -- (syntax);\n \\draw [->] (im) -- (indentation);\n \\draw [->] (im) -- (repl);\n \\draw [->] (im) -- (commands);\n \\draw [->] (im) -- (compat);\n\n \\draw [->] (events) -- (common);\n \\draw [->] (log) -- (common);\n\n \\draw [->] (commands) -- (inferior);\n \\draw [->] (commands) -- (repl);\n \\draw [->] (commands) -- (warnings);\n\n \\draw [->] (repl) -- (common);\n \\draw [->] (repl) -- (completion);\n \\draw [->] (repl) -- (inferior);\n\n \\draw [->] (inferior) -- (events);\n \\draw [->] (inferior) -- (log);\n \\draw [->] (inferior) -- (warnings);\n \\draw [->] (inferior) -- (prover);\n\n \\draw [->] (prover) -- (warnings);\n\n\\end{tikzpicture}\n\\label{fig:elisp-deps}\n\\caption{The internal dependency graph of idris-mode}\n\\end{figure}\n\nMinor 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.\n\nThe current design uses exactly one Idris process for the interaction (a handle is stored in \\emph{idris-process} (in \\texttt{inferior-idris.el})).\n\nSince 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.\nSome features, like tab completion, return a result immediately.\nTo simplify understanding of code, idris-mode waits for the reply in a synchronous fashion.\nThis is achieved by \\emph{idris-eval} (as well in \\texttt{inferior-idris.el}), which takes a sexp and returns the result immediately.\n\nBoth methods of interaction use the same underlying mechanism, namely sending a sexp via \\emph{idris-rex} using the dispatcher \\emph{idris-dispatch-event}.\n\nThe main entry for interaction between emacs and Idris is the method \\emph{idris-run} in the \\texttt{inferior-idris.el} file.\nIt starts the idris binary with the \\emph{--ide-mode} command line option, and additional customizable flags \\emph{idris-interpreter-flags}.\nThe output of the idris process is connected to \\emph{idris-output-filter}, which inserts the received string into the \\emph{*idris-process*} buffer.\nThis 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}.\n\nThe 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.\nIf 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.\nIf the sexp is a result (starts with \\emph{:result}), the continuation registered during the request is called.\nFurthermore, the continuation is removed from the list.\n\nThe 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.\nThe REPL also has a persistent history, which is saved to \\texttt{.idris/idris-history.eld}.\nIt 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.\n\nWhen logging is enabled, log messages are appended to the \\emph{*idris-log*} buffer.\n\nThe proof mode consists of three buffers and is enabled by the \\emph{:proof} command on the REPL.\nThe 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.\nProof obligations are shown in the \\emph{*idris-proof-obligations*} buffer, which is readonly.\nThere are keyboard shortcuts in the \\emph{*idris-proof-script*} buffer available to step forward and backward over the proof script.\nFurthermore, tab completion is available there as well as in the proof shell.\nThe proof script highlights the parts which have been processed by Idris.\n\n\\section{Highlighting}\nIdris mode supports highlighting the output from Idris.\nIn reality, this highlighting is controlled by the Idris compiler.\nSome of the return forms from Idris support an optional extra parameter: a list mapping spans of text to metadata about that text.\nIdris mode then uses this list both to highlight the displayed output and to enable richer interaction by having more metadata present.\n\nA particular semantic span is a three element list.\nThe 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.\nThe semantic data is a list of lists.\nThe head of each list is a key that denotes what kind of metadata is in the list, and the tail is the metadata itself.\nPresently, the following keys are available:\n\\begin{description}\n\\item[name] gives a reference to the fully-qualified Idris name\n\\item[implicit] provides a Boolean value that is True if the region is the name of an implicit argument\n\\item[decor] describes the category of a token, which can be ``type'', ``function'', ``data'', ``keyword'', or ``bound''.\n\\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:\n \\begin{description}\n \\item[filename] provides the filename\n \\item[start] provides the line and column that the source location starts at as a two-element tail\n \\item[end] provides the line and column that the source location ends at as a two-element tail\n \\end{description}\n\\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''.\n\n\\end{description}\n\nThe 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.\nPresently, spans only overlap in output from documentation strings, but this may change in the future.\n\n\\section{Conclusion}\nThe IDE mode provides a structured output of the Idris compiler.\nThis is especially useful for interfacing Idris to use for interactive development.\nIt exposes some internals of the Idris compiler which are useful for interactive development environments.\n\n\\section{Bugs and Future Work}\nThe proof mode needs some further thinking, currently it rewrites the proof script with the one from Idris and applies its own indentation (2 whitespaces).\nIt should be more interactive and not reformat proof script typed in by a user.\n\nThe interactive commands also depend heavily on lines and just insert or rewrite the next line.\nThis should be prevented to avoid brittleness.\n\nAs mentioned in the implementation section, not all commands of the Idris REPL are available in IDE mode:\n\\begin{itemize}\n\\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.\n\\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.\n\\end{itemize}\n\n\\subsection{Future}\n\nAlso, navigation in the source code and further support for the developer.\n\\end{document}\n" }, { "path": "flycheck-idris.el", "content": ";;; flycheck-idris.el --- Major mode for editing Idris code -*- lexical-binding: t -*-\n\n;; Copyright (C) 2022\n\n;; Author:\n;; URL: https://github.com/idris-hackers/idris-mode\n;; Keywords: languages\n;; Package-Requires: ((emacs \"24\") (prop-menu \"0.1\") (cl-lib \"0.5\"))\n;; Version: 1.1.0\n\n\n;;; Commentary:\n\n;; FlyCheck checkers for Idris(2)\n\n;;; Code:\n\n(require 'flycheck)\n(require 'idris-mode)\n\n(flycheck-define-checker idris\n \"An Idris syntax and type checker.\"\n :command (\"idris\"\n \"--check\" \"--nocolor\" \"--warnpartial\"\n ;; Compute the command-line options similarly to inferior-idris\n (eval (idris-compute-flags))\n source-original)\n :error-patterns\n ((warning line-start\n (file-name)\n \":\"\n line\n \":\"\n column\n \"-\"\n end-column\n \":\" line-end \"\\n\"\n (one-or-more blank) \"|\\n\"\n (one-or-more digit) (one-or-more blank) \"|\" (one-or-more not-newline) \"\\n\"\n (one-or-more blank) \"|\" (zero-or-more blank) (one-or-more \"~\") \"\\n\"\n \"Warning - \"(message (one-or-more not-newline)\n (zero-or-more \"\\n\" (one-or-more not-newline))))\n (error line-start\n (file-name)\n \":\"\n line\n \":\"\n column\n \"-\"\n end-column\n \":\" line-end \"\\n\"\n (one-or-more blank) \"|\\n\"\n (one-or-more digit) (one-or-more blank) \"|\" (one-or-more not-newline) \"\\n\"\n (one-or-more blank) \"|\" (zero-or-more blank) (one-or-more \"~\") \"\\n\"\n (one-or-more not-newline) \"\\n\"\n (one-or-more blank) (one-or-more not-newline) \"\\n\\n\"\n (message (one-or-more not-newline)\n (zero-or-more \"\\n\" (one-or-more not-newline)))))\n :error-filter delete-dups\n :modes idris-mode)\n\n\n(flycheck-define-checker idris2\n \"An Idris2 syntax and type checker.\"\n :command (\"idris2\"\n \"--check\" \"--no-colour\"\n ;; Compute the command-line options similarly to inferior-idris\n (eval (idris-compute-flags))\n source-original)\n :error-patterns ((warning line-start\n \"Warning: \"\n (message (one-or-more not-newline)\n (zero-or-more \"\\n\" (one-or-more not-newline))\n \"\\n\\n\")\n (one-or-more (not \":\")) ;; (file-name)\n \":\" line\n \":\" column\n \"--\" end-line\n \":\" end-column)\n (error line-start\n (zero-or-one \"Uncaught error: \")\n \"Error: \"\n (zero-or-one \"While processing\" (one-or-more (not \".\")) \".\")\n (message (one-or-more not-newline)\n (zero-or-more \"\\n\" (one-or-more not-newline))\n \"\\n\\n\")\n (one-or-more (not \":\")) ;; (file-name)\n \":\" line\n \":\" column\n \"--\" end-line\n \":\" end-column))\n :modes idris-mode)\n\n\n;;; ###autoload\n(add-to-list 'flycheck-checkers 'idris)\n(add-to-list 'flycheck-checkers 'idris2)\n\n\n(provide 'flycheck-idris)\n;;; flycheck-idris.el ends here\n" }, { "path": "idris-commands.el", "content": ";;; idris-commands.el --- Commands for Emacs passed to Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Mehnert\n\n;; Author: Hannes Mehnert and David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Code:\n\n(require 'idris-core)\n(require 'idris-settings)\n(require 'inferior-idris)\n(require 'idris-repl)\n(require 'idris-warnings)\n(require 'idris-compat)\n(require 'idris-info)\n(require 'idris-tree-info)\n(require 'idris-log)\n(require 'idris-ipkg-mode)\n(require 'idris-warnings-tree)\n(require 'idris-hole-list)\n(require 'idris-prover)\n(require 'idris-common-utils)\n(require 'idris-syntax)\n(require 'idris-highlight-input)\n\n(require 'cl-lib)\n(require 'thingatpt)\n\n(defvar-local idris-load-to-here nil\n \"The maximum position to load.\")\n\n(defun idris-make-dirty ()\n \"Mark an Idris buffer as dirty and remove the loaded region.\"\n (setq idris-buffer-dirty-p t)\n (when idris-loaded-region-overlay\n (delete-overlay idris-loaded-region-overlay))\n (setq idris-loaded-region-overlay nil))\n\n(defun idris-make-clean ()\n (setq idris-buffer-dirty-p nil))\n\n(defun idris-current-buffer-dirty-p ()\n \"Check whether the current buffer's most recent version is loaded.\"\n (or idris-buffer-dirty-p\n (not (equal (current-buffer)\n idris-currently-loaded-buffer))\n ;; for when we load the whole buffer\n (and (not idris-load-to-here) (not idris-loaded-region-overlay))\n ;; true when the place to load is outside the loaded region - extend region!\n (and idris-loaded-region-overlay\n idris-load-to-here\n (> (marker-position idris-load-to-here)\n (overlay-end idris-loaded-region-overlay)))))\n\n(defun idris-position-loaded-p (pos)\n (and idris-loaded-region-overlay\n (member idris-loaded-region-overlay (overlays-at pos))\n t))\n\n(defun idris-ensure-process-and-repl-buffer ()\n \"Ensure that an Idris process is running and the Idris REPL buffer exists.\"\n (idris-run)\n (idris-repl-buffer))\n\n(defun idris-switch-working-directory (new-working-directory)\n \"Switch working directory to NEW-WORKING-DIRECTORY.\"\n (unless (string= idris-process-current-working-directory new-working-directory)\n (idris-ensure-process-and-repl-buffer)\n (let* ((path (if (> idris-protocol-version 1)\n (prin1-to-string new-working-directory)\n new-working-directory))\n (eval-result (idris-eval `(:interpret ,(concat \":cd \" path))))\n (result-msg (or (car-safe eval-result) \"\")))\n ;; Check if the message from Idris contains the new directory path.\n ;; Before check drop the last character (slash) in the path\n ;; as the message does not include it.\n (if (string-match-p (file-truename (substring new-working-directory 0 -1))\n result-msg)\n (progn\n (message result-msg)\n (setq idris-process-current-working-directory new-working-directory))\n (error \"Failed to switch the working directory %s\" eval-result)))))\n\n(define-obsolete-function-alias 'idris-list-holes-on-load 'idris-list-holes \"2022-12-15\"\n \"Use the user's settings from customize to determine whether to list the holes.\")\n\n(defun idris-possibly-make-dirty (_beginning _end _length)\n \"Make the buffer dirty.\"\n (idris-make-dirty))\n ;; If there is a load-to-here marker and a currently loaded region, only\n ;; make the buffer dirty when the change overlaps the loaded region.\n ;; (if (and idris-load-to-here idris-loaded-region-overlay)\n ;; (when (member idris-loaded-region-overlay\n ;; (overlays-in beginning end))\n ;; (idris-make-dirty))\n ;; ;; Otherwise just make it dirty.\n ;; (idris-make-dirty)))\n\n(defun idris-update-loaded-region (fc)\n (if fc\n (let* ((end (assoc :end fc))\n (line (cadr end))\n (col (cl-caddr end)))\n (when (overlayp idris-loaded-region-overlay)\n (delete-overlay idris-loaded-region-overlay))\n (with-current-buffer idris-currently-loaded-buffer\n (setq idris-loaded-region-overlay\n (make-overlay (point-min)\n (save-excursion (goto-char (point-min))\n (forward-line (1- line))\n (move-to-column (1- col))\n (point))\n (current-buffer)))\n (overlay-put idris-loaded-region-overlay 'face 'idris-loaded-region-face)))\n\n ;; HACK: Some versions of Idris don't properly return a span for\n ;; some modules, returning () instead. Remove this (and the\n ;; surrounding (if fc)) after Idris 0.9.17, which contains a fix.\n (idris-update-loaded-region\n `((:filename ,(cdr (idris-filename-to-load)))\n (:start 1 1)\n ,`(:end ,(idris-get-line-num (point-max)) 1)))))\n\n(defun idris-load-to (&optional pos)\n (when (not pos) (setq pos (point)))\n (setq idris-load-to-here (copy-marker pos t))\n (setq overlay-arrow-position (copy-marker (save-excursion\n (goto-char pos)\n (line-beginning-position))\n nil)))\n\n(defun idris-no-load-to ()\n (setq idris-load-to-here nil)\n (setq overlay-arrow-position nil))\n\n(defun idris-load-forward-line (&optional nlines)\n (interactive)\n (when idris-load-to-here\n (save-excursion\n (goto-char idris-load-to-here)\n (forward-line nlines)\n (idris-make-dirty)\n (idris-load-to (point)))))\n\n(defun idris-load-backward-line ()\n (interactive)\n (idris-load-forward-line -1))\n\n(defun idris-filename-to-load ()\n \"Compute the working directory and filename to load in Idris.\nReturning these as a cons.\"\n (let* ((ipkg-file (car-safe (idris-find-file-upwards \"ipkg\")))\n (file-name (buffer-file-name))\n (work-dir (directory-file-name (idris-file-name-parent-directory (or ipkg-file file-name))))\n (source-dir (or (idris-ipkg-find-src-dir) work-dir)))\n ;; TODO: Update once https://github.com/idris-lang/Idris2/issues/3310 is resolved\n (if (> idris-protocol-version 1)\n (cons work-dir (file-relative-name file-name work-dir))\n (cons source-dir (file-relative-name file-name source-dir)))))\n\n(defun idris-load-file (&optional set-line)\n \"Pass the current buffer's file to the inferior Idris process.\nA prefix argument SET-LINE forces loading but only up to the current line.\"\n (interactive \"p\")\n (save-buffer)\n (idris-ensure-process-and-repl-buffer)\n (when (and set-line (= set-line 4))\n (idris-load-to (point))\n (idris-make-dirty))\n (when (and set-line (= set-line 16)) (idris-no-load-to))\n (if (buffer-file-name)\n (when (idris-current-buffer-dirty-p)\n (when idris-prover-currently-proving\n (if (y-or-n-p (format \"%s is open in the prover. Abandon and load? \"\n idris-prover-currently-proving))\n (idris-prover-abandon)\n (signal 'quit nil)))\n ;; Remove warning overlays\n (idris-warning-reset-all)\n ;; Clear the contents of the compiler notes buffer, if it exists\n (when (get-buffer idris-notes-buffer-name)\n (with-current-buffer idris-notes-buffer-name\n (let ((inhibit-read-only t)) (erase-buffer))))\n ;; Actually do the loading\n (let* ((dir-and-fn (idris-filename-to-load))\n (fn (cdr dir-and-fn))\n (srcdir (car dir-and-fn))\n (idris-semantic-source-highlighting (idris-buffer-semantic-source-highlighting)))\n (setq idris-currently-loaded-buffer nil)\n (idris-switch-working-directory srcdir)\n (idris-delete-ibc t) ;; delete the ibc to avoid interfering with partial loads\n (idris-toggle-semantic-source-highlighting)\n (idris-eval-async\n (if idris-load-to-here\n `(:load-file ,fn ,(idris-get-line-num idris-load-to-here))\n `(:load-file ,fn))\n (lambda (result)\n (pcase result\n (`(:highlight-source ,hs)\n (idris-highlight-source-file hs))\n (_ (idris-make-clean)\n (idris-update-options-cache)\n (setq idris-currently-loaded-buffer (current-buffer))\n (when (member 'warnings-tree idris-warnings-printing)\n (idris-list-compiler-notes))\n (run-hooks 'idris-load-file-success-hook)\n (idris-update-loaded-region result))))\n (lambda (_condition)\n (when (member 'warnings-tree idris-warnings-printing)\n (idris-list-compiler-notes))))))\n (user-error \"Cannot find file for current buffer\")))\n\n(defun idris-view-compiler-log ()\n \"Jump to the log buffer, if it is open.\"\n (interactive)\n (let ((buffer (get-buffer idris-log-buffer-name)))\n (if buffer\n (pop-to-buffer buffer)\n (message \"No Idris compiler log is currently open\"))))\n\n(defun idris-next-error ()\n \"Jump to the next error overlay in the buffer.\"\n (interactive)\n (let ((warnings-forward (sort (cl-remove-if-not #'(lambda (w) (> (overlay-start w) (point))) idris-warnings)\n #'(lambda (w1 w2) (<= (overlay-start w1) (overlay-start w2))))))\n (if warnings-forward\n (goto-char (overlay-start (car warnings-forward)))\n (user-error \"No warnings or errors until end of buffer\"))))\n\n(defun idris-previous-error ()\n \"Jump to the previous error overlay in the buffer.\"\n (interactive)\n (let ((warnings-backward (sort (cl-remove-if-not #'(lambda (w) (< (overlay-end w) (point))) idris-warnings)\n #'(lambda (w1 w2) (>= (overlay-end w1) (overlay-end w2))))))\n (if warnings-backward\n (goto-char (overlay-end (car warnings-backward)))\n (user-error \"No warnings or errors until beginning of buffer\"))))\n\n(defun idris-load-file-sync ()\n \"Pass the current buffer's file synchronously to the inferior Idris process.\nThis sets the load position to point, if there is one.\"\n (save-buffer)\n (idris-ensure-process-and-repl-buffer)\n (if (buffer-file-name)\n (unless (idris-position-loaded-p (point))\n (idris-warning-reset-all)\n (when (and idris-load-to-here\n (< (marker-position idris-load-to-here) (point)))\n (idris-load-to (point)))\n (let* ((dir-and-fn (idris-filename-to-load))\n (fn (cdr dir-and-fn))\n (srcdir (car dir-and-fn)))\n (setq idris-currently-loaded-buffer nil)\n (idris-switch-working-directory srcdir)\n (let ((result\n (idris-eval\n (if idris-load-to-here\n `(:load-file ,fn ,(idris-get-line-num idris-load-to-here))\n `(:load-file ,fn)))))\n (idris-update-options-cache)\n (setq idris-currently-loaded-buffer (current-buffer))\n (idris-make-clean)\n (idris-update-loaded-region (car result)))))\n (user-error \"Cannot find file for current buffer\")))\n\n\n\n(defun idris-info-for-name (command name)\n \"Pass to Idris compiler COMMAND with NAME as argument and display the result.\"\n (let* ((ty (idris-eval (list command name)))\n (result (car ty))\n (formatting (cdr ty)))\n (idris-show-info (format \"%s\" result) formatting)))\n\n\n(defun idris-type-at-point (thing)\n \"Display the type of the THING at point, considered as a global variable.\"\n (interactive \"P\")\n (let ((name (if thing (read-string \"Check: \")\n (idris-name-at-point))))\n (when (idris-current-buffer-dirty-p)\n (idris-load-file-sync))\n (when name\n (idris-info-for-name :type-of name))))\n\n(defun idris--print-definition-of-name (name)\n \"Fetch from the Idris compiler and display the definition of the NAME.\"\n (if (>=-protocol-version 2 1)\n (idris-info-for-name :interpret (concat \":printdef \" name))\n (idris-info-for-name :print-definition name)))\n\n(defun idris-print-definition-of-name-at-point (name)\n \"Display the definition of the function or type of the NAME at point.\n\nIdris 2 as of 05/01/2023 does not yet fully support\nprinting definition of a type at point.\"\n (interactive \"P\")\n (let ((name* (if name\n (read-string \"Print definition: \")\n (idris-name-at-point))))\n (when name*\n (idris--print-definition-of-name name*))))\n\n(define-obsolete-function-alias 'idris-print-definition-of-name 'idris-print-definition-of-name-at-point \"2023-01-05\")\n\n(defun idris-who-calls-name (name)\n \"Show the callers of NAME in a tree.\"\n (let* ((callers (idris-eval `(:who-calls ,name)))\n (roots (mapcar #'(lambda (c) (idris-caller-tree c :who-calls))\n (car callers))))\n (if (not (null roots))\n (idris-tree-info-show-multiple roots \"Callers\")\n (message \"The name %s was not found.\" name))\n nil))\n\n(defun idris-who-calls-name-at-point (thing)\n (interactive \"P\")\n (let ((name (if thing (read-string \"Who calls: \")\n (idris-name-at-point))))\n (when name\n (idris-who-calls-name name))))\n\n(defun idris-name-calls-who (name)\n \"Show the callees of NAME in a tree.\"\n (let* ((callees (idris-eval `(:calls-who ,name)))\n (roots (mapcar #'(lambda (c) (idris-caller-tree c :calls-who)) (car callees))))\n (if (not (null roots))\n (idris-tree-info-show-multiple roots \"Callees\")\n (message \"The name %s was not found.\" name))\n nil))\n\n(defun idris-name-calls-who-at-point (thing)\n (interactive \"P\")\n (let ((name (if thing (read-string \"Calls who: \")\n (idris-name-at-point))))\n (when name\n (idris-name-calls-who name))))\n\n(defun idris-browse-namespace (namespace)\n \"Show the contents of NAMESPACE in a tree info buffer.\"\n (interactive\n ;; Compute a default namespace for the prompt based on the text\n ;; annotations at point when called interactively. Overlays are\n ;; preferred over text properties.\n (let ((default\n (or (cl-some #'(lambda (o) (overlay-get o 'idris-namespace))\n (overlays-at (point)))\n (get-text-property (point) 'idris-namespace))))\n (list (read-string \"Browse namespace: \" default))))\n (idris-tree-info-show (idris-namespace-tree namespace)\n \"Browse Namespace\"))\n\n(defun idris-caller-tree (caller cmd)\n \"Display a tree from an IDE CALLER list.\nUsing CMD lazily retrieve a few levels at a time from Idris compiler.\"\n (pcase caller\n (`((,name ,highlight) ,children)\n (make-idris-tree\n :item name\n :highlighting highlight\n :collapsed-p t\n :kids (lambda ()\n (cl-mapcan #'(lambda (child)\n (let ((child-name (caar (idris-eval `(,cmd ,(car child))))))\n (if child-name\n (list (idris-caller-tree child-name cmd))\n nil)))\n children))\n :preserve-properties '(idris-tt-tree)))\n (_ (error \"Failed to make tree from %s\" caller))))\n\n(defun idris-namespace-tree (namespace &optional recursive)\n \"Create a tree of the contents of NAMESPACE.\nLazily retrieve children when RECURSIVE is non-nil.\"\n (cl-flet*\n ;; Show names as childless trees with decorated roots\n ((name-tree (n) (make-idris-tree :item (car n)\n :highlighting (cadr n)\n :kids nil\n :preserve-properties '(idris-tt-tree)))\n ;; The children of a tree are the namespaces followed by the names.\n (get-children (sub-namespaces names)\n (append (mapcar #'(lambda (ns)\n (idris-namespace-tree ns t))\n sub-namespaces)\n (mapcar #'name-tree names))))\n (let ((highlight `((0 ,(length namespace)\n ((:decor :namespace)\n (:namespace ,namespace))))))\n (if recursive\n ;; In the recursive case, generate a collapsed tree and lazily\n ;; get the contents as expansion is requested\n (make-idris-tree\n :item namespace\n :highlighting highlight\n :collapsed-p t\n :kids (lambda ()\n (pcase (idris-eval `(:browse-namespace ,namespace))\n (`((,sub-namespaces ,names . ,_))\n (get-children sub-namespaces names))\n (_ nil)))\n :preserve-properties '(idris-tt-term))\n ;; In the non-recursive case, generate an expanded tree with the\n ;; first level available, but only if the namespace actually makes\n ;; sense\n (pcase (idris-eval `(:browse-namespace ,namespace))\n (`((,sub-namespaces ,names . ,_))\n (make-idris-tree\n :item namespace\n :highlighting highlight\n :collapsed-p nil\n :kids (get-children sub-namespaces names)\n :preserve-properties '(idris-tt-term)))\n (_ (error \"Invalid namespace %s\" namespace)))))))\n\n(defun idris-newline-and-indent ()\n \"Indent a new line like the current one by default.\"\n (interactive)\n (let ((indent \"\"))\n (save-excursion\n (move-beginning-of-line nil)\n (when (looking-at (if (idris-lidr-p) \"^\\\\(>\\\\s-*\\\\)\" \"\\\\(\\\\s-*\\\\)\"))\n (setq indent (match-string 1))))\n (insert \"\\n\" indent)))\n\n(defun idris-delete-forward-char (n &optional killflag)\n \"Delete the following N characters (previous if N is negative).\nIf the current buffer is in `idris-mode' and the file being\nedited is a literate Idris file, deleting the end of a line will\ntake into account bird tracks. If Transient Mark mode is\nenabled, the mark is active, and N is 1, delete the text in the\nregion and deactivate the mark instead.\nTo disable this, set variable `delete-active-region' to nil.\n\nOptional second arg KILLFLAG non-nil means to kill (save in kill\nring) instead of delete. Interactively, N is the prefix arg, and\nKILLFLAG is set if N was explicitly specified.\"\n (interactive \"p\\nP\")\n (unless (integerp n)\n (signal 'wrong-type-argument (list 'integerp n)))\n (cond\n ;; Under the circumstances that `delete-forward-char' does something\n ;; special, delegate to it. This was discovered by reading the source to\n ;; it.\n ((and (use-region-p)\n delete-active-region\n (= n 1))\n (call-interactively 'delete-forward-char n killflag))\n ;; If in idris-mode and editing an LIDR file and at the end of a line,\n ;; then delete the newline and a leading >, if it exists\n ((and (eq major-mode 'idris-mode)\n (idris-lidr-p)\n (= n 1)\n (eolp))\n (delete-char 1 killflag)\n (when (and (not (eolp)) (equal (following-char) ?\\>))\n (delete-char 1 killflag)\n (when (and (not (eolp)) (equal (following-char) ?\\ ))\n (delete-char 1 killflag))))\n ;; Nothing special to do - delegate to `delete-char', just as\n ;; `delete-forward-char' does\n (t (delete-char 1 killflag))))\n\n\n(defun idris-apropos (what)\n \"Look up WHAT in names, type signatures, and docstrings.\"\n (interactive \"sSearch Idris docs for: \")\n (idris-info-for-name :apropos what))\n\n(defun idris-type-search (what)\n \"Search the Idris libraries for WHAT by fuzzy type matching.\"\n (interactive \"sSearch for type: \")\n (idris-info-for-name :interpret (concat \":search \" what)))\n\n(defun idris-docs-at-point (thing)\n \"Display the internal documentation for the THING (name at point).\nConsidered as a global variable\"\n (interactive \"P\")\n (let ((name (if thing (read-string \"Docs: \")\n (idris-name-at-point))))\n (when name\n (idris-info-for-name :docs-for name))))\n\n(defun idris-eldoc-lookup ()\n \"Return Eldoc string associated with the thing at point.\"\n (get-char-property (point) 'idris-eldoc))\n\n(defun idris-pretty-print ()\n \"Get a term or definition pretty-printed by Idris.\nUseful for writing papers or slides.\"\n (interactive)\n (let ((what (read-string \"What should be pretty-printed? \"))\n (fmt (completing-read \"What format? \" '(\"html\", \"latex\") nil t nil nil \"latex\"))\n (width (read-string \"How wide? \" nil nil \"80\")))\n (if (<= (string-to-number width) 0)\n (user-error \"Width must be positive\")\n (if (< (length what) 1)\n (user-error \"Nothing to pretty-print\")\n (let ((text (idris-eval `(:interpret ,(concat \":pprint \" fmt \" \" width \" \" what)))))\n (with-idris-info-buffer\n (insert (car text))\n (goto-char (point-min))\n (re-search-forward (if (string= fmt \"latex\")\n \"% START CODE\\n\"\n \"\"))\n (push-mark nil t)\n (re-search-forward (if (string= fmt \"latex\")\n \"% END CODE\\n\"\n \"\"))\n (goto-char (match-beginning 0))\n (copy-region-as-kill (mark) (point))\n (message \"Code copied to kill ring\")))))))\n\n\n(defun idris-case-split ()\n \"Case split the pattern variable at point.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n (let ((result (car (idris-eval `(:case-split ,(cdr what) ,(car what)))))\n (initial-position (point)))\n (if (<= (length result) 2)\n (message \"Can't case split %s\" (car what))\n (delete-region (line-beginning-position) (line-end-position))\n (if (> idris-protocol-version 1)\n (insert (substring result 0 (length result)))\n (insert (substring result 0 (1- (length result)))))\n (goto-char initial-position))))))\n\n(defun idris-make-cases-from-hole ()\n \"Make a case expression from the metavariable at point.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n (let ((result (car (idris-eval `(:make-case ,(cdr what) ,(car what))))))\n (if (<= (length result) 2)\n (message \"Can't make cases from %s\" (car what))\n (delete-region (line-beginning-position) (line-end-position))\n (if (> idris-protocol-version 1)\n (insert (substring result 0 (length result)))\n (insert (substring result 0 (1- (length result)))))\n (search-backward \"_ of\\n\"))))))\n\n(defun idris-case-dwim ()\n \"If point is on a hole name, make it into a case expression.\nOtherwise, case split as a pattern variable.\"\n (interactive)\n (cond\n ((looking-at-p \"\\\\?[a-zA-Z_]+\") ;; point at \"?\" in ?hole_rs1\n (forward-char) ;; move from \"?\" for idris-make-cases-from-hole to work correctly\n (idris-make-cases-from-hole))\n ((or (and (char-equal (char-before) ??) ;; point at \"h\" in ?hole_rs1\n (looking-at-p \"[a-zA-Z_]+\"))\n (looking-back \"\\\\?[a-zA-Z0-9_]+\" nil)) ;; point somewhere afte \"?h\" in ?hole_rs1\n (idris-make-cases-from-hole))\n (t (idris-case-split))))\n\n(defun idris-line-indentation-for (thing)\n \"Return the indentation prefix string for the line indicated by THING.\n\nTHING should be an Idris source location object, where the cdr gives the\n1-based line number of the expression the current command was invoked on.\n\nThe return value is the leading whitespace of that line.\nFor Idris protocol versions <= 1, the prefix may also include a leading ‘>’.\nIf no indentation is found, return the empty string.\"\n (save-excursion\n (goto-char (point-min))\n (forward-line (1- (cdr thing)))\n (goto-char (line-beginning-position))\n (re-search-forward (if (> idris-protocol-version 1)\n \"^\\\\(\\\\s-*\\\\)\"\n \"\\\\(^>?\\\\s-*\\\\)\")\n nil t)\n (or (match-string 1) \"\")))\n\n(defun idris-add-clause (proof)\n \"Add clauses to the declaration at point.\"\n (interactive \"P\")\n (let ((what (idris-thing-at-point))\n (command (if proof :add-proof-clause :add-clause)))\n (when (car what)\n (idris-load-file-sync)\n (let ((result (string-trim-left (car (idris-eval `(,command ,(cdr what) ,(car what))))))\n final-point\n (prefix (idris-line-indentation-for what)))\n ;; Go forward until we get to a line with equal or less indentation to\n ;; the type declaration, or the end of the buffer, and insert the\n ;; result\n (goto-char (line-beginning-position))\n (forward-line)\n (while (and (not (eobp))\n (progn (goto-char (line-beginning-position))\n ;; this will be true if we're looking at the prefix\n ;; with extra whitespace\n (looking-at-p (concat prefix \"\\\\s-+\"))))\n (forward-line))\n (insert prefix)\n (setq final-point (point)) ;; Save the location of the start of the clause\n (insert result)\n (newline)\n (goto-char final-point))))) ;; Put the cursor on the start of the inserted clause\n\n(defun idris-add-missing ()\n \"Add missing cases.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n (let ((result (car (idris-eval `(:add-missing ,(cdr what) ,(car what))))))\n (forward-line 1)\n (insert result)))))\n\n(defun idris-make-with-block ()\n \"Add with block.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n (let ((result (car (idris-eval `(:make-with ,(cdr what) ,(car what))))))\n (beginning-of-line)\n (kill-line)\n (insert result)))))\n\n(defun idris-make-lemma ()\n \"Extract lemma from hole.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n (let* ((result (car (idris-eval `(:make-lemma ,(cdr what) ,(car what)))))\n (lemma-type (car result)))\n ;; There are two cases here: either a ?hole, or the {name} of a provisional defn.\n (cond ((equal lemma-type :metavariable-lemma)\n (let ((lem-app (cadr (assoc :replace-metavariable (cdr result))))\n (type-decl (cadr (assoc :definition-type (cdr result)))))\n ;; replace the hole\n ;; assume point is on the hole right now!\n (while (not (looking-at \"\\\\?[a-zA-Z0-9?_]+\"))\n (backward-char 1))\n ;; now we're on the ? - we just matched the metavar\n (replace-match lem-app)\n\n ;; now we add the type signature - search upwards for the current\n ;; signature, then insert before it\n (re-search-backward (if (idris-lidr-p)\n \"^\\\\(>\\\\s-*\\\\)\\\\(([^)]+)\\\\|[a-zA-Z_0-9]+\\\\)\\\\s-*:\"\n \"^\\\\(\\\\s-*\\\\)\\\\(([^)]+)\\\\|[a-zA-Z_0-9]+\\\\)\\\\s-*:\"))\n (let ((indentation (match-string 1))\n end-point)\n (beginning-of-line)\n\n ;; make sure we are above the documentation string\n (forward-line -1)\n (while (and (not (looking-at-p \"^\\\\s-*$\"))\n (not (equal (point) (point-min)))\n (or (looking-at-p \"^|||\") (looking-at-p \"^--\")))\n (forward-line -1))\n\n ;; if we reached beginning of file\n ;; add new line between the type signature and the lemma\n (if (equal (point) (point-min))\n (progn\n (newline 1)\n (forward-line -1))\n ;; otherwise find first non empty line\n (forward-line -1)\n (when (looking-at-p \"^.*\\\\S-.*$\")\n (forward-line 1)\n (newline 1)))\n\n (insert indentation)\n (setq end-point (point))\n (insert type-decl)\n (newline 1)\n ;; make sure point ends up ready to start a new pattern match\n (goto-char end-point))))\n ((equal lemma-type :provisional-definition-lemma)\n (let ((clause (cadr (assoc :definition-clause (cdr result)))))\n ;; Insert the definition just after the current definition\n ;; This can either be before the next type definition or at the end of\n ;; the buffer, if there is no next type definition\n (let ((next-defn-point\n (re-search-forward (if (idris-lidr-p)\n \"^\\\\(>\\\\s-*\\\\)\\\\(([^)]+)\\\\|\\\\w+\\\\)\\\\s-*:\"\n \"^\\\\(\\\\s-*\\\\)\\\\(([^)]+)\\\\|\\\\w+\\\\)\\\\s-*:\")\n nil t)))\n (if next-defn-point ;; if we found a definition\n (let ((indentation (match-string 1)) end-point)\n (goto-char next-defn-point)\n (beginning-of-line)\n (insert indentation)\n (setq end-point (point))\n (insert clause)\n (newline 2)\n ;; make sure point is at new defn\n (goto-char end-point))\n ;; otherwise it goes at the end of the buffer\n (let ((end (point-max)))\n (goto-char end)\n (insert clause)\n (newline)\n ;; make sure point is at new defn\n (goto-char end)))))))))))\n\n(defun idris-compile-and-execute ()\n \"Execute the program in the current buffer.\"\n (interactive)\n (idris-load-file-sync)\n (if (>=-protocol-version 2 1)\n (let ((name (read-string \"MExpression to compile & execute (default main): \"\n nil nil \"main\")))\n (idris-repl-eval-string (format \":exec %s\" name) 0))\n (idris-eval '(:interpret \":exec\"))))\n\n(defun idris-replace-hole-with (expr)\n \"Replace the hole under the cursor by some EXPR.\"\n (save-excursion\n (let ((start (progn (search-backward \"?\") (point)))\n (end (progn (forward-char) (search-forward-regexp \"[^a-zA-Z0-9_']\")\n (backward-char) (point))))\n (delete-region start end))\n (insert expr)))\n\n(defvar-local proof-region-start nil\n \"The start position of the last proof region.\")\n(defvar-local proof-region-end nil\n \"The end position of the last proof region.\")\n\n(defun idris-proof-search (&optional arg)\n \"Invoke the proof search.\nA plain prefix ARG causes the command to prompt for hints and recursion\n depth, while a numeric prefix argument sets the recursion depth directly.\"\n (interactive \"P\")\n (let ((hints (if (consp arg)\n (split-string (read-string \"Hints: \") \"[^a-zA-Z0-9']\")\n '()))\n (depth (cond ((consp arg)\n (let ((input (string-to-number (read-string \"Search depth: \"))))\n (if (= input 0)\n nil\n (list input))))\n ((numberp arg)\n (list arg))\n (t nil)))\n (what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n\n (let ((result (car (if (> idris-protocol-version 1)\n (idris-eval `(:proof-search ,(cdr what) ,(car what)))\n (idris-eval `(:proof-search ,(cdr what) ,(car what) ,hints ,@depth))\n ))))\n (if (string= result \"\")\n (user-error \"Nothing found\")\n (idris-replace-hole-with result))))))\n\n(defun idris-proof-search-next ()\n \"Replace the previous proof search result with the next one, if it exists.\nIdris 2 only.\"\n (interactive)\n (if (not proof-region-start)\n (user-error \"You must proof search first before looking for subsequent proof results\")\n (let ((result (car (idris-eval `:proof-search-next))))\n (if (string= result \"No more results\")\n (message \"No more results\")\n (save-excursion\n (goto-char proof-region-start)\n (delete-region proof-region-start proof-region-end)\n (setq proof-region-start (point))\n (insert result)\n (setq proof-region-end (point)))))))\n\n(defvar-local def-region-start nil)\n(defvar-local def-region-end nil)\n\n(defun idris-generate-def ()\n \"Generate definition.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (when (car what)\n (idris-load-file-sync)\n (let ((result (car (idris-eval `(:generate-def ,(cdr what) ,(car what)))))\n final-point\n (prefix (idris-line-indentation-for what)))\n (if (string= result \"\")\n (user-error \"Nothing found\")\n (beginning-of-line)\n (forward-line)\n (while (and (not (eobp))\n (progn (beginning-of-line)\n (looking-at-p (concat prefix \"\\\\s-+\"))))\n (forward-line))\n (insert prefix)\n (setq final-point (point))\n (setq def-region-start (point))\n (insert result)\n (setq def-region-end (point))\n (newline)\n (goto-char final-point))))))\n\n(defun idris-generate-def-next ()\n \"Replace the previous generated definition with next definition, if it exists.\nIdris 2 only.\"\n (interactive)\n (if (not def-region-start)\n (user-error \"You must program search first before looking for subsequent program results\")\n (let ((result (car (idris-eval `:generate-def-next))))\n (if (string= result \"No more results\")\n (message \"No more results\")\n (save-excursion\n (goto-char def-region-start)\n (delete-region def-region-start def-region-end)\n (setq def-region-start (point))\n (insert result)\n (setq def-region-end (point)))))))\n\n(defun idris-intro ()\n \"Introduce the unambiguous constructor to use in this hole.\"\n (interactive)\n (let ((what (idris-thing-at-point)))\n (unless (car what)\n (user-error \"Could not find a hole at point to refine by\"))\n (idris-load-file-sync)\n (let ((results (car (idris-eval `(:intro ,(cdr what) ,(car what))))))\n (pcase results\n (`(,result) (idris-replace-hole-with result))\n (_ (idris-replace-hole-with (ido-completing-read \"I'm hesitating between: \" results)))))))\n\n(defun idris-refine (name)\n \"Refine by some NAME, without recursive proof search.\"\n (interactive \"MRefine by: \")\n (let ((what (idris-thing-at-point)))\n (unless (car what)\n (user-error \"Could not find a hole at point to refine by\"))\n (idris-load-file-sync)\n (let ((result (car (idris-eval `(:refine ,(cdr what) ,(car what) ,name)))))\n (idris-replace-hole-with result))))\n\n(defun idris-identifier-backwards-from-point ()\n (let (identifier-start\n (identifier-end (point))\n (failure (list nil nil nil)))\n (save-excursion\n (while (and (> (point) (point-min)) (idris-is-ident-char-p (char-before)))\n (backward-char)\n (setq identifier-start (point)))\n (if identifier-start\n (list (buffer-substring-no-properties identifier-start identifier-end)\n identifier-start\n identifier-end)\n failure))))\n\n(defun idris-complete-symbol-at-point ()\n \"Attempt to complete the symbol at point as a global variable.\n\nThis function does not attempt to load the buffer if it's not\nalready loaded, as a buffer awaiting completion is probably not\ntype-correct, so loading will fail.\"\n (if (not idris-process)\n nil\n (when idris-completion-via-compiler\n (cl-destructuring-bind (identifier start end) (idris-identifier-backwards-from-point)\n (when identifier\n (let ((result (car (idris-eval `(:repl-completions ,identifier)))))\n (cl-destructuring-bind (completions _partial) result\n (if (null completions)\n nil\n (list start end completions\n :exclusive 'no)))))))))\n\n(defun idris-complete-keyword-at-point ()\n \"Attempt to complete the symbol at point as an Idris keyword.\"\n (pcase-let* ((all-idris-keywords\n (append idris-keywords idris-definition-keywords))\n (`(,identifier ,start ,end)\n (idris-identifier-backwards-from-point)))\n (when identifier\n (let ((candidates (cl-remove-if-not\n (apply-partially #'string-prefix-p identifier)\n all-idris-keywords)))\n (if (null candidates)\n nil\n (list start end candidates\n :exclusive 'no))))))\n\n(defun idris-list-holes ()\n \"Get a list of currently open holes.\"\n (interactive)\n (when (idris-current-buffer-dirty-p)\n (idris-load-file-sync))\n (idris-hole-list-show (car (idris-eval '(:metavariables 80)))))\n\n(defun idris-list-compiler-notes ()\n \"Show the compiler notes in tree view.\"\n (interactive)\n (with-temp-message \"Preparing compiler note tree...\"\n (idris-compiler-notes-list-show (reverse idris-raw-warnings))))\n\n(defun idris-kill-buffers ()\n ;; not killing :events since it it tremendously useful for debuging\n (let ((bufs (list :repl :proof-obligations :proof-shell :proof-script :log :info :notes :holes :tree-viewer)))\n (dolist (b bufs) (idris-kill-buffer b))))\n\n(defun idris-remove-event-hooks ()\n \"Remove Idris event hooks set after connection with Idris established.\"\n (dolist (h idris-event-hooks) (remove-hook 'idris-event-hooks h)))\n\n(define-obsolete-function-alias 'idris-pop-to-repl 'idris-switch-to-repl \"2022-12-28\")\n\n(defun idris-switch-to-last-idris-buffer ()\n \"Switch to the last Idris buffer.\nThe default keybinding for this command is\nthe same as for command `idris-switch-to-repl',\nso it is convenient to jump between Idris code and REPL.\n\nInspired by `cider-switch-to-last-clojure-buffer'\nhttps://github.com/clojure-emacs/cider\"\n (interactive)\n (if (derived-mode-p 'idris-repl-mode)\n (let ((idris-buffer (seq-find\n (lambda (b) (eq 'idris-mode (buffer-local-value 'major-mode b)))\n (buffer-list))))\n (if idris-buffer\n (pop-to-buffer idris-buffer `(display-buffer-reuse-window))\n (user-error \"No Idris buffer found\")))\n (user-error \"Not in a Idris REPL buffer\")))\n\n(defun idris-run ()\n \"Run an inferior Idris process.\"\n (interactive)\n (let ((command-line-flags (idris-compute-flags)))\n ;; Kill the running Idris if the command-line flags need updating\n (when (and (get-buffer-process idris-connection-buffer-name)\n (not (equal command-line-flags idris-current-flags)))\n (message \"Idris command line arguments changed, restarting Idris\")\n (idris-quit)\n (sit-for 0.01)) ; allows the sentinel to run and reset idris-process\n ;; Start Idris if necessary\n (when (not idris-process)\n (setq idris-process\n (get-buffer-process\n (apply #'make-comint-in-buffer\n \"idris\"\n idris-process-buffer-name\n idris-interpreter-path\n nil\n \"--ide-mode-socket\"\n command-line-flags)))\n (with-current-buffer idris-process-buffer-name\n (add-hook 'comint-preoutput-filter-functions\n 'idris-process-filter\n nil\n t)\n (add-hook 'comint-output-filter-functions\n 'idris-show-process-buffer\n nil\n t))\n (set-process-sentinel idris-process 'idris-sentinel)\n (setq idris-current-flags command-line-flags)\n (accept-process-output idris-process 3))))\n\n(defun idris-quit ()\n \"Quit the Idris process, cleaning up the state synchronized with Emacs.\"\n (interactive)\n (if (get-buffer-process idris-process-buffer-name)\n (delete-process idris-process-buffer-name))\n (if (get-buffer-process idris-connection-buffer-name)\n (delete-process idris-connection-buffer-name))\n (if (get-buffer idris-process-buffer-name)\n (kill-buffer idris-process-buffer-name))\n (if (get-buffer idris-connection-buffer-name)\n (kill-buffer idris-connection-buffer-name))\n (if idris-loaded-region-overlay\n (delete-overlay idris-loaded-region-overlay))\n (idris-prover-end)\n (idris-warning-reset-all)\n (idris-remove-event-hooks)\n (idris-kill-buffers)\n (setq idris-loaded-region-overlay nil\n idris-currently-loaded-buffer nil\n idris-rex-continuations '()\n idris-process-current-working-directory nil\n idris-protocol-version 0\n idris-protocol-version-minor 0))\n\n(defun idris-delete-ibc (no-confirmation)\n \"Delete the IBC file for the current buffer.\nWhen NO-CONFIRMATION argument is set to t the deletion will be\nperformed silently without confirmation from the user.\"\n (interactive \"P\")\n (unless (> idris-protocol-version 1)\n (let* ((fname (buffer-file-name))\n (ibc (concat (file-name-sans-extension fname) \".ibc\")))\n (if (not (member (file-name-extension fname)\n '(\"idr\" \"lidr\" \"org\" \"markdown\" \"md\")))\n (user-error \"The current file is not an Idris file\")\n (when (or no-confirmation (y-or-n-p (concat \"Really delete \" ibc \"?\")))\n (when (file-exists-p ibc)\n (delete-file ibc)\n (message \"%s deleted\" ibc)))))))\n\n(defun idris--active-term-beginning (term pos)\n \"Find the beginning of active term TERM that occurs at POS.\n\nIt is an error if POS is not in the specified term. TERM should\nbe Idris's own serialization of the term in question.\"\n (unless (equal (get-char-property pos 'idris-tt-term) term)\n (user-error \"Term not present at %s\" pos))\n (save-excursion\n ;; Find the beginning of the active term\n (goto-char pos)\n (while (equal (get-char-property (point) 'idris-tt-term)\n term)\n (backward-char 1))\n (forward-char 1)\n (point)))\n\n(defun idris-make-term-menu (_term)\n \"Make a menu for the widget for some term.\"\n (let ((menu (make-sparse-keymap)))\n (define-key menu [idris-term-menu-normalize]\n `(menu-item \"Normalize\"\n (lambda () (interactive))))\n (define-key-after menu [idris-term-menu-show-implicits]\n `(menu-item \"Show implicits\"\n (lambda () (interactive))))\n (define-key-after menu [idris-term-menu-hide-implicits]\n `(menu-item \"Hide implicits\"\n (lambda () (interactive))))\n (define-key-after menu [idris-term-menu-core]\n `(menu-item \"Show core\"\n (lambda () (interactive))))\n menu))\n\n(defun idris-insert-term-widget (term)\n \"Make a widget for interacting with the TERM.\"\n (let ((inhibit-read-only t)\n (start-pos (copy-marker (point)))\n (end-pos (copy-marker (idris-find-term-end (point) 1)))\n (buffer (current-buffer)))\n (insert-before-markers\n (propertize\n \"▶\"\n 'face 'idris-active-term-face\n 'mouse-face 'highlight\n 'idris-term-widget term\n 'help-echo \": term menu\"\n 'keymap (let ((map (make-sparse-keymap)))\n (define-key map [mouse-3]\n (lambda () (interactive)\n (let ((selection\n (x-popup-menu t (idris-make-term-menu term))))\n (cond ((equal selection\n '(idris-term-menu-normalize))\n (idris-normalize-term start-pos buffer)\n (idris-remove-term-widgets))\n ((equal selection\n '(idris-term-menu-show-implicits))\n (idris-show-term-implicits start-pos buffer)\n (idris-remove-term-widgets))\n ((equal selection\n '(idris-term-menu-hide-implicits))\n (idris-hide-term-implicits start-pos buffer)\n (idris-remove-term-widgets))\n ((equal selection\n '(idris-term-menu-core))\n (idris-show-core-term start-pos buffer)\n (idris-remove-term-widgets))))))\n map)))\n (let ((term-overlay (make-overlay start-pos end-pos)))\n ;; TODO: delete the markers now that they're not useful\n (overlay-put term-overlay 'idris-term-widget term)\n (overlay-put term-overlay 'face 'idris-active-term-face))))\n\n(defun idris-add-term-widgets ()\n \"Add interaction widgets to annotated terms.\"\n (interactive)\n (save-excursion\n (goto-char (point-min))\n (let (term)\n (while (setq term (idris-search-property 'idris-tt-term))\n (idris-insert-term-widget term)))))\n\n(defun idris-remove-term-widgets (&optional buffer)\n \"Remove interaction widgets from annotated terms in BUFFER.\"\n (interactive)\n (with-current-buffer (or buffer (current-buffer))\n (save-excursion\n (let ((inhibit-read-only t))\n (mapc (lambda (overlay)\n (when (overlay-get overlay 'idris-term-widget)\n (delete-overlay overlay)))\n (overlays-in (point-min) (point-max)))\n (goto-char (point-min))\n (while (idris-search-property 'idris-term-widget)\n (delete-char 1))))))\n\n(defun idris-show-term-implicits (position &optional buffer)\n \"Replace the term at POSITION in BUFFER with a fully-explicit version.\"\n (interactive \"d\")\n (idris-active-term-command position :show-term-implicits buffer))\n\n(defun idris-hide-term-implicits (position &optional buffer)\n \"Replace the term at POSITION in BUFFER with a fully-implicit version.\"\n (interactive \"d\")\n (idris-active-term-command position :hide-term-implicits buffer))\n\n(defun idris-normalize-term (position &optional buffer)\n \"Replace the term at POSITION in BUFFER with a normalized version.\"\n (interactive \"d\")\n (idris-active-term-command position :normalise-term buffer))\n\n(defun idris-show-core-term (position &optional buffer)\n \"Replace the term at POSITION in BUFFER with the corresponding core term.\"\n (interactive \"d\")\n (idris-active-term-command position :elaborate-term buffer))\n\n(defun idris-active-term-command (position cmd &optional buffer)\n \"For the term at POSITION in BUFFER, run the live term command (CMD).\"\n (unless (member cmd '(:show-term-implicits\n :hide-term-implicits\n :normalise-term\n :elaborate-term))\n (error \"Invalid term command %s\" cmd))\n (with-current-buffer (or buffer (current-buffer))\n (let ((term (plist-get (text-properties-at position) 'idris-tt-term)))\n (if (null term)\n (error \"No term here\")\n (let* ((res (car (idris-eval (list cmd term))))\n (new-term (car res))\n (spans (cadr res))\n (col (save-excursion (goto-char (idris-find-term-end position -1))\n (current-column)))\n (rendered\n (with-temp-buffer\n (idris-propertize-spans (idris-repl-semantic-text-props spans)\n (insert new-term))\n ;; Indent the new term properly, if it's annotated\n (let ((new-tt-term (plist-get (text-properties-at (point-min)) 'idris-tt-term)))\n (when new-tt-term\n (goto-char (point-min))\n (when (= (forward-line 1) 0)\n (indent-rigidly (point) (point-max) col))\n (put-text-property (point-min) (point-max) 'idris-tt-term new-tt-term)))\n (buffer-string))))\n (idris-replace-term-at position rendered))))))\n\n(defun idris-find-term-end (pos step)\n \"Find an end of the term at POS, moving STEP positions in each iteration.\nReturn the position found.\"\n (unless (or (= step 1) (= step -1))\n (error \"Valid values for STEP are 1 or -1\"))\n ;; Can't use previous-single-property-change-position because it breaks if\n ;; point is at the beginning of the term (likewise for next/end).\n (let ((term (plist-get (text-properties-at pos) 'idris-tt-term)))\n (when (null term)\n (error \"No term at %s\" pos))\n (save-excursion\n (goto-char pos)\n (while (and (string= term\n (plist-get (text-properties-at (point))\n 'idris-tt-term))\n (not (eobp))\n (not (bobp)))\n (forward-char step))\n (if (= step -1)\n (1+ (point))\n (point)))))\n\n(defun idris-replace-term-at (position new-term)\n \"Replace the term at POSITION with the new rendered term NEW-TERM.\nThe idris-tt-term text property is used to determined the extent\nof the term to replace.\"\n (when (null (plist-get (text-properties-at position) 'idris-tt-term))\n (error \"No term here\"))\n (let ((start (idris-find-term-end position -1))\n (end (idris-find-term-end position 1))\n (inhibit-read-only t))\n (save-excursion\n (delete-region start end)\n (goto-char start)\n (insert new-term))))\n\n(defun idris-prove-hole (name &optional elab)\n \"Launch the prover on the hole NAME, using Elab mode if ELAB is non-nil.\"\n (idris-eval-async `(:interpret ,(concat (if elab \":elab \" \":p \") name))\n (lambda (_) t))\n ;; The timer is necessary because of the async nature of starting the prover\n (run-with-timer 0.25 nil\n #'(lambda ()\n (let ((buffer (get-buffer idris-prover-script-buffer-name)))\n (when buffer\n (let ((window (get-buffer-window buffer)))\n (when window\n (select-window window))))))))\n\n(defun idris-fill-paragraph (justify)\n \"In literate Idris files, allow filling non-code paragraphs.\"\n (if (and (idris-lidr-p) (not (save-excursion (move-beginning-of-line nil)\n (looking-at-p \">\\\\s-\"))))\n (fill-paragraph justify)\n (save-excursion\n (if (nth 4 (syntax-ppss))\n (fill-comment-paragraph justify) ;; if inside comment, use normal Emacs comment filling\n (if (save-excursion (move-beginning-of-line nil)\n (looking-at \"\\\\s-*|||\\s-*\")) ;; if inside documentation, fill with special prefix\n (let ((fill-prefix (substring-no-properties (match-string 0)))\n (paragraph-start \"\\\\s-*|||\\\\s-*$\\\\|\\\\s-*$\\\\|\\\\s-*@\" )\n (paragraph-separate \"\\\\s-*|||\\\\s-*$\\\\|\\\\s-*$\"))\n (fill-paragraph))\n ;; Otherwise do nothing\n \"\")))))\n\n\n(defun idris-set-idris-load-packages ()\n \"Interactively set the `idris-load-packages' variable.\"\n (interactive)\n (let* ((idris-libdir (replace-regexp-in-string\n \"[\\r\\n]*\\\\'\" \"\" ; remove trailing newline junk\n (shell-command-to-string (concat idris-interpreter-path \" --libdir\"))))\n (idris-libs (cl-remove-if #'(lambda (x) (string= (substring x 0 1) \".\"))\n (directory-files idris-libdir)))\n (packages '())\n (prompt \"Package to use (blank when done): \")\n (this-package (completing-read prompt (cons \"\" idris-libs))))\n (while (not (string= this-package \"\"))\n (push this-package packages)\n (setq this-package (completing-read prompt (cl-remove-if #'(lambda (x) (member x packages))\n idris-libs))))\n (when (y-or-n-p (format \"Use the packages %s for this session?\"\n (cl-reduce #'(lambda (x y) (concat x \", \" y)) packages)))\n (setq idris-load-packages packages)\n (when (y-or-n-p \"Save package list for future sessions? \")\n (add-file-local-variable 'idris-load-packages packages)))))\n\n(defun idris-open-package-file ()\n \"Provide easy access to package files.\"\n (interactive)\n (let ((files (idris-find-file-upwards \"ipkg\")))\n (cond ((= (length files) 0)\n (user-error \"No .ipkg file found\"))\n ((= (length files) 1)\n (find-file (car files)))\n (t (find-file (completing-read \"Package file: \" files nil t))))))\n\n(defun idris-start-project ()\n \"Interactively create a new Idris project, complete with ipkg file.\"\n (interactive)\n (let* ((project-name (read-string \"Project name: \"))\n (default-filename (downcase (replace-regexp-in-string \"[^a-zA-Z]\" \"\" project-name)))\n (create-in (read-directory-name \"Create in: \" nil default-filename))\n (default-ipkg-name (concat default-filename \".ipkg\"))\n (ipkg-file (read-string\n (format \"Package file name (%s): \" default-ipkg-name)\n nil nil default-ipkg-name))\n (src-dir (read-string \"Source directory (src): \" nil nil \"src\"))\n (module-name-suggestion (replace-regexp-in-string \"[^a-zA-Z]+\" \".\" (capitalize project-name)))\n (first-mod (read-string\n (format \"First module name (%s): \" module-name-suggestion)\n nil nil module-name-suggestion)))\n (when (file-exists-p create-in) (user-error \"%s already exists\" create-in))\n (when (string= src-dir \"\") (setq src-dir nil))\n (make-directory create-in t)\n (when src-dir (make-directory (concat (file-name-as-directory create-in) src-dir) t))\n (find-file (concat (file-name-as-directory create-in) ipkg-file))\n (insert \"package \" (replace-regexp-in-string \".ipkg$\" \"\" ipkg-file))\n (newline 2)\n (insert \"-- \" project-name)\n (newline)\n (let ((name (user-full-name)))\n (unless (string= name \"unknown\")\n (insert \"-- by \" name)\n (newline)))\n (newline)\n (insert \"opts = \\\"\\\"\")\n (newline)\n (when src-dir (insert \"sourcedir = \\\"\" src-dir \"\\\"\") (newline))\n (insert \"modules = \")\n (insert first-mod)\n (newline)\n (save-buffer)\n (let* ((mod-path (reverse (split-string first-mod \"\\\\.+\")))\n (mod-dir (mapconcat #'file-name-as-directory\n (cons create-in (cons src-dir (reverse (cdr mod-path))))\n \"\"))\n (filename (concat mod-dir (car mod-path) \".idr\")))\n (make-directory mod-dir t)\n (pop-to-buffer (find-file-noselect filename))\n (insert \"module \" first-mod)\n (newline)\n (save-buffer))))\n\n;;; Pretty-printer stuff\n\n(defun idris-set-current-pretty-print-width ()\n \"Send the current pretty-printer width to Idris, if there is a process.\"\n (let ((command (format \":consolewidth %s\"\n (or idris-pretty-printer-width\n \"infinite\"))))\n (when (and idris-process\n (not idris-prover-currently-proving))\n (idris-eval `(:interpret ,command) t))))\n\n;;; Computing a menu with these commands\n(defun idris-context-menu-items (plist)\n \"Compute a contextual menu based on the Idris semantic decorations in PLIST.\"\n (let ((ref (or (plist-get plist 'idris-name-key) (plist-get plist 'idris-ref)))\n (ref-style (plist-get plist 'idris-ref-style))\n (namespace (plist-get plist 'idris-namespace))\n (source-file (plist-get plist 'idris-source-file))\n (tt-term (plist-get plist 'idris-tt-term)))\n (append\n (when ref\n (append (list (list \"Get type\"\n (lambda ()\n (interactive)\n (idris-info-for-name :type-of ref))))\n (cond ((member ref-style\n '(:type :data :function))\n (list\n (list \"Get docs\"\n (lambda ()\n (interactive)\n (idris-info-for-name :docs-for ref)))\n (list \"Get definition\"\n (lambda ()\n (interactive)\n (idris--print-definition-of-name ref)))\n (list \"Who calls?\"\n (lambda ()\n (interactive)\n (idris-who-calls-name ref)))\n (list \"Calls who?\"\n (lambda ()\n (interactive)\n (idris-name-calls-who ref)))))\n ((equal ref-style :metavar)\n (cons (list \"Launch prover\"\n (lambda ()\n (interactive)\n (idris-prove-hole ref)))\n (when idris-enable-elab-prover\n (list (list \"Launch interactive elaborator\"\n (lambda ()\n (interactive)\n (idris-prove-hole ref t))))))))))\n (when namespace\n (list (list (concat \"Browse \" namespace)\n (lambda ()\n (interactive)\n (idris-browse-namespace namespace)))))\n (when (and namespace source-file)\n (list (list (concat \"Edit \" source-file)\n (lambda ()\n (interactive)\n (find-file source-file)))))\n (when tt-term\n (list (list \"Normalize term\"\n (let ((pos (point)))\n (lambda ()\n (interactive)\n (save-excursion\n (idris-normalize-term\n (idris--active-term-beginning tt-term pos))))))\n (list \"Show term implicits\"\n (let ((pos (point)))\n (lambda ()\n (interactive)\n (save-excursion\n (idris-show-term-implicits\n (idris--active-term-beginning tt-term pos))))))\n (list \"Hide term implicits\"\n (let ((pos (point)))\n (lambda ()\n (interactive)\n (save-excursion\n (idris-hide-term-implicits\n (idris--active-term-beginning tt-term pos))))))\n (list \"Show core\"\n (let ((pos (point)))\n (lambda ()\n (interactive)\n (save-excursion\n (idris-show-core-term\n (idris--active-term-beginning tt-term pos)))))))))))\n\n(provide 'idris-commands)\n;;; idris-commands.el ends here\n" }, { "path": "idris-common-utils.el", "content": ";;; idris-common-utils.el --- Useful utilities -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013-2015 Hannes Mehnert and David Raymond Christiansen\n\n;; Author: Hannes Mehnert and David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Commentary\n;; This file contains various useful things that are employed\n;; throughout idris-mode.\n\n;;; Code:\n(require 'idris-core)\n(require 'idris-settings)\n(require 'cl-lib)\n\n\n;;; These variables are here because many things depend on them\n(defvar-local idris-buffer-dirty-p t\n \"An Idris buffer is dirty if it have been modified since it was last loaded.\")\n\n(defvar idris-currently-loaded-buffer nil\n \"The buffer currently loaded by the running Idris.\")\n\n(defvar idris-loaded-region-overlay nil\n \"The region loaded by Idris, should such a thing exist.\")\n\n(defvar idris-process-current-working-directory \"\"\n \"Working directory of Idris process.\")\n\n(defvar idris-command-line-option-functions nil\n \"A list of functions to call to compute the `command-line' arguments to Idris.\nEach function should take no arguments and return a list of\nstrings that are suitable arguments to `start-process'.\")\n\n(defvar idris-mode-path nil\n \"Directory containing the `idris-mode' package.\nThis is used to load resource files such as images. The default\nvalue is automatically computed from the location of the Emacs\nLisp package.\")\n(when load-file-name ;; guard to allow M-x eval-buffer\n (setq idris-mode-path (file-name-directory load-file-name)))\n\n(defun idris-buffer-name (type)\n (cl-assert (keywordp type))\n (concat (format \"*idris-%s*\" (substring (symbol-name type) 1))))\n\n(defun idris-kill-buffer (buffer)\n (let ((buf (cond\n ((symbolp buffer)\n (get-buffer (idris-buffer-name buffer)))\n ((stringp buffer)\n (get-buffer buffer))\n ((bufferp buffer)\n buffer)\n (t (message \"don't know how to kill buffer\"))))\n (return-buffer (seq-find (lambda (b) (eq 'idris-mode (buffer-local-value 'major-mode b)))\n (buffer-list))))\n (when (and buf (buffer-live-p buf))\n (let ((win (get-buffer-window buf)))\n (kill-buffer buf)\n (when (and (null (window-prev-buffers win)) (< 1 (length (window-list))))\n (delete-window win))))\n (when return-buffer (pop-to-buffer return-buffer `(display-buffer-reuse-window)))))\n\n(defun idris-minibuffer-respecting-message (text &rest args)\n \"Display TEXT as a message, without hiding any minibuffer contents.\"\n (let ((mtext (format \" [%s]\" (apply #'format text args))))\n (if (minibuffer-window-active-p (minibuffer-window))\n (minibuffer-message mtext)\n (message \"%s\" mtext))))\n\n(defun idris-same-line-p (pos1 pos2)\n \"Return t if buffer positions POS1 and POS2 are on the same line.\"\n (save-excursion (goto-char (min pos1 pos2))\n (<= (max pos1 pos2) (line-end-position))))\n\n(defmacro idris-save-marker (marker &rest body)\n \"Save the contents of the marker MARKER while executing BODY.\"\n (declare (indent 1))\n (let ((pos (gensym \"pos\")))\n `(let ((,pos (marker-position ,marker)))\n (prog1 (progn . ,body)\n (set-marker ,marker ,pos)))))\n\n(defmacro idris-propertize-region (props &rest body)\n \"Execute BODY and add PROPS to all the text it inserts.\nMore precisely, PROPS are added to the region between the point's\npositions before and after executing BODY.\"\n (declare (indent 1))\n (let ((start (gensym \"foo\")))\n `(let ((,start (point)))\n (prog1 (progn ,@body)\n (add-text-properties ,start (point) ,props)))))\n\n(defmacro idris-propertize-spans (spans &rest body)\n \"Execute BODY and add the properties indicated by SPANS to the\ninserted text (that is, relative to point prior to insertion).\"\n (declare (indent 1))\n (let ((start (gensym)))\n `(let ((,start (point)))\n (prog1 (progn ,@body)\n (cl-loop for (begin length props) in ,spans\n do (add-text-properties (+ ,start begin)\n (+ ,start begin length)\n props))))))\n\n;;; TODO: Take care of circular dependency issue\n(autoload 'idris-eval \"inferior-idris.el\")\n\n(defun idris-make-link-keymap (url)\n \"Compute the keymap for a clickable link to URL.\"\n (let ((map (make-sparse-keymap))\n (browse (lambda () (interactive) (browse-url url))))\n (define-key map [mouse-1] browse)\n (define-key map [mouse-2] browse)\n (define-key map (kbd \"RET\") browse)\n map))\n\n(defconst idris-semantic-properties-clickable-decors\n '(:type :data :function :metavar :module :namespace :postulate)\n \"The decors that should light up as responsive to mouse clicks.\")\n\n(defun idris-semantic-properties-face (props)\n \"Compute the text property `face' from the Idris properties (PROPS) for a region.\"\n (let* ((decor (assoc :decor props))\n (implicit (assoc :implicit props))\n (text-format (assoc :text-formatting props))\n (idris-err (assoc :error props))\n (link-href (assoc :link-href props))\n (qquote (assoc :quasiquotation props))\n (aquote (assoc :antiquotation props))\n (decor-face (if decor\n (pcase (cadr decor)\n (:type '(idris-semantic-type-face))\n (:data '(idris-semantic-data-face))\n (:function '(idris-semantic-function-face))\n (:keyword '(idris-keyword-face))\n (:metavar '(idris-hole-face))\n (:bound '(idris-semantic-bound-face))\n (:namespace '(idris-semantic-namespace-face))\n (:postulate '(idris-semantic-postulate-face))\n (:module '(idris-semantic-module-face))\n (_ nil))\n nil))\n (implicit-face (if (and implicit (equal (cadr implicit) :True))\n '(idris-semantic-implicit-face)\n nil))\n (err-face (if idris-err\n '(idris-warning-face)\n ()))\n (text-face (pcase (cadr text-format)\n (:bold '(bold))\n (:italic '(italic))\n (:underline '(underline))\n (_ nil)))\n (link-face (if link-href '(idris-link-face) ()))\n (unique-val (gensym)) ; HACK to stop consecutive mouse-faces from interfering\n (mousable-face\n (cond ((member (cadr decor) idris-semantic-properties-clickable-decors)\n `((:inherit (,decor-face highlight) :hack ,unique-val)))\n (idris-err\n `((:inherit ('idris-warning-face highlight))))\n (link-href\n '(highlight))\n (t nil)))\n (qquote-face (when qquote '(idris-quasiquotation-face)))\n (aquote-face (when aquote '(idris-antiquotation-face)))\n (computed-face (append text-face\n implicit-face\n decor-face\n err-face\n link-face\n qquote-face\n aquote-face)))\n (append (if computed-face (list 'face computed-face) ())\n (if mousable-face (list 'mouse-face mousable-face) ()))))\n\n\n(defun idris-semantic-properties-eldoc (props)\n \"Compute an Eldoc string from Idris semantic properties (PROPS).\"\n (let* ((name (assoc :name props))\n (namespace (assoc :namespace props))\n (source-file (assoc :source-file props))\n (type (pcase (assoc :type props)\n (`(:type ,ty)\n (concat \" : \" ty))\n (_ \"\")))\n (doc-overview (pcase (assoc :doc-overview props)\n (`(:doc-overview ,docs)\n (if (string-match \"[^ ]\" docs)\n (concat \"\\n\"\n ;; Emacs will do its own line-wrapping in Eldoc\n (replace-regexp-in-string \"\\\\\\n\" \" \" docs))\n \"\"))\n (_ \"\"))))\n (cond (name (list 'idris-eldoc\n (concat (cadr name)\n ;; Emacs will do its own line-wrapping in Eldoc\n (replace-regexp-in-string \"\\\\\\n\" \" \" type)\n doc-overview)))\n ((and namespace source-file)\n (list 'idris-eldoc\n (file-relative-name (cadr source-file))))\n (namespace (list 'idris-eldoc\n (cadr namespace)))\n (t nil))))\n\n\n(defun idris-semantic-properties-help-echo (props)\n (let* ((name (assoc :name props))\n (decor (assoc :decor props))\n (namespace (assoc :namespace props))\n (idris-err (assoc :error props))\n (link-href (assoc :link-href props))\n (image (assoc :image props))\n (type (pcase (assoc :type props)\n (`(:type ,ty) (concat \" : \" ty))\n (_ \"\")))\n (doc-overview (pcase (assoc :doc-overview props)\n (`(:doc-overview ,docs) (concat \"\\n\" docs))\n (_ \"\")))\n (mouse-help\n (cond ((member (cadr decor) idris-semantic-properties-clickable-decors)\n \"\\n context menu\")\n (idris-err (idris-eval `(:error-string ,(cadr idris-err))))\n (t \"\"))))\n (cond (name (list 'help-echo\n (concat (cadr name)\n type\n doc-overview\n mouse-help)))\n (namespace (list 'help-echo (concat (cadr namespace) \"\\n\" mouse-help)))\n (link-href (list 'help-echo (concat \" browse \" (cadr link-href))))\n (image (list 'help-echo (cadr image)))\n (t nil))))\n\n(defun idris-semantic-properties (props)\n \"Compute how to highlight with Idris compiler properties (PROPS).\"\n (let* ((name (assoc :name props))\n (decor (assoc :decor props))\n (term (assoc :tt-term props))\n (key (assoc :key props))\n (namespace (assoc :namespace props))\n (source-file (assoc :source-file props))\n (idris-err (assoc :error props))\n (link-href (assoc :link-href props))\n (image (assoc :image props)))\n (append '(rear-nonsticky t)\n (cond (name\n (if (and (member (cadr decor)\n '(:type :data :function :metavar))\n name)\n (append (list 'idris-ref (cadr name)\n 'idris-ref-style (cadr decor))\n (when namespace\n (list 'idris-namespace (cadr namespace))))\n ()))\n (namespace\n (if (or (equal (cadr decor) :module)\n (equal (cadr decor) :namespace))\n (append (list 'idris-namespace (cadr namespace))\n (when source-file\n (list 'idris-source-file (cadr source-file))))\n ()))\n (link-href\n (list 'keymap (idris-make-link-keymap (cadr link-href))\n 'idris-url (cadr link-href)))\n (image\n (list 'display\n `(image :type imagemagick\n :file ,(expand-file-name (cl-caddr image)\n (file-name-directory idris-process-current-working-directory)))))\n (t nil))\n (if term\n (list 'idris-tt-term (cadr term))\n ())\n (if (and key (not (string-empty-p (cadr key))))\n (list 'idris-name-key (concat \"{{{{{\" (cadr key) \"}}}}}\"))\n ())\n (if idris-err\n (list 'idris-tt-error (cadr idris-err))\n ())\n (idris-semantic-properties-help-echo props)\n (idris-semantic-properties-face props)\n (idris-semantic-properties-eldoc props))))\n\n(defun idris-repl-semantic-text-props (highlighting)\n (cl-loop for (start length props) in highlighting\n collecting (list start\n length\n (idris-semantic-properties props))))\n\n(defun idris-add-overlay-properties (overlay plist)\n \"Add the contents of PLIST to the properties of OVERLAY.\"\n (while (and plist (cdr plist))\n (overlay-put overlay (car plist) (cadr plist))\n (setq plist (cddr plist))))\n\n;;; Was originally slime-search-property - thanks SLIME!\n(defun idris-search-property (prop &optional backward prop-value-fn)\n \"Search for the next text range where PROP is non-nil.\nReturn the value of PROP, or nil if it is not found.\nIf BACKWARD is non-nil, search backward.\nIf PROP-VALUE-FN is non-nil use it to extract PROP's value.\"\n (let ((next-candidate (if backward\n #'previous-single-char-property-change\n #'next-single-char-property-change))\n (prop-value-fn (or prop-value-fn\n (lambda ()\n (get-text-property (point) prop))))\n (start (point))\n (prop-value))\n (while (progn\n (goto-char (funcall next-candidate (point) prop))\n (not (or (setq prop-value (funcall prop-value-fn))\n (eobp)\n (bobp)))))\n (cond (prop-value)\n (t (goto-char start) nil))))\n\n;;; Dispatching of events and helpers\n(defmacro destructure-case (value &rest patterns)\n \"Dispatch VALUE to one of PATTERNS.\nA cross between `cl-case' and `cl-destructuring-bind'.\nThe pattern syntax is:\n ((HEAD . ARGS) . BODY)\nThe list of patterns is searched for a HEAD `eq' to the car of\nVALUE. If one is found, the BODY is executed with ARGS bound to the\ncorresponding values in the CDR of VALUE.\"\n (declare (indent 1))\n (let ((operator (gensym \"op-\"))\n (operands (gensym \"rand-\"))\n (tmp (gensym \"tmp-\")))\n `(let* ((,tmp ,value)\n (,operator (car ,tmp))\n (,operands (cdr ,tmp)))\n (cl-case ,operator\n ,@(mapcar (lambda (clause)\n (if (eq (car clause) t)\n `(t ,@(cdr clause))\n (cl-destructuring-bind ((op &rest rands) &rest body) clause\n `(,op (cl-destructuring-bind ,rands ,operands\n . ,body)))))\n patterns)\n ,@(if (eq (caar (last patterns)) t)\n '()\n `((t (error \"ELISP destructure-case failed: %S\" ,tmp))))))))\n\n(defun idris-lidr-p (&optional buffer)\n \"Return t if BUFFER is a literate Idris file, or nil otherwise.\nUse the current buffer if BUFFER is not supplied or is nil.\"\n (let ((file-name (buffer-file-name buffer)))\n ;; We check for nil here because idris-lidr-p might be called on\n ;; buffers that don't have associated files, such as the REPL\n ;; buffer or an info buffer\n (and (stringp file-name)\n (string= (file-name-extension file-name) \"lidr\"))))\n\n(defun idris-make-file-link-overlay (start end keymap help-echo)\n (let ((overlay (make-overlay start end)))\n (overlay-put overlay 'idris-file-link t)\n (overlay-put overlay 'keymap keymap)\n (overlay-put overlay 'mouse-face 'highlight)\n (overlay-put overlay 'help-echo help-echo)))\n\n(defun idris-clear-file-link-overlays (&optional mode)\n \"Remove all file link overlays from the current buffer.\"\n (when (or (not mode) (eq major-mode mode))\n (remove-overlays (point-min) (point-max) 'idris-file-link t)))\n\n(defun idris-make-module-link (start end src-dir)\n \"Attempt to make the region between START and END into a\nclickable link to open a module for editing, with modules located\nrelative to SRC-DIR\"\n (let* ((name (buffer-substring-no-properties start end))\n (fname (split-string name \"\\\\.\"))\n (basename (concat (mapconcat 'file-name-as-directory (cons src-dir (butlast fname)) \"\")\n (car (last fname))))\n (idr (concat basename \".idr\"))\n (lidr (concat basename \".lidr\")))\n (cl-flet ((make-link (src-name)\n (let ((map (make-sparse-keymap)))\n (define-key map [mouse-2] #'(lambda ()\n (interactive)\n (find-file src-name)))\n (idris-make-file-link-overlay start end map \"mouse-2: edit module\"))))\n (if (file-exists-p idr)\n (make-link idr)\n (when (file-exists-p lidr)\n (make-link lidr))))))\n\n(defvar idris-protocol-version 0 \"The protocol version.\")\n(defvar idris-protocol-version-minor 0 \"The protocol minor version.\")\n\n(defun >=-protocol-version (major minor)\n (or (> idris-protocol-version major)\n (and (>= idris-protocol-version major)\n (>= idris-protocol-version-minor minor))))\n\n(defun idris-get-line-num (position)\n \"Get the absolute line number at POSITION.\"\n ;; In Emacs 26.1 > line-number-at-pos accepts\n ;; additional optional argument ABSOLUTE which\n ;; removes need for `save-restriction' and `widen'\n (save-restriction\n (widen)\n (line-number-at-pos position)))\n\n(defun idris-operator-at-position-p (pos)\n \"Return t if syntax lookup is `.' or char after POS is `-'.\"\n (or (equal (syntax-after pos) (string-to-syntax \".\"))\n (eq (char-after pos) ?-)))\n\n(defun idris-thing-at-point ()\n \"Return the line number and name at point as a cons.\nUse this in Idris source buffers.\"\n (let ((line (idris-get-line-num (point))))\n (cons\n (if (idris-operator-at-position-p (point))\n (save-excursion\n (skip-syntax-backward \".\")\n (let ((beg (point)))\n (skip-syntax-forward \".\")\n (buffer-substring-no-properties beg (point))))\n ;; Try if we're on a symbol or fail otherwise.\n (or (current-word t)\n (user-error \"Nothing identifiable under point\")))\n line)))\n\n(defun idris-name-at-point ()\n \"Return the name at point, taking into account semantic annotations.\nUse this in Idris source buffers or in compiler-annotated output.\nDoes not return a line number.\"\n (let ((ref (cl-remove-if\n #'null\n (cons (get-text-property (point) 'idris-ref)\n (cl-loop for overlay in (overlays-at (point))\n collecting (overlay-get overlay 'idris-ref))))))\n (car (or ref (idris-thing-at-point)))))\n\n(provide 'idris-common-utils)\n" }, { "path": "idris-compat.el", "content": ";;; idris-compat.el --- compatibility functions for Emacs 24.1 -*- lexical-binding: t -*-\n\n;;; Commentary:\n;; This file defines defvar-local, which was introduced in Emacs 24.3, and string-suffix-p, from Emacs 24.4.\n\n;;; Code:\n(require 'subr-x nil 'no-error) ; Additional utilities, Emacs 24.4 and upwards\n\n(eval-and-compile\n (unless (featurep 'subr-x)\n ;; `subr-x' function for Emacs 24.3 and below\n (defsubst string-blank-p (string)\n \"Check whether STRING is either empty or only whitespace.\"\n (string-match-p \"\\\\`[ \\t\\n\\r]*\\\\'\" string))))\n\n(unless (fboundp 'defvar-local)\n (defmacro defvar-local (var val &optional docstring)\n `(progn\n (defvar ,var ,val ,docstring)\n (make-variable-buffer-local ',var))))\n\n;;; The following function is copyright FSF, from GNU Emacs 24.4 source code.\n(unless (fboundp 'string-suffix-p)\n (defun string-suffix-p (suffix string &optional ignore-case)\n \"Return non-nil if SUFFIX is a suffix of STRING.\nIf IGNORE-CASE is non-nil, the comparison is done without paying\nattention to case differences.\"\n (let ((start-pos (- (length string) (length suffix))))\n (and (>= start-pos 0)\n (eq t (compare-strings suffix nil nil\n string start-pos nil ignore-case))))))\n\n;; gensym fun introduced at or before Emacs version 26.1.\n(unless (fboundp 'gensym)\n (defalias 'gensym 'cl-gensym))\n\n(if (fboundp 'file-name-concat)\n (defalias 'idris-file-name-concat 'file-name-concat)\n (defun idris-file-name-concat (&rest components)\n (let ((dirs (butlast components)))\n (concat (apply 'concat (mapcar 'file-name-as-directory dirs))\n (car (reverse components))))))\n\n(if (fboundp 'file-name-parent-directory)\n (defalias 'idris-file-name-parent-directory 'file-name-parent-directory)\n ;; Extracted from Emacs 29+ https://github.com/emacs-mirror/emacs/blob/master/lisp/files.el\n (defun idris-file-name-parent-directory (filename)\n \"Return the directory name of the parent directory of FILENAME.\nIf FILENAME is at the root of the filesystem, return nil.\nIf FILENAME is relative, it is interpreted to be relative\nto `default-directory', and the result will also be relative.\"\n (let* ((expanded-filename (expand-file-name filename))\n (parent (file-name-directory (directory-file-name expanded-filename))))\n (cond\n ;; filename is at top-level, therefore no parent\n ((or (null parent)\n ;; `equal' is enough, we don't need to resolve symlinks here\n ;; with `file-equal-p', also for performance\n (equal parent expanded-filename))\n nil)\n ;; filename is relative, return relative parent\n ((not (file-name-absolute-p filename))\n (file-relative-name parent))\n (t\n parent)))))\n\n(provide 'idris-compat)\n;;; idris-compat.el ends here\n" }, { "path": "idris-core.el", "content": ";;; idris-core.el --- Core functionality -*- lexical-binding: t -*-\n;; Copyright (C) 2013 Hannes Mehnert\n\n;; Authors: Hannes Mehnert \n;; David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Code:\n(require 'idris-compat)\n\n(defun idris-is-ident-char-p (ch)\n (or (and (<= ?a ch) (<= ch ?z))\n (and (<= ?A ch) (<= ch ?Z))\n (and (<= ?0 ch) (<= ch ?9))\n (= ch ?_)))\n\n(provide 'idris-core)\n;;; idris-core.el ends here\n" }, { "path": "idris-events.el", "content": ";;; idris-events.el --- Logging of events in inferior Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Mehnert\n\n;; Author: Hannes Mehnert \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n(require 'pp)\n\n(require 'idris-core)\n(require 'idris-common-utils)\n(require 'idris-settings)\n\n(defvar idris-event-buffer-name (idris-buffer-name :events)\n \"The name of the Idris event buffer.\")\n\n(defun idris-events-buffer ()\n \"Return or create the event log buffer.\"\n (or (get-buffer idris-event-buffer-name)\n (let ((buffer (get-buffer-create idris-event-buffer-name)))\n (with-current-buffer buffer\n (buffer-disable-undo)\n (set (make-local-variable 'outline-regexp) \"^(\")\n (set (make-local-variable 'comment-start) \";\")\n (set (make-local-variable 'comment-end) \"\")\n (setq buffer-read-only t))\n buffer)))\n\n(defun idris-event-log (event sending)\n \"Record the fact that EVENT occured in the SENDING direction.\n\nThe event is only logged if `idris-log-events' is non-nil.\"\n (when idris-log-events\n (with-current-buffer (idris-events-buffer)\n (goto-char (point-max))\n (let ((buffer-read-only nil)\n (time (format-time-string \"%H:%M:%S\")))\n (save-excursion\n (if sending\n (insert (concat time \" -> \"))\n (insert (concat time \" <- \")))\n (idris-pprint-event event (current-buffer))))\n (goto-char (point-max)))))\n\n(defun idris-pprint-event (event buffer)\n \"Pretty print EVENT in BUFFER.\"\n (let ((print-length 20)\n (print-level 10)\n (pp-escape-newlines t))\n (pp event buffer)))\n\n(defun idris-dump-events-to-file (file)\n \"Dump event log to FILE.\"\n (when idris-log-events\n (with-current-buffer (idris-events-buffer)\n (write-file file))))\n\n(provide 'idris-events)\n;;; idris-events.el ends here\n" }, { "path": "idris-highlight-input.el", "content": ";;; idris-highlight-input.el --- Compiler-driven highlighting of user input -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2015 David Raymond Christiansen\n\n;; Author: David Raymond Christiansen \n;; Keywords: languages\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; This file contains routines for highlighting user input with\n;; information generated by the Idris elaborator.\n\n;;; Code:\n\n(require 'idris-common-utils)\n(require 'idris-settings)\n\n(defun idris-highlight-remove-overlays (&optional buffer)\n \"Remove all Idris highlighting overlays from BUFFER.\nUse the current buffer if BUFFER is nil.\"\n (interactive)\n (with-current-buffer (or buffer (current-buffer))\n (save-restriction\n (widen)\n (dolist (overlay (overlays-in (point-min) (point-max)))\n (when (overlay-get overlay 'idris-source-highlight)\n (delete-overlay overlay))))))\n\n(defun idris-highlight-column (idris-col)\n \"Compute the Emacs position offset of the Idris column IDRIS-COL.\n\nIn particular, this takes bird tracks into account in literate Idris.\"\n (+ idris-col (if (idris-lidr-p) 1 -1)))\n\n(defun idris-highlight--overlay-modification-hook (&rest args)\n \"Delete semantic overlays if they are changed.\n\nSee Info node `(elisp)Overlay Properties' to understand how ARGS are used.\"\n ;; There are 5 args when it's called post-modification\n (when (= (length args) 5)\n (delete-overlay (car args))))\n\n(defun idris-highlight-input-region (start-line start-col end-line end-col highlight)\n \"Highlight in BUFFER using an overlay from START-LINE and START-COL to\n END-LINE and END-COL and the semantic properties specified in HIGHLIGHT.\"\n (save-excursion\n (save-restriction\n (widen)\n (goto-char (point-min))\n (let* ((start-pos (+ (line-beginning-position start-line)\n (idris-highlight-column start-col)))\n (end-pos (+ (line-beginning-position end-line)\n (idris-highlight-column end-col)))\n (existing-idris-overlays-in-range (seq-filter\n (lambda (overlay)\n (overlay-get overlay 'idris-source-highlight))\n (overlays-in start-pos end-pos)))\n (existing-idris-overlay (seq-find (lambda (overlay)\n (and\n (eql start-pos (overlay-start overlay))\n (eql end-pos (overlay-end overlay))\n ;; TODO: overlay properties match\n ))\n existing-idris-overlays-in-range)))\n (when (null existing-idris-overlay)\n (mapc #'delete-overlay existing-idris-overlays-in-range)\n (let ((highlight-overlay (make-overlay start-pos end-pos)))\n (overlay-put highlight-overlay 'idris-source-highlight t)\n (idris-add-overlay-properties highlight-overlay (idris-semantic-properties highlight))\n (overlay-put highlight-overlay 'modification-hooks '(idris-highlight--overlay-modification-hook))))))))\n\n(defun idris-highlight-source-file (hs)\n (pcase-dolist\n (`(((:filename ,fn)\n (:start ,start-line-raw ,start-col-raw)\n (:end ,end-line-raw ,end-col-raw))\n ,props)\n hs)\n (when (string= (file-name-nondirectory fn)\n (file-name-nondirectory (buffer-file-name)))\n (let ((start-line (if (>=-protocol-version 2 1)\n (1+ start-line-raw)\n start-line-raw))\n (start-col (if (>=-protocol-version 2 1)\n (1+ start-col-raw)\n start-col-raw))\n (end-line (if (>=-protocol-version 2 1)\n (1+ end-line-raw)\n end-line-raw))\n (end-col (if (>= idris-protocol-version 1)\n (1+ end-col-raw)\n end-col-raw)))\n (idris-highlight-input-region start-line start-col\n end-line end-col\n props)))))\n\n(defun idris-highlight-input-region-debug (start-line start-col end-line end-col highlight)\n (when (not (or (> end-line start-line)\n (and (= end-line start-line)\n (> end-col start-col))))\n (message \"Not highlighting absurd span %s:%s-%s:%s with %s\"\n start-line start-col\n end-line end-col\n highlight)))\n\n(defun idris-toggle-semantic-source-highlighting ()\n \"Turn on/off semantic highlighting.\nThis is controled by value of `idris-semantic-source-highlighting' variable.\nWhen the value is `debug' additional checks are performed on received data.\"\n (if idris-semantic-source-highlighting\n (progn\n (if (eq idris-semantic-source-highlighting 'debug)\n (advice-add 'idris-highlight-input-region\n :before-until\n #'idris-highlight-input-region-debug)\n (advice-remove 'idris-highlight-input-region\n #'idris-highlight-input-region-debug))\n (advice-remove 'idris-highlight-source-file #'ignore))\n (advice-add 'idris-highlight-source-file :around #'ignore)))\n\n(defun idris-buffer-semantic-source-highlighting ()\n \"Return nil if current buffer size is larger than set limit.\nThe limit is defined as value of:\n`idris-semantic-source-highlighting-max-buffer-size'.\nOtherwise return current value of `idris-semantic-source-highlighting'\"\n (if (< (buffer-size)\n idris-semantic-source-highlighting-max-buffer-size)\n idris-semantic-source-highlighting\n (message \"Semantic source highlighting is disabled for the current buffer. %s\"\n \"Customize `idris-semantic-source-highlighting-max-buffer-size' to enable it.\")\n nil))\n\n(provide 'idris-highlight-input)\n;;; idris-highlight-input.el ends here\n" }, { "path": "idris-hole-list.el", "content": ";;; idris-hole-list.el --- List Idris holes in a buffer -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 David Raymond Christiansen\n\n;; Author: David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n(require 'cl-lib)\n(require 'prop-menu)\n\n(require 'idris-core)\n(require 'idris-keys)\n(require 'idris-warnings-tree)\n(require 'idris-settings)\n\n(defvar idris-hole-list-buffer-name (idris-buffer-name :holes)\n \"The name of the buffer containing Idris holes.\")\n\n(defun idris-hole-list-quit ()\n \"Quit the Idris hole list.\"\n (interactive)\n (idris-kill-buffer idris-hole-list-buffer-name))\n\n(defvar idris-hole-list-mode-map\n (let ((map (make-keymap)))\n (suppress-keymap map)\n (define-key map (kbd \"RET\") 'idris-compiler-notes-default-action-or-show-details)\n (define-key map (kbd \"\") 'idris-compiler-notes-default-action-or-show-details/mouse)\n ;;; Allow buttons to be clicked with the left mouse button in the hole list\n (define-key map [follow-link] 'mouse-face)\n (cl-loop for keyer\n in '(idris-define-docs-keys\n idris-define-general-keys\n idris-define-active-term-keys)\n do (funcall keyer map))\n map))\n\n(easy-menu-define idris-hole-list-mode-menu idris-hole-list-mode-map\n \"Menu for the Idris hole list buffer.\"\n `(\"Idris Holes\"\n [\"Show term interaction widgets\" idris-add-term-widgets t]\n [\"Close hole list buffer\" idris-hole-list-quit t]\n \"------------------\"\n [\"Customize idris-hole-list-mode\" (customize-group 'idris-hole-list) t]\n [\"Customize fonts and colors\" (customize-group 'idris-faces) t]))\n\n(define-derived-mode idris-hole-list-mode special-mode \"Idris Holes\"\n \"Major mode used for transient Idris hole list buffers.\n\\\\{idris-hole-list-mode-map}\nInvokes `idris-hole-list-mode-hook'.\"\n (setq-local prop-menu-item-functions '(idris-context-menu-items)))\n\n;; TODO: Auto detect mode for idris holes buffer instead of\n;; invoking `idris-hole-list-mode' in `idris-hole-list-show'\n;; (push '(\"#\\\\*idris-holes\\\\*$\" . idris-hole-list-mode) auto-mode-alist)\n\n(defun idris-hole-list-buffer ()\n \"Return the Idris hole buffer, creating one if there is not one.\"\n (get-buffer-create idris-hole-list-buffer-name))\n\n(defun idris-hole-list-show (hole-info)\n (if (null hole-info)\n (progn (message \"No holes found!\")\n (idris-hole-list-quit))\n (with-current-buffer (idris-hole-list-buffer)\n (idris-hole-list-mode)\n (let ((buffer-read-only nil))\n (erase-buffer)\n (insert (propertize \"Holes\" 'face 'idris-info-title-face) \"\\n\\n\")\n (when idris-show-help-text\n (insert \"This buffer displays the unsolved holes from the currently-loaded code. \")\n (insert (concat \"Press the \"\n (if idris-enable-elab-prover \"[E]\" \"[P]\")\n \" buttons to solve the holes interactively in the prover.\"))\n (let ((fill-column 80))\n (fill-region (point-min) (point-max)))\n (insert \"\\n\\n\"))\n (dolist (tree (mapcar #'idris-tree-for-hole hole-info))\n (idris-tree-insert tree \"\")\n (insert \"\\n\\n\"))\n (message \"Press q to close\")\n (goto-char (point-min))))\n (display-buffer (idris-hole-list-buffer))))\n\n(defun idris-hole-tree-printer (tree)\n \"Print TREE, formatted for holes.\"\n (idris-propertize-spans (idris-repl-semantic-text-props (idris-tree.highlighting tree))\n (insert (idris-tree.item tree)))\n (when (idris-tree.button tree)\n (insert \" \")\n (apply #'insert-button (idris-tree.button tree))\n (insert (idris-tree.after-button tree))))\n\n\n;;; Prevent circularity error\n(autoload 'idris-prove-hole \"idris-commands.el\")\n\n(defun idris-tree-for-hole (hole)\n \"Generate a tree for HOLE.\n\nHOLE should be a three-element list consisting of the\nhole name, its premises, and its conclusion.\"\n (cl-destructuring-bind (name premises conclusion) hole\n (make-idris-tree :item name\n :button (if idris-enable-elab-prover\n `(\"[E]\"\n help-echo \"Elaborate interactively\"\n action ,#'(lambda (_)\n (interactive)\n (idris-prove-hole name t)))\n `(\"[P]\"\n help-echo \"Open in prover\"\n action ,#'(lambda (_)\n (interactive)\n (idris-prove-hole name))))\n :highlighting `((0 ,(length name) ((:decor :metavar))))\n :print-fn #'idris-hole-tree-printer\n :collapsed-p (not idris-hole-list-show-expanded) ; from customize\n :preserve-properties '(idris-tt-term)\n :kids (list (idris-tree-for-hole-details name premises conclusion)))))\n\n(defun idris-tree-for-hole-details (name premises conclusion)\n (let* ((name-width (1+ (apply #'max 0 (length name)\n (mapcar #'(lambda (h) (length (car h)))\n premises))))\n (divider-marker nil)\n (contents (with-temp-buffer\n (dolist (h premises)\n (cl-destructuring-bind (name type formatting) h\n (cl-dotimes (_ (- name-width (length name))) (insert \" \"))\n (idris-propertize-spans (idris-repl-semantic-text-props\n `((0 ,(length name) ((:decor :bound)))))\n (insert name))\n (insert \" : \")\n (let ((start (point)))\n (idris-propertize-spans (idris-repl-semantic-text-props formatting)\n (insert type))\n (insert \"\\n\")\n ;; Indent the term to match the tree and\n ;; its binder, if it is more than one line.\n (let ((term-end-marker (copy-marker (point))))\n (beginning-of-line)\n (forward-line -1)\n (while (< start (point))\n ;; Preserve the term annotation, to not break active terms\n (let ((tm (get-text-property (point) 'idris-tt-term)))\n (insert-before-markers\n (propertize (make-string (+ 3 name-width) ? )\n 'idris-tt-term tm)))\n (forward-line -1))\n (goto-char term-end-marker)))))\n (setq divider-marker (point-marker))\n (cl-destructuring-bind (type formatting) conclusion\n (when premises\n (insert \" \")\n (idris-propertize-spans (idris-repl-semantic-text-props\n `((0 ,(length name) ((:decor :metavar)))))\n (insert name))\n (insert \" : \"))\n (idris-propertize-spans (idris-repl-semantic-text-props formatting)\n (insert type)))\n (when premises\n (let ((width (apply #'max 0\n (mapcar #'length\n (split-string (buffer-string) \"\\n\")))))\n (goto-char (marker-position divider-marker))\n (dotimes (_ (1+ width)) (insert \"-\"))\n (insert \"\\n\")))\n (buffer-string))))\n (make-idris-tree :item contents\n :active-p nil\n :highlighting '()\n :preserve-properties '(idris-tt-term))))\n\n\n(provide 'idris-hole-list)\n" }, { "path": "idris-info.el", "content": ";;; idris-info.el --- Facilities for showing Idris help information -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 David Raymond Christiansen\n\n;; Author: David Raymond Christiansen \n;; Keywords: languages, tools\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; This module contains facilities for showing information provided by the\n;; Idris compiler in a separate buffer, as well as keeping the irritation of\n;; that buffer to a minimum.\n\n;;; Code:\n(require 'prop-menu)\n(require 'idris-core)\n(require 'idris-common-utils)\n(require 'help-mode)\n\n(defvar idris-info-buffer-name (idris-buffer-name :info)\n \"The name of the buffer containing Idris help information\")\n\n(defvar idris-info-mode-map\n (let ((map (make-keymap)))\n (suppress-keymap map) ; remove the self-inserting char commands\n ;;; Allow buttons to be clicked with the left mouse button in info buffers\n (define-key map [follow-link] 'mouse-face)\n (cl-loop for keyer\n in '(idris-define-docs-keys\n idris-define-general-keys\n idris-define-active-term-keys)\n do (funcall keyer map))\n map))\n\n(easy-menu-define idris-info-mode-menu idris-info-mode-map\n \"Menu for the Idris info buffer.\"\n `(\"Idris Info\"\n [\"Show term interaction widgets\" idris-add-term-widgets t]\n [\"Close Idris info buffer\" idris-info-quit t]))\n\n(define-derived-mode idris-info-mode help-mode \"Idris Info\"\n \"Major mode used for transient Idris information.\n\\\\{idris-info-mode-map}\nInvokes `idris-info-mode-hook'.\"\n (setq-local prop-menu-item-functions '(idris-context-menu-items))\n (set (make-local-variable 'prop-menu-item-functions) '(idris-context-menu-items)))\n\n(defun idris-info-buffer ()\n \"Return Idris info buffer.\"\n (let ((buffer (get-buffer-create idris-info-buffer-name)))\n (with-current-buffer buffer\n (when (not (eq major-mode 'idris-info-mode))\n (idris-info-mode)))\n buffer))\n\n(defalias 'idris-info-quit #'quit-window)\n\n(defmacro with-idris-info-buffer (&rest cmds)\n \"Execute `CMDS' in a fresh Idris info buffer, then display it to the user.\"\n (declare (indent defun))\n `(idris-show-info (with-temp-buffer ,@cmds (buffer-string))))\n\n(defun idris-show-info (info-string &optional spans)\n \"Show INFO-STRING with SPANS in the Idris info buffer.\"\n (with-current-buffer (idris-info-buffer)\n ;; (help-xref-following t) ensure that current buffer -> idris-info-buffer\n ;; is recognised by `help-setup-xref' and `with-help-window'\n ;; as `help-buffer'\n (let ((help-xref-following t))\n (help-setup-xref (list #'idris-show-info info-string spans)\n (called-interactively-p 'interactive))\n (with-help-window (current-buffer)\n (idris-propertize-spans (idris-repl-semantic-text-props spans)\n (insert info-string)))\n ;; reset major-mode for idris-info-buffer\n ;; back from help-mode to idris-info-mode\n (idris-info-buffer))))\n\n(provide 'idris-info)\n;;; idris-info.el ends here\n" }, { "path": "idris-ipkg-mode.el", "content": ";;; idris-ipkg-mode.el --- Major mode for editing Idris package files -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014\n\n;; Author: David Raymond Christiansen\n;; URL: https://github.com/idris-hackers/idris-mode\n;; Keywords: languages\n;; Package-Requires: ((emacs \"24\"))\n\n\n;;; Commentary:\n\n;; This is an Emacs mode for editing Idris packages. It requires the latest\n;; version of Idris, and some features may rely on the latest Git version of\n;; Idris.\n\n;;; Code:\n(require 'ansi-color)\n(require 'compile)\n\n(require 'idris-core)\n(require 'idris-settings)\n(require 'idris-common-utils)\n(require 'idris-keys)\n\n;;; Faces\n\n(defface idris-ipkg-keyword-face\n '((t (:inherit font-lock-keyword-face)))\n \"The face to highlight Idris package keywords.\"\n :group 'idris-faces)\n\n(defface idris-ipkg-package-name-face\n '((t (:inherit font-lock-function-name-face)))\n \"The face to highlight the name of the package.\"\n :group 'idris-faces)\n\n\n;;; Syntax\n\n(defconst idris-ipkg-syntax-table\n (let ((st (make-syntax-table (standard-syntax-table))))\n ;; Strings\n (modify-syntax-entry ?\\\" \"\\\"\" st)\n (modify-syntax-entry ?\\\\ \"/\" st)\n\n ;; Matching {}, but with nested comments\n (modify-syntax-entry ?\\{ \"(} 1bn\" st)\n (modify-syntax-entry ?\\} \"){ 4bn\" st)\n (modify-syntax-entry ?\\- \"_ 123\" st)\n (modify-syntax-entry ?\\n \">\" st)\n\n st))\n\n(defconst idris-ipkg-keywords\n '(\"package\"\n \"authors\"\n \"maintainers\"\n \"license\"\n \"brief\"\n \"readme\"\n \"homepage\"\n \"sourceloc\"\n \"bugtracker\"\n \"options\"\n \"opts\"\n \"sourcedir\"\n \"builddir\"\n \"outputdir\"\n \"prebuild\"\n \"postbuild\"\n \"preinstall\"\n \"postinstall\"\n \"preclean\"\n \"postclean\"\n \"version\"\n \"langversion\"\n \"depends\"\n \"modules\"\n \"main\"\n \"executable\"\n \"makefile\"\n \"objs\"\n \"libs\"\n \"pkgs\"))\n\n(defconst idris-ipkg-font-lock-defaults\n `(,idris-ipkg-keywords))\n\n(defconst idris-ipkg-sourcedir-re\n;; \"^sourcedir\\\\s-*=\\\\s-*\\\"?\\\\([a-zA-Z/0-9]+\\\\)\\\"?\"\n \"^\\\\s-*sourcedir\\\\s-*=\\\\s-*\\\\(\\\\sw+\\\\)\"\n)\n\n;;; Completion\n\n(defun idris-ipkg-find-keyword ()\n (let ((start nil)\n (end (point))\n (failure (list nil nil nil)))\n (if (idris-is-ident-char-p (char-before))\n (progn\n (save-excursion\n (while (idris-is-ident-char-p (char-before))\n (backward-char))\n (setq start (point)))\n (if start\n (list (buffer-substring-no-properties start end)\n start\n end)\n failure))\n failure)))\n\n(defun idris-ipkg-complete-keyword ()\n \"Complete the current .ipkg keyword, if possible.\"\n (interactive)\n (cl-destructuring-bind (identifier start end) (idris-ipkg-find-keyword)\n (when identifier\n (list start end idris-ipkg-keywords))))\n\n;;; Inserting fields\n(defun idris-ipkg-insert-field ()\n \"Insert one of the ipkg fields.\"\n (interactive)\n (let ((field (completing-read \"Field: \" (remove \"package\" idris-ipkg-keywords) nil t)))\n (beginning-of-line)\n (while (and (not (looking-at-p \"^\\\\s-*$\")) (= (forward-line) 0)))\n (beginning-of-line)\n (when (not (looking-at-p \"^\\\\s-*$\")) ;; end of buffer had stuff\n (goto-char (point-max))\n (newline))\n (newline)\n (insert field \" = \")\n (let ((p (point)))\n (newline)\n (goto-char p))))\n\n;;; Clickable modules\n\n(defun idris-ipkg-make-files-clickable ()\n \"Make all modules with existing files clickable, where clicking opens them.\"\n (interactive)\n (idris-clear-file-link-overlays 'idris-ipkg-mode)\n (let ((src-dir (idris-ipkg-buffer-src-dir (file-name-directory (buffer-file-name)))))\n ;; Make the sourcedir clickable\n (save-excursion\n (goto-char (point-min))\n (when (and (file-exists-p src-dir)\n (file-directory-p src-dir)\n (re-search-forward idris-ipkg-sourcedir-re nil t))\n (let ((start (match-beginning 1))\n (end (match-end 1))\n (map (make-sparse-keymap)))\n (define-key map [mouse-2] #'(lambda ()\n (interactive)\n (dired src-dir)))\n (idris-make-file-link-overlay start end map\n (concat \"mouse-2: dired \" src-dir)))))\n ;; Make the modules clickable\n (save-excursion\n (goto-char (point-min))\n (cl-flet ((mod-link ()\n (re-search-forward \"[a-zA-Z0-9\\\\.]+\" nil t)\n (let ((beg (match-beginning 0))\n (end (match-end 0)))\n (idris-make-module-link beg end src-dir))))\n (when (re-search-forward \"^modules\\\\s-*=\\\\s-*\" nil t)\n (cl-loop initially (mod-link)\n while (looking-at-p \"\\\\s-*,\\\\s-*\")\n do (progn (skip-chars-forward \" ,\\n\")\n (mod-link))))))\n ;; Make the Makefile clickable\n (save-excursion\n (goto-char (point-min))\n (when (re-search-forward \"^makefile\\\\s-*=\\\\s-*\\\\([a-zA-Z/0-9]+\\\\)\" nil t)\n (let ((start (match-beginning 1))\n (end (match-end 1))\n (makefile (concat (file-name-as-directory src-dir) (match-string 1))))\n (when (file-exists-p makefile)\n (let ((map (make-sparse-keymap)))\n (define-key map [mouse-2] #'(lambda ()\n (interactive)\n (find-file makefile)))\n (idris-make-file-link-overlay start end map \"mouse-2: edit makefile\"))))))))\n\n\n(defun idris-ipkg-enable-clickable-files ()\n \"Enable setting up clickable modules and makefiles on idle Emacs.\"\n (interactive)\n (add-hook 'after-save-hook 'idris-ipkg-make-files-clickable)\n (idris-ipkg-make-files-clickable))\n\n;;; finding ipkg files\n\n;; Based on http://www.emacswiki.org/emacs/EmacsTags section \"Finding tags files\"\n;; That page is GPL, so this is OK to include\n(defun idris-find-file-upwards (suffix &optional allow-hidden)\n \"Recursively searches each parent directory starting from the\ndirectory of the current buffer filename or from\n`default-directory' if that's not found, looking for a file with\nname ending in SUFFIX. Returns the paths to the matching files,\nor nil if not found.\"\n (cl-labels\n ((find-file-r (path)\n (let* ((parent (file-name-directory path))\n (matching (if parent\n (idris-try-directory-files parent t (concat \"\\\\\\.\" suffix \"$\"))\n nil)))\n (cond\n (matching matching)\n ;; The parent of ~ is nil and the parent of / is itself.\n ;; Thus the terminating condition for not finding the file\n ;; accounts for both.\n ((or (null parent) (equal parent (directory-file-name parent))) nil) ; Not found\n (t (find-file-r (directory-file-name parent))))))) ; Continue\n (let* ((file (buffer-file-name (current-buffer)))\n (dir (if file (file-name-directory file) default-directory)))\n (when dir\n (cl-remove-if #'(lambda (f)\n (and (not allow-hidden)\n (string-prefix-p \".\" (file-name-nondirectory f))))\n (find-file-r dir))))))\n\n(defun idris-try-directory-files (directory &optional full match nosort)\n \"Call `directory-files' with arguments DIRECTORY, FULL, MATCH and NOSORT.\nReturn the empty list on failure instead of throwing an error.\n\nSee the docstring for `directory-files' for the meaning of the\narguments.\"\n ;; This wrapper is useful because some users can't read all the\n ;; directories above the current working directory. In particular,\n ;; /home is sometimes not readable.\n (condition-case nil\n (directory-files directory full match nosort)\n (error nil)))\n\n(defvar idris-ipkg-build-buffer-name \"*idris-build*\")\n\n(defun idris-ipkg--compilation-buffer-name-function (_mode)\n \"Compute a buffer name for the `idris-mode' compilation buffer.\"\n idris-ipkg-build-buffer-name)\n\n(defun idris-ipkg--ansi-compile-filter (start)\n \"Apply ANSI formatting to the region of the buffer from START to point.\"\n (save-excursion\n (let ((buffer-read-only nil))\n (ansi-color-apply-on-region start (point)))))\n\n(defun idris-ipkg-command (ipkg-file command)\n \"Run a command on IPKG-FILE. The COMMAND can be build, install, or clean.\"\n ;; Idris must have its working directory in the same place as the ipkg file\n (let ((dir (file-name-directory ipkg-file))\n (file (file-name-nondirectory ipkg-file))\n (opt (cond ((equal command 'build) \"--build\")\n ((equal command 'install) \"--install\")\n ((equal command 'clean) \"--clean\")\n (t (error \"Invalid command name %s\" command)))))\n (unless dir\n (error \"Unable to determine directory for filename '%s'\" ipkg-file))\n (let* ((default-directory dir) ; default-directory is a special variable - this starts idris in dir\n (compilation-buffer-name-function\n 'idris-ipkg--compilation-buffer-name-function)\n (command (concat idris-interpreter-path \" \" opt \" \" file))\n (compilation-filter-hook\n (cons 'idris-ipkg--ansi-compile-filter compilation-filter-hook)))\n (compile command))))\n\n(defun idris-ipkg-build (ipkg-file)\n (interactive (list\n (let ((ipkg-default (idris-find-file-upwards \"ipkg\")))\n (if ipkg-default\n (read-file-name \"Package file to build: \"\n (file-name-directory (car ipkg-default))\n (car ipkg-default)\n t\n (file-name-nondirectory (car ipkg-default)))\n (read-file-name \"Package file to build: \" nil nil nil t)))))\n (idris-ipkg-command ipkg-file 'build))\n\n(defun idris-ipkg-install (ipkg-file)\n (interactive (list\n (let ((ipkg-default (idris-find-file-upwards \"ipkg\")))\n (if ipkg-default\n (read-file-name \"Package file to install: \"\n (file-name-directory (car ipkg-default))\n (car ipkg-default)\n t\n (file-name-nondirectory (car ipkg-default)))\n (read-file-name \"Package file to install: \" nil nil nil t)))))\n (idris-ipkg-command ipkg-file 'install))\n\n(defun idris-ipkg-clean (ipkg-file)\n (interactive (list\n (let ((ipkg-default (idris-find-file-upwards \"ipkg\")))\n (if ipkg-default\n (read-file-name \"Package file to clean: \"\n (file-name-directory (car ipkg-default))\n (car ipkg-default)\n t\n (file-name-nondirectory (car ipkg-default)))\n (read-file-name \"Package file to clean: \" nil nil nil t)))))\n (idris-ipkg-command ipkg-file 'clean))\n\n(defun idris-ipkg-build-quit ()\n (interactive)\n (idris-kill-buffer idris-ipkg-build-buffer-name))\n\n(defun idris-ipkg-buffer-src-dir (basename)\n (save-excursion\n (goto-char (point-min))\n (let ((found\n (re-search-forward idris-ipkg-sourcedir-re nil t)))\n (if found\n (let ((subdir (buffer-substring-no-properties (match-beginning 1) (match-end 1))))\n (concat (file-name-directory basename) subdir))\n (file-name-directory basename)))))\n\n(defun idris-ipkg-find-src-dir (&optional ipkg-file)\n (let ((found (or (and ipkg-file (list ipkg-file))\n (idris-find-file-upwards \"ipkg\"))))\n (if (not found)\n nil\n (setq ipkg-file (car found))\n ;; Now ipkg-file contains the path to the package\n (with-temp-buffer\n (insert-file-contents ipkg-file)\n (idris-ipkg-buffer-src-dir ipkg-file)))))\n\n(defun idris-ipkg-buffer-cmdline-opts ()\n (save-excursion\n (goto-char (point-min))\n (let ((found\n (re-search-forward \"^\\\\s-*opts\\\\s-*=\\\\s-*\\\"\\\\([^\\\"]*\\\\)\\\"\"\n nil\n t)))\n (if found\n (buffer-substring-no-properties (match-beginning 1) (match-end 1))\n \"\"))))\n\n(defun idris-ipkg-find-cmdline-opts (&optional ipkg-file)\n (let ((found (or (and ipkg-file (list ipkg-file))\n (idris-find-file-upwards \"ipkg\"))))\n (if (not found)\n nil\n (setq ipkg-file (car found))\n ;; Now ipkg-file contains the path to the package\n (with-temp-buffer\n (insert-file-contents ipkg-file)\n (idris-ipkg-buffer-cmdline-opts)))))\n\n(defun idris-ipkg-flags-for-current-buffer ()\n \"Extract the command line options field from the current .ipkg buffer.\"\n (let ((opts (idris-ipkg-find-cmdline-opts)))\n (if (stringp opts)\n (split-string opts nil t)\n nil)))\n\n(defun idris-ipkg-pkgs-for-current-buffer ()\n \"Find the explicit list of packages for the current .ipkg buffer.\"\n (let ((file (idris-find-file-upwards \"ipkg\")))\n (when file\n (with-temp-buffer\n (let ((pkgs nil))\n (cl-flet\n ((get-pkg ()\n (re-search-forward \"[a-zA-Z0-9\\\\._-]+\" nil t)\n (let ((beg (match-beginning 0))\n (end (match-end 0)))\n (push (buffer-substring-no-properties beg end) pkgs))))\n (insert-file-contents (car file))\n (goto-char (point-min))\n (when (re-search-forward \"^\\\\s-*pkgs\\\\s-*=\\\\s-*\" nil t)\n (cl-loop initially (get-pkg)\n while (looking-at-p \"\\\\s-*,\\\\s-*\")\n do (progn (skip-chars-forward \" ,\\n\")\n (get-pkg)))))\n pkgs)))))\n\n(defun idris-ipkg-pkgs-flags-for-current-buffer ()\n \"List of Idris command line options based on the pkgs field of the .ipkg file.\"\n (let ((pkgs (idris-ipkg-pkgs-for-current-buffer)))\n (cl-loop for pkg in pkgs appending (list \"-p\" pkg))))\n\n(add-to-list 'idris-command-line-option-functions 'idris-ipkg-flags-for-current-buffer)\n(add-to-list 'idris-command-line-option-functions 'idris-ipkg-pkgs-flags-for-current-buffer)\n\n;;; Settings\n\n(defgroup idris-ipkg nil \"Idris package mode\" :prefix 'idris-ipkg :group 'idris)\n\n(defcustom idris-ipkg-mode-hook '(idris-ipkg-enable-clickable-files)\n \"Hook to run when setting up the mode for editing Idris packages.\"\n :type 'hook\n :options '(idris-ipkg-enable-clickable-files)\n :group 'idris-ipkg)\n\n;;; Mode definition\n\n(defvar idris-ipkg-mode-map (let ((map (make-sparse-keymap)))\n (cl-loop for keyer\n in '(idris-define-ipkg-keys\n idris-define-ipkg-editing-keys)\n do (funcall keyer map))\n map)\n \"Keymap used for Idris package mode.\")\n\n(easy-menu-define idris-ipkg-mode-menu idris-ipkg-mode-map\n \"Menu for Idris package mode.\"\n `(\"IPkg\"\n [\"Build package\" idris-ipkg-build t]\n [\"Install package\" idris-ipkg-install t]\n [\"Clean package\" idris-ipkg-clean t]\n \"----------------\"\n [\"Insert field\" idris-ipkg-insert-field t]))\n\n;;;###autoload\n(define-derived-mode idris-ipkg-mode prog-mode \"Idris Pkg\"\n \"Major mode for Idris package files.\n\\\\{idris-ipkg-mode-map}\nInvokes `idris-ipkg-mode-hook'.\"\n :group 'idris\n :syntax-table idris-ipkg-syntax-table\n (set (make-local-variable 'font-lock-defaults)\n idris-ipkg-font-lock-defaults)\n (set (make-local-variable 'completion-at-point-functions)\n '(idris-ipkg-complete-keyword))\n (set (make-local-variable 'comment-start) \"--\"))\n\n;; Make filenames clickable\n(add-to-list 'compilation-error-regexp-alist-alist\n `(idris-type-checking\n \"Type checking \\\\(.+\\\\)$\" 1 nil nil 0 1))\n\n(cl-pushnew 'idris-type-checking compilation-error-regexp-alist)\n\n(push '(\"\\\\.ipkg$\" . idris-ipkg-mode) auto-mode-alist)\n\n(provide 'idris-ipkg-mode)\n\n;;; idris-ipkg-mode.el ends here\n" }, { "path": "idris-keys.el", "content": ";;; idris-keys.el --- Hooks to define Idris keybindings -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 David Raymond Christiansen\n\n;; Author: David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Commentary:\n;; We don't need to (require 'idris-commands) because the RHS of keybindings\n;; is always just a quoted symbol\n\n;;; Code:\n\n(require 'idris-core)\n\n;;; Keymap-construction hooks\n\n;; These are provided as hooks rather than being hard-coded to facilitate\n;; their replacement and cut down on copy-paste.\n\n(defun idris-define-loading-keys (map)\n \"Define the keys related to loading files in the keymap MAP.\"\n (define-key map (kbd \"C-c C-l\") 'idris-load-file)\n (define-key map (kbd \"C-c C-n\") 'idris-load-forward-line)\n (define-key map (kbd \"C-c C-p\") 'idris-load-backward-line))\n\n(defun idris-define-docs-keys (map)\n \"Define the keys related to documentation lookup in the keymap MAP.\"\n (define-key map (kbd \"C-c C-t\") 'idris-type-at-point)\n (define-key map (kbd \"C-c C-d C-d\") 'idris-docs-at-point)\n (define-key map (kbd \"C-c C-d d\") 'idris-docs-at-point)\n (define-key map (kbd \"C-c C-d C-a\") 'idris-apropos)\n (define-key map (kbd \"C-c C-d a\") 'idris-apropos)\n (define-key map (kbd \"C-c C-d C-t\") 'idris-type-search)\n (define-key map (kbd \"C-c C-d t\") 'idris-type-search))\n\n(defun idris-define-editing-keys (map)\n \"Define the keys related to editing Idris code in the keymap MAP.\"\n (define-key map (kbd \"C-c C-c\") 'idris-case-dwim)\n (define-key map (kbd \"C-c C-m\") 'idris-add-missing)\n (define-key map (kbd \"C-c C-e\") 'idris-make-lemma)\n (define-key map (kbd \"C-c C-s\") 'idris-add-clause)\n (define-key map (kbd \"C-c C-w\") 'idris-make-with-block)\n (define-key map (kbd \"C-c C-a\") 'idris-proof-search)\n\n (define-key map (kbd \"C-c C-S-a\") 'idris-proof-search-next)\n (define-key map (kbd \"C-c C-g\") 'idris-generate-def)\n (define-key map (kbd \"C-c C-S-g\") 'idris-generate-def-next)\n\n (define-key map (kbd \"C-c C-r\") 'idris-intro)\n (define-key map (kbd \"C-c C-S-r\") 'idris-refine)\n (define-key map (kbd \"RET\") 'idris-newline-and-indent)\n ;; Not using `kbd' due to oddness about backspace and delete\n (define-key map [delete] 'idris-delete-forward-char)\n (define-key map (kbd \"C-d\") 'idris-delete-forward-char)\n (define-key map (kbd \"M-n\") 'idris-next-error)\n (define-key map (kbd \"M-p\") 'idris-previous-error))\n\n(defun idris-define-general-keys (map)\n \"Define keys that are generally useful for all Idris modes in the keymap MAP.\"\n (define-key map (kbd \"C-c C-z\") 'idris-switch-to-repl)\n (define-key map (kbd \"\") 'prop-menu-show-menu)\n (define-key map (kbd \"C-c C-SPC\") 'prop-menu-by-completing-read))\n\n(defun idris-define-active-term-keys (map)\n \"Define keys for manipulating active terms in the keymap MAP.\"\n (define-key map (kbd \"C-c C-m n\") 'idris-normalize-term)\n (define-key map (kbd \"C-c C-m i\") 'idris-show-term-implicits)\n (define-key map (kbd \"C-c C-m h\") 'idris-hide-term-implicits)\n (define-key map (kbd \"C-c C-m c\") 'idris-show-core-term))\n\n(defun idris-define-ipkg-keys (map)\n \"Define keys for working with the current package in the keymap MAP.\"\n (define-key map (kbd \"C-c C-b b\") 'idris-ipkg-build)\n (define-key map (kbd \"C-c C-b C-b\") 'idris-ipkg-build)\n (define-key map (kbd \"C-c C-b c\") 'idris-ipkg-clean)\n (define-key map (kbd \"C-c C-b C-c\") 'idris-ipkg-clean)\n (define-key map (kbd \"C-c C-b i\") 'idris-ipkg-install)\n (define-key map (kbd \"C-c C-b C-i\") 'idris-ipkg-install))\n\n(defun idris-define-ipkg-editing-keys (map)\n \"Define keys used only for editing packages in the keymap MAP.\"\n (define-key map (kbd \"C-c C-f\") 'idris-ipkg-insert-field))\n\n(defun idris-define-ipkg-opening-keys (map)\n \"Define keys used to find or open a package file in the keymap MAP.\"\n (define-key map (kbd \"C-c C-b C-p\") 'idris-open-package-file)\n (define-key map (kbd \"C-c C-b p\") 'idris-open-package-file))\n\n(defun idris-define-evil-keys ()\n \"Define keys for evil-mode.\"\n (when (fboundp 'evil-leader/set-key-for-mode)\n (evil-leader/set-key-for-mode 'idris-mode\n \"r\" 'idris-load-file\n \"t\" 'idris-type-at-point\n \"d\" 'idris-add-clause\n \"l\" 'idris-make-lemma\n \"c\" 'idris-case-split\n \"w\" 'idris-make-with-block\n \"m\" 'idris-add-missing\n \"p\" 'idris-proof-search\n \"h\" 'idris-docs-at-point)))\n\n(provide 'idris-keys)\n\n;;; idris-keys.el ends here\n" }, { "path": "idris-log.el", "content": ";;; idris-log.el --- Logging of Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013-2014 Hannes Mehnert and David Raymond Christiansen\n\n;; Authors: Hannes Mehnert \n;; David Raymond Christiansen \n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n\n;;; Commentary:\n;; Record and present log messages from Idris compiler in a buffer.\n\n(require 'idris-core)\n(require 'idris-common-utils)\n\n;;; Code:\n\n(defvar idris-log-buffer-name (idris-buffer-name :log)\n \"The name of the Idris log buffer.\")\n\n(defface idris-log-timestamp-face\n '((t :foreground \"#211ab0\"\n :weight bold))\n \"The face used for timestamps in the Idris log.\"\n :group 'idris-faces)\n\n(defface idris-log-level-face\n '((t :weight bold))\n \"General properties for displaying Idris log levels.\"\n :group 'idris-faces)\n\n(defface idris-log-level-1-face\n '((t :foreground \"#ff0011\"))\n \"The face used for log level 1 in the Idris log.\"\n :group 'idris-faces)\n\n(defface idris-log-level-2-face\n '((t :foreground \"#dd0033\"))\n \"The face used for log level 2 in the Idris log.\"\n :group 'idris-faces)\n\n(defface idris-log-level-3-face\n '((t :foreground \"#bb0055\"))\n \"The face used for log level 3 in the Idris log.\"\n :group 'idris-faces)\n\n(defface idris-log-level-4-face\n '((t :foreground \"#990077\"))\n \"The face used for log level 4 in the Idris log.\"\n :group 'idris-faces)\n\n(defface idris-log-level-5-face\n '((t :foreground \"#770099\"))\n \"The face used for log level 5 in the Idris log.\"\n :group 'idris-faces)\n\n(defface idris-log-level-higher-face\n '((t :foreground \"#550099\"))\n \"The face used for log levels over 5 in the Idris log.\"\n :group 'idris-faces)\n\n(defun idris-get-log-level-face (level)\n (cond ((= level 1) 'idris-log-level-1-face)\n ((= level 2) 'idris-log-level-2-face)\n ((= level 3) 'idris-log-level-3-face)\n ((= level 4) 'idris-log-level-4-face)\n ((= level 5) 'idris-log-level-5-face)\n (t 'idris-log-level-higher-face)))\n\n(defvar idris-log-mode-map\n (let ((map (make-keymap)))\n (suppress-keymap map) ; remove self-inserting char commands\n map))\n\n(define-derived-mode idris-log-mode fundamental-mode \"Idris Log\"\n \"Major mode used to show Idris compiler internals logs.\n\\\\{idris-log-mode-map}\nInvokes `idris-log-mode-hook'.\"\n (buffer-disable-undo)\n (set (make-local-variable 'outline-regexp) \"^(\")\n (set (make-local-variable 'comment-start) \";\")\n (set (make-local-variable 'comment-end) \"\")\n (set (make-local-variable 'left-margin-width) 22)\n (setq buffer-read-only t)\n (view-mode 1))\n\n(defun idris-log-buffer ()\n \"Return or create the log buffer.\"\n (or (get-buffer idris-log-buffer-name)\n (let ((buffer (get-buffer-create idris-log-buffer-name)))\n (with-current-buffer buffer\n (idris-log-mode))\n buffer)))\n\n(defun idris-log (level message)\n \"Record with LEVEL the fact that MESSAGE occured.\"\n ;; TODO: Different faces for different log levels\n (with-current-buffer (idris-log-buffer)\n (goto-char (point-max))\n (let* ((buffer-read-only nil)\n (time (format-time-string \"%Y-%m-%d %H:%M:%S\"))\n (meta-info (concat (propertize time 'face 'idris-log-timestamp-face)\n (propertize (format \"%2s\" level)\n 'face (idris-get-log-level-face level))))\n (meta (propertize \" \"\n 'display `((margin left-margin)\n ,meta-info))))\n (save-excursion\n (insert meta)\n (insert message)\n (insert \"\\n\")))\n (goto-char (point-max))))\n\n(defun idris-log-hook-function (event)\n (pcase event\n (`(:log (,level ,message) ,_target)\n (idris-log level message)\n t)\n (_ nil)))\n\n(provide 'idris-log)\n\n;;; idris-log.el ends here\n" }, { "path": "idris-mode.el", "content": ";;; idris-mode.el --- Major mode for editing Idris code -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013\n\n;; Author:\n;; URL: https://github.com/idris-hackers/idris-mode\n;; Keywords: languages\n;; Package-Requires: ((emacs \"24\") (prop-menu \"0.1\") (cl-lib \"0.5\"))\n;; Version: 1.1.0\n\n\n;;; Commentary:\n\n;; This is an Emacs mode for editing Idris code. It requires the latest\n;; version of Idris, and some features may rely on the latest Git version of\n;; Idris.\n\n;;; Code:\n\n(require 'prop-menu)\n(require 'eldoc)\n\n(require 'idris-core)\n(require 'idris-settings)\n(require 'idris-syntax)\n(require 'idris-simple-indent)\n(require 'idris-repl)\n(require 'idris-commands)\n(require 'idris-warnings)\n(require 'idris-common-utils)\n(require 'idris-ipkg-mode)\n(require 'idris-xref)\n\n(defun idris-mode-context-menu-items (plist)\n \"Compute menu items from PLIST that are specific to editing text in `idris-mode'.\"\n (let ((ref (plist-get plist 'idris-ref))\n (ref-style (plist-get plist 'idris-ref-style)))\n (when (and ref (equal ref-style :metavar))\n (list (list \"Extract lemma\"\n (let ((location (point)))\n (lambda ()\n (interactive)\n (save-excursion\n (goto-char location)\n (idris-make-lemma)))))\n (list \"Fill with case block\"\n (let ((location (point)))\n (lambda ()\n (interactive)\n (save-excursion\n (goto-char location)\n (idris-make-cases-from-hole)))))))))\n\n(defvar idris-mode-map (let ((map (make-sparse-keymap)))\n (cl-loop for keyer\n in '(idris-define-loading-keys\n idris-define-docs-keys\n idris-define-editing-keys\n idris-define-general-keys\n idris-define-ipkg-keys\n idris-define-ipkg-opening-keys)\n do (funcall keyer map))\n map)\n \"Keymap used in Idris mode.\")\n\n\n\n(easy-menu-define idris-mode-menu idris-mode-map\n \"Menu for the Idris major mode.\"\n `(\"Idris\"\n [\"New Project\" idris-start-project t]\n \"-----------------\"\n [\"Load file\" idris-load-file t]\n [\"Choose packages\" idris-set-idris-load-packages t]\n [\"Compile and execute\" idris-compile-and-execute]\n [\"Delete IBC file\" idris-delete-ibc t]\n [\"View compiler log\" idris-view-compiler-log (get-buffer idris-log-buffer-name)]\n [\"Quit inferior Idris process\" idris-quit t]\n \"-----------------\"\n [\"Add initial match clause to type declaration\" idris-add-clause t]\n [\"Add missing cases\" idris-add-missing t]\n [\"Case split pattern variable\" idris-case-dwim t]\n [\"Add with block\" idris-make-with-block t]\n [\"Extract lemma from hole\" idris-make-lemma t]\n [\"Solve hole with case expression\" idris-case-dwim t]\n [\"Attempt to solve hole\" idris-proof-search t]\n [\"Get next solve attempt (Idris 2)\" idris-proof-search-next t]\n\n [\"Generate definition (Idris 2)\" idris-generate-def t]\n [\"Get next definition (Idris 2)\" idris-generate-def-next t]\n [\"Display type\" idris-type-at-point t]\n \"-----------------\"\n [\"Open package\" idris-open-package-file t]\n [\"Build package\" idris-ipkg-build t]\n [\"Install package\" idris-ipkg-install t]\n [\"Clean package\" idris-ipkg-clean t]\n \"-----------------\"\n [\"Get documentation\" idris-docs-at-point t]\n [\"Search for type\" idris-type-search t]\n [\"Apropos\" idris-apropos t]\n [\"Browse namespace\" idris-browse-namespace t]\n [\"Pretty-print to HTML or LaTeX\" idris-pretty-print t]\n \"-----------------\"\n (\"Interpreter options\" :active idris-process\n [\"Show implicits\" (idris-set-option :show-implicits t)\n :visible (not (idris-get-option :show-implicits))]\n [\"Hide implicits\" (idris-set-option :show-implicits nil)\n :visible (idris-get-option :show-implicits)]\n [\"Show error context\" (idris-set-option :error-context t)\n :visible (not (idris-get-option :error-context))]\n [\"Hide error context\" (idris-set-option :error-context nil)\n :visible (idris-get-option :error-context)])\n [\"Customize idris-mode\" (customize-group 'idris) t]\n [\"Customize fonts and colors\" (customize-group 'idris-faces) t]))\n\n\n;;;###autoload\n(define-derived-mode idris-mode prog-mode \"Idris\"\n \"Major mode for Idris\n \\\\{idris-mode-map}\nInvokes `idris-mode-hook'.\"\n :syntax-table idris-syntax-table\n :group 'idris\n (set (make-local-variable 'font-lock-defaults)\n (idris-font-lock-defaults))\n (set (make-local-variable 'indent-tabs-mode) nil)\n (set (make-local-variable 'comment-start) \"--\")\n\n (set (make-local-variable 'parse-sexp-lookup-properties) t)\n (set (make-local-variable 'syntax-propertize-function) 'idris-syntax-propertize-function)\n\n ;; REPL completion for Idris source\n (set (make-local-variable 'completion-at-point-functions)\n (list 'idris-complete-symbol-at-point\n 'idris-complete-keyword-at-point))\n\n ;; imenu support\n (set (make-local-variable 'imenu-case-fold-search) nil)\n (set (make-local-variable 'imenu-generic-expression)\n '((\"Data\" \"^\\\\s-*data\\\\s-+\\\\(\\\\sw+\\\\)\" 1)\n (\"Data\" \"^\\\\s-*record\\\\s-+\\\\(\\\\sw+\\\\)\" 1)\n (\"Data\" \"^\\\\s-*codata\\\\s-+\\\\(\\\\sw+\\\\)\" 1)\n (\"Postulates\" \"^\\\\s-*postulate\\\\s-+\\\\(\\\\sw+\\\\)\" 1)\n (\"Classes\" \"^\\\\s-*class\\\\s-+\\\\(\\\\sw+\\\\)\" 1)\n (nil \"^\\\\s-*\\\\(\\\\sw+\\\\)\\\\s-*:\" 1)\n (\"Namespaces\" \"^\\\\s-*namespace\\\\s-+\\\\(\\\\sw\\\\|\\\\.\\\\)\" 1)))\n\n ;; eldoc support\n (set (make-local-variable 'eldoc-documentation-function) 'idris-eldoc-lookup)\n\n ;; Filling of comments and docs\n (set (make-local-variable 'fill-paragraph-function) 'idris-fill-paragraph)\n ;; Make dirty if necessary\n (add-hook (make-local-variable 'after-change-functions) 'idris-possibly-make-dirty)\n (setq mode-name `(\"Idris\"\n (:eval (if idris-rex-continuations \"!\" \"\"))\n \" \"\n (:eval (if (idris-current-buffer-dirty-p)\n \"(Not loaded)\"\n \"(Loaded)\"))))\n ;; Extra hook for LIDR files (to set up extra highlighting, etc)\n (when (idris-lidr-p)\n (run-hooks 'idris-mode-lidr-hook))\n (set (make-local-variable 'prop-menu-item-functions)\n '(idris-context-menu-items idris-mode-context-menu-items))\n\n (add-hook 'xref-backend-functions #'idris-xref-backend nil 'local)\n ;; Support for xref-find-references\n (setq-local semantic-symref-filepattern-alist '((idris-mode \"*.idr\" \"*.lidr\"))))\n\n;; Automatically use idris-mode for .idr and .lidr files.\n;;;###autoload\n(push '(\"\\\\.idr$\" . idris-mode) auto-mode-alist)\n;;;###autoload\n(push '(\"\\\\.lidr$\" . idris-mode) auto-mode-alist)\n\n\n(provide 'idris-mode)\n;;; idris-mode.el ends here\n" }, { "path": "idris-navigate.el", "content": ";;; idris-navigate.el --- navigate in Idris code -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2020 Andreas Röhler\n\n;; Author: Andreas Röhler \n;; Keywords: convenience\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;;\n\n;;; Code:\n\n;;; Commentary:\n\n;; Provide a reliable jump to start and end of a top-level form - and some more\n;; subroutines.\n\n;; Key-setting working here:\n;; (define-key idris-mode-map [(control meta a)] 'idris-backward-toplevel)\n;; (define-key idris-mode-map [(control meta e)] 'idris-forward-toplevel)\n\n;; (define-key idris-mode-map [(meta p)] 'idris-backward-statement) ;; current indent upwards\n;; (define-key idris-mode-map [(meta n)] 'idris-forward-statement) ;; travels EOL downwards\n\n;; Tested with\n;; GNU Emacs 24.4.1 (i586-pc-linux-gnu, GTK+ Version 3.14.5)\n;; of 2017-09-12 on x86-csail-01, modified by Debian\n;;\n;; passed 1/4 idris-backard-statement-navigation-test-2pTac9\n;; passed 2/4 idris-backard-toplevel-navigation-test-2pTac9\n;; passed 3/4 idris-forward-statement-navigation-test-2pTac9\n;; passed 4/4 idris-forward-toplevel-navigation-test-2pTac9\n\n;; Ran 4 tests, 4 results as expected (2020-08-21 20:10:42+0200)\n\n;; Tests probably should go into another file\n\n;;; Code:\n\n(defvar idris-debug-p nil\n \"Switch to test-buffer when t.\")\n\n;; (setq idris-debug-p t)\n\n(defvar idris-verbose-p nil)\n\n(defvar idris-max-specpdl-size max-specpdl-size\n \"Protect against eternal loop.\")\n\n(defvar idris-literal-delim-re \"\\\"\"\n \"When looking at beginning of string.\")\n\n(defvar idris-expression-skip-chars \"^ (:=#\\t\\r\\n\\f\"\n \"idris-expression assumes chars indicated possible composing a idris-expression, skip it.\")\n(make-variable-buffer-local 'idris-expression-skip-chars)\n\n(defvar idris-assignment-regexp \"[ \\t]*=[^=]\"\n \"Matches assignment operator inclusive whitespaces around.\")\n\n(defvar idris-string-delim-re \"\\\\(\\\"\\\"\\\"\\\\|'''\\\\|\\\"\\\\|'\\\\)\"\n \"When looking at beginning of string.\")\n\n(defvar idris-expression-re \"[^ =#\\t\\r\\n\\f]+\"\n \"Ar-expression assumes chars indicated possible composing a idris-expression, when ‘looking-at’ or -back.\")\n(make-variable-buffer-local 'idris-expression-re)\n\n(defvar idris-delimiter-regexp \"\\\\(\\\\.[[:alnum:]]\\\\|,\\\\|;\\\\|:\\\\)[ \\t\\n]\"\n \"Delimiting elements of lists or other programming constructs.\")\n(make-variable-buffer-local 'idris-delimiter-regexp)\n\n(defvar idris-not-expression-regexp \"[ .=#\\t\\r\\n\\f)]+\"\n \"idris-expression assumes chars indicated probably will not compose a idris-expression.\")\n\n(defvar idris-not-expression-chars \" #\\t\\r\\n\\f\"\n \"idris-expression assumes chars indicated probably will not compose a idris-expression.\")\n\n(defvar idris-partial-expression-backward-chars \"^] .=,\\\"'()[{}:#\\t\\r\\n\\f\"\n \"idris-partial-expression assumes chars indicated possible composing a idris-partial-expression, skip it.\")\n;; (setq idris-partial-expression-backward-chars \"^] .=,\\\"'()[{}:#\\t\\r\\n\\f\")\n\n(defvar idris-partial-expression-forward-chars \"^ .\\\"')}]:#\\t\\r\\n\\f\")\n;; (setq idris-partial-expression-forward-chars \"^ .\\\"')}]:#\\t\\r\\n\\f\")\n\n(defvar idris-partial-expression-re\n (concat \"[\" idris-partial-expression-backward-chars (substring idris-partial-expression-forward-chars 1) \"]+\"))\n;; (setq idris-partial-expression-re (concat \"[\" idris-partial-expression-backward-chars \"]+\"))\n\n(defvar idris-expression-skip-regexp \"[^ (=:#\\t\\r\\n\\f]\"\n \"idris-expression assumes chars indicated possible composing a idris-expression, skip it.\")\n(make-variable-buffer-local 'idris-expression-skip-regexp)\n\n(defmacro idris--escaped-p ()\n \"Return t if char is preceded by an odd number of backslashes.\"\n `(save-excursion\n (< 0 (% (abs (skip-chars-backward \"\\\\\\\\\")) 2))))\n\n(defmacro idris--preceding-line-backslashed-p ()\n \"Return t if preceding line is a backslashed continuation line.\"\n `(save-excursion\n (beginning-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (and (eq (char-before (point)) ?\\\\ )\n (idris--escaped-p))))\n\n(defun idris-fix-comment-start ()\n \"Comment at point might not have a padding.\"\n (if (and comment-start (string-match \"[ \\t]$\" comment-start))\n (concat comment-start \"*\")\n comment-start))\n\n(defun idris--skip-to-semicolon-backward (&optional limit)\n \"Fetch the beginning of expression after a semicolon.\n\nReturns position reached if point was moved.\nOptional argument LIMIT limit.\"\n (let ((orig (point)))\n (and (< 0 (abs\n (skip-chars-backward \"^;\" (or limit (line-beginning-position)))))\n (skip-chars-forward \" \\t\" (line-end-position))\n (and (< (point) orig) (point)))))\n\n(defmacro idris--current-line-backslashed-p ()\n \"Return t if current line is a backslashed continuation line.\"\n `(save-excursion\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (and (eq (char-before (point)) ?\\\\ )\n (idris--escaped-p))))\n\n;;; string-strip stuff ends here\n(defcustom empty-line-p-chars \"^[ \\t\\r]*$\"\n \"Empty-line-p-chars.\"\n :type 'regexp\n :group 'convenience)\n(unless (functionp 'empty-line-p)\n (defalias 'empty-line-p 'idris-empty-line-p))\n\n(defun idris-empty-line-p (&optional iact)\n \"Return t if cursor is at an empty line, nil otherwise.\nOptional argument IACT saying interactively called.\"\n (interactive \"p\")\n (save-excursion\n (beginning-of-line)\n (when iact\n (message \"%s\" (looking-at empty-line-p-chars)))\n (looking-at empty-line-p-chars)))\n\n(defun idris-in-comment-p (&optional start)\n \"Return the beginning of current line's comment, if inside.\nOptional argument START start.\"\n (interactive)\n (let* ((pps (parse-partial-sexp (or start (point-min)) (point)))\n (erg (and (nth 4 pps) (nth 8 pps))))\n (unless (or erg (nth 3 pps))\n (when (or (eq (car (syntax-after (point))) 11)\n (ignore-errors (looking-at comment-start)))\n (setq erg (point))))\n erg))\n\n(defun idris-backward-comment (&optional pos)\n \"Got to beginning of a commented section.\nOptional argument POS start.\"\n (interactive)\n (let ((erg pos)\n last)\n (when erg (goto-char erg))\n (while (and (not (bobp)) (setq erg (idris-in-comment-p)))\n (when (< erg (point))\n (goto-char erg)\n (setq last (point)))\n (skip-chars-backward \" \\t\\r\\n\\f\"))\n (when last (goto-char last))\n last))\n\n(defun idris-forward-comment (&optional pos char)\n \"Go to end of (next) commented section following point.\n\nOptional args position and ‘comment-start’ character\nTravel empty lines\nOptional argument POS orig.\nOptional argument CHAR comment start.\"\n (interactive)\n (let ((orig (or pos (point)))\n (char (or char (string-to-char comment-start)))\n last)\n (unless (idris-in-comment-p)\n (search-forward comment-start nil t 1))\n (while (and (not (eobp))\n (forward-comment 99999)))\n (when (eq (point) orig)\n ;; forward-comment fails sometimes\n (while\n (and (not (eobp)) (or (idris-in-comment-p)(eq (point) orig)))\n (setq last (line-end-position))\n (forward-line 1)\n (end-of-line)\n ;; (setq orig (point))\n ))\n (and (eq orig (point)) (prog1 (forward-line 1) (back-to-indentation))\n (while (member (char-after) (list char 10))(forward-line 1)(back-to-indentation)))\n ;; go\n (when last\n (goto-char last)\n (skip-chars-forward \" \\t\\r\\n\\f\")\n (back-to-indentation))\n (unless (eq (point) orig)\n (point))))\n\n;; Navigate\n(defun idris-skip-blanks-and-comments (&optional arg pps orig)\n \"Go forward over empty lines and comments alike.\n\nStop at first non-empty char.\nWith negative arg go backward. \"\n (interactive)\n (let ((arg (or arg 1))\n (pos (point))\n (orig (or orig (point)))\n (pps (or pps (parse-partial-sexp (point-min) (point)))))\n (if (< 0 arg)\n (progn\n (skip-chars-forward \" \\t\\r\\n\")\n (when (or (and pps (nth 4 pps))(idris-in-comment-p))\n (end-of-line)\n (skip-chars-forward \" \\t\\r\\n\\f\"))\n (when (empty-line-p)\n (forward-line arg))\n (when (> (point) pos)\n (idris-skip-blanks-and-comments arg nil orig))\n (< orig (point)))\n (skip-chars-backward \" \\t\\r\\n\")\n (when (or (and pps (nth 4 pps))(idris-in-comment-p))\n (goto-char (or (and pps (nth 4 pps))(nth 8 pps))))\n (> orig (point)))))\n\n(defun idris-in-string-p ()\n \"Return start position, if inside or at opening delimiter.\n\nOtherwise return nil.\"\n (interactive)\n (let* ((pps (parse-partial-sexp (point-min) (point)))\n (erg (and (nth 3 pps) (nth 8 pps)))\n (la (unless (or erg (eobp))\n (and (eq (char-syntax (char-after)) 34)\n ;; look for closing char\n (save-excursion\n (forward-char 1)\n (nth 3 (parse-partial-sexp (point-min) (point))))\n (point)))))\n (when (called-interactively-p 'interactive) (message \"%s\" (or erg la)))\n (or erg la)))\n\n;; Expression\n(defun idris-backward-expression ()\n \"Go to the beginning of a compound expression.\n\nA a compound expression might be concatenated,\nthus composed by minor expressions.\n\nIf already at the beginning or before a expression,\ngo to next expression in buffer upwards\"\n (interactive)\n (let (erg)\n (setq erg (idris--beginning-of-expression-intern))\n (when (and idris-verbose-p (called-interactively-p 'interactive)) (message \"%s\" erg))\n erg))\n\n(defun idris--beginning-of-expression-intern (&optional orig)\n (unless (bobp)\n (let ((orig (or orig (point)))\n (pps (syntax-ppss))\n erg)\n (cond\n ( ;; (empty-line-p)\n (eq 9 (char-after))\n (while\n (and ;; (empty-line-p)\n (eq 9 (char-after))(not (bobp)))\n (forward-line -1)\n (end-of-line))\n (idris--beginning-of-expression-intern orig))\n ;; lists\n ((nth 1 pps)\n (goto-char (nth 1 pps))\n (skip-chars-backward idris-expression-skip-chars))\n ((and (nth 3 pps)(nth 8 pps)\n (goto-char (nth 8 pps)))\n (cond (;; consider expression a string starting at BOL\n (bolp))\n ((looking-back idris-assignment-regexp (line-beginning-position)))\n ((looking-back idris-operator-regexp (line-beginning-position))\n (when (nth 2 pps)\n (goto-char (nth 2 pps))))\n (t (idris--beginning-of-expression-intern orig))))\n ;; comments left\n ((nth 8 pps)\n (goto-char (nth 8 pps))\n (unless (bobp)\n (idris--beginning-of-expression-intern orig)))\n ;; concatenated strings\n ((looking-back (concat idris-string-delim-re idris-expression-re idris-string-delim-re idris-operator-regexp idris-string-delim-re idris-expression-re idris-string-delim-re) (line-beginning-position))\n (goto-char (match-beginning 0))\n (while (looking-back (concat idris-string-delim-re idris-expression-re idris-string-delim-re idris-operator-regexp) (line-beginning-position) t)\n (goto-char (match-beginning 0)))\n (skip-chars-backward idris-expression-skip-chars))\n ;; before comment\n ((and (looking-at \"[ \\t]*#\") (looking-back \"^[ \\t]*\" (line-beginning-position)))\n (forward-line -1)\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (unless (bobp)\n (forward-char -1)\n (idris--beginning-of-expression-intern orig)))\n ((and (< (point) orig)(looking-at (concat idris-expression-re idris-delimiter-regexp))))\n ((looking-back (concat \"[^ \\t\\n\\r\\f]+\" idris-delimiter-regexp) (line-beginning-position))\n (goto-char (match-beginning 0))\n (skip-chars-backward idris-expression-skip-chars)\n (unless (or (looking-back idris-assignment-regexp (line-beginning-position)) (looking-back \"^[ \\t]*\" (line-beginning-position)))\n (idris--beginning-of-expression-intern orig)))\n ;; before assignment\n ((looking-back idris-assignment-regexp (line-beginning-position))\n (goto-char (1- (match-beginning 0)))\n (forward-char -1)\n (idris--beginning-of-expression-intern orig))\n ((looking-back idris-operator-regexp (line-beginning-position))\n (goto-char (1- (match-beginning 0)))\n (forward-char -1)\n (unless (< 0 (abs (skip-chars-backward idris-expression-skip-chars)))\n (idris--beginning-of-expression-intern orig)))\n ((looking-back \"\\\"\\\\|'\" (line-beginning-position))\n (forward-char -1)\n (skip-chars-backward \"\\\"'\")\n (unless (looking-back idris-assignment-regexp (line-beginning-position))\n (idris--beginning-of-expression-intern orig)))\n ((looking-back \"(\\\\|\\\\[\" (line-beginning-position))\n (forward-char -1)\n (unless (looking-back idris-assignment-regexp (line-beginning-position))\n (idris--beginning-of-expression-intern orig)))\n ((looking-back \"[\\])}]\" (line-beginning-position))\n (forward-char -1)\n (unless (looking-back idris-assignment-regexp (line-beginning-position))\n (idris--beginning-of-expression-intern orig)))\n ;; inside expression\n ((looking-back idris-expression-re (line-beginning-position))\n (skip-chars-backward idris-expression-skip-chars)\n (unless (or (looking-back \"^[ \\t]*\" (line-beginning-position)) (looking-back idris-assignment-regexp (line-beginning-position)))\n (idris--beginning-of-expression-intern orig)))\n ((looking-back (concat \"[ \\t]*\" \"[[:alnum:]_]*\" idris-operator-regexp \"[[:alnum:]_]*\") (line-beginning-position) t)\n (goto-char (match-beginning 0))\n (unless (looking-back \"^[ \\t]*\" (line-beginning-position))\n (idris--beginning-of-expression-intern orig)))\n ((and (eq (point) orig) (looking-back \"[ \\t\\r\\n\\f]\" (line-beginning-position)))\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (unless (bobp)\n (forward-char -1)\n (idris--beginning-of-expression-intern orig)))\n ((and (eq (point) orig) (not (bobp)) (looking-back idris-expression-re (line-beginning-position)))\n (forward-char -1)\n (when (< 0 (abs (skip-chars-backward idris-expression-skip-chars)))\n (idris--beginning-of-expression-intern orig)))\n ((and (looking-at idris-expression-re) (not (looking-back \"[ \\t\\r\\n\\f]\" (line-beginning-position))))\n (unless (< 0 (abs (skip-chars-backward idris-expression-skip-chars)))\n (idris--beginning-of-expression-intern orig)))\n ((and (eq (point) orig)(looking-back \"[ \\t]*=\" (line-beginning-position)))\n (goto-char (match-beginning 0))\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (idris--beginning-of-expression-intern orig)))\n (unless (or (eq (point) orig)(looking-at \"[ \\t]*#\"))\n (setq erg (point)))\n erg)))\n\n(defun idris-forward-expression (&optional orig done repeat pps)\n \"Go to the end of a compound expression.\n\nOperators are ignored.\nOptional argument ORIG Position.\nOptional argument DONE status.\nOptional argument REPEAT counter.\nOptional argument PPS result of ‘parse-partial-sexp’.\"\n (interactive)\n (unless done (skip-chars-forward \" \\t\\r\\n\\f\"))\n (unless (eobp)\n (let ((comment-start (idris-fix-comment-start))\n (repeat (or (and repeat (1+ repeat)) 0))\n (pps (or pps (parse-partial-sexp (point-min) (point))))\n (orig (or orig (point)))\n erg)\n (if (< idris-max-specpdl-size repeat)\n (error \"`idris-forward-expression' reached loops max\")\n (cond\n ;; in comment\n ((nth 4 pps)\n (or (< (point) (progn (forward-comment 1)(point)))(forward-line 1))\n (idris-forward-expression orig done repeat))\n ;; empty before comment\n ((and comment-start (looking-at (concat \"[ \\t]*\" comment-start))(looking-back \"^[ \\t]*\" (line-beginning-position)))\n (while (and (looking-at (concat \"[ \\t]*\" comment-start)) (not (eobp)))\n (forward-line 1))\n (idris-forward-expression orig done repeat))\n ;; inside string\n ((nth 3 pps)\n (goto-char (nth 8 pps))\n (goto-char (scan-sexps (point) 1))\n (setq done t)\n (idris-forward-expression orig done repeat))\n ((looking-at \"\\\"\\\"\\\"\\\\|'''\\\\|\\\"\\\\|'\")\n (goto-char (scan-sexps (point) 1))\n (setq done t)\n (idris-forward-expression orig done repeat))\n ((nth 1 pps)\n (goto-char (nth 1 pps))\n (goto-char (scan-sexps (point) 1))\n (setq done t)\n (idris-forward-expression orig done repeat))\n ;; looking at opening delimiter\n ((eq 4 (car-safe (syntax-after (point))))\n (goto-char (scan-sexps (point) 1))\n (setq done t)\n (idris-forward-expression orig done repeat))\n ((and (eq orig (point)) (looking-at idris-operator-regexp))\n (goto-char (match-end 0))\n (idris-forward-expression orig done repeat))\n ((and (not done)\n (< 0 (skip-chars-forward idris-expression-skip-chars)))\n (setq done t)\n (idris-forward-expression orig done repeat))\n ;; at colon following arglist\n ((looking-at \":[ \\t]*$\")\n (forward-char 1)))\n (unless (or (eq (point) orig)(and (eobp)(bolp)))\n (setq erg (point)))\n (when (and idris-verbose-p (called-interactively-p 'any)) (message \"%s\" erg))\n erg))))\n\n(defun idris-down-expression ()\n \"Go to the beginning of next expression downwards in buffer.\n\nReturn position if expression found, nil otherwise.\"\n (interactive)\n (let* ((orig (point))\n (erg\n (cond ((idris--end-of-expression-p)\n (and (idris-forward-expression) (idris-backward-expression)))\n ((ignore-errors (< orig (progn (idris-forward-expression) (idris-backward-expression))))\n (point))\n (t (goto-char orig) (and (idris-forward-expression) (idris-forward-expression)(idris-backward-expression))))))\n (when (and idris-verbose-p (called-interactively-p 'interactive)) (message \"%s\" erg))\n erg))\n\n;; (defun idris--end-of-expression-intern (&optional orig)\n;; (unless (eobp)\n;; (let* ((orig (or orig (point)))\n;; (pps (syntax-ppss))\n;; erg\n;; ;; use by scan-lists\n;; parse-sexp-ignore-comments)\n;; (cond\n;; ((nth 1 pps)\n;; (goto-char (nth 1 pps))\n;; (let ((parse-sexp-ignore-comments t))\n;; (forward-list))\n;; (unless (or (looking-at \"[ \\t]*$\")(looking-at idris-assignment-regexp))\n;; (idris--end-of-expression-intern orig)))\n;; ;; in comment\n;; ((nth 4 pps)\n;; (or (< (point) (progn (forward-comment 1)(point)))(forward-line 1))\n;; (idris--end-of-expression-intern orig))\n;; ( ;; (empty-line-p)\n;; (eq 9 (char-after))\n;; (while\n;; (and ;; (empty-line-p)\n;; (eq 9 (char-after))(not (eobp)))\n;; (forward-line 1))\n;; (idris--end-of-expression-intern orig))\n;; ((looking-at (concat idris-string-delim-re idris-expression-re idris-string-delim-re idris-operator-regexp idris-string-delim-re idris-expression-re idris-string-delim-re))\n;; (goto-char (match-end 0))\n;; (while (looking-at (concat idris-operator-regexp idris-string-delim-re idris-expression-re idris-string-delim-re))\n;; (goto-char (match-end 0))))\n;; ;; inside string\n;; ((idris-in-string-p)\n;; (when (looking-at \"\\\"\\\"\\\"\\\\|'''\\\\|\\\"\\\\|'\")\n;; (goto-char (match-end 0)))\n;; (while\n;; (nth 3 (syntax-ppss))\n;; (forward-char 1))\n;; (unless (looking-at \"[ \\t]*$\")\n;; (idris--end-of-expression-intern orig)))\n;; ((looking-at \"[(\\[]\")\n;; (forward-list)\n;; (unless (looking-at \"[ \\t]*$\")\n;; (idris--end-of-expression-intern orig)))\n;; ((and (looking-at \"[ \\t]*#\")(looking-back \"^[ \\t]*\" (line-beginning-position)))\n;; (while (and (looking-at \"[ \\t]*#\") (not (eobp)))\n;; (forward-line 1))\n;; (idris--end-of-expression-intern orig))\n;; ((and (eq orig (point)) (looking-at idris-assignment-regexp))\n;; (goto-char (match-end 0))\n;; (if (looking-at \"[(\\[]\")\n;; (forward-list 1)\n;; (idris--end-of-expression-intern orig)))\n;; ((looking-at (concat \"[^ \\t\\n\\r\\f]*\" idris-delimiter-regexp))\n;; (goto-char (match-end 0))\n;; (while (looking-at (concat \"[^ \\t\\n\\r\\f]*\" idris-delimiter-regexp))\n;; (goto-char (match-end 0)))\n;; (forward-char -1)\n;; (unless (looking-at (concat idris-assignment-regexp \"\\\\|[ \\t]*$\\\\|\" idris-delimiter-regexp))\n;; (idris--end-of-expression-intern orig)))\n;; ((looking-at (concat \"\\\\([[:alnum:] ]+ \\\\)\" idris-assignment-regexp))\n;; (goto-char (match-end 1))\n;; (skip-chars-backward \" \\t\\r\\n\\f\"))\n;; ((and (eq orig (point)) (looking-at (concat \"[ \\t]*\" \"[^(\\t\\n\\r\\f]+\" idris-operator-regexp)))\n;; (skip-chars-forward \" \\t\\r\\n\\f\")\n;; (when (< 0 (skip-chars-forward idris-expression-skip-chars))\n;; (idris--end-of-expression-intern orig)))\n;; ((and (eq orig (point)) (looking-at idris-not-expression-regexp))\n;; (skip-chars-forward idris-not-expression-chars)\n;; (unless (or (looking-at \"[ \\t]*$\")(looking-at idris-assignment-regexp))\n;; (idris--end-of-expression-intern orig)))\n;; ((looking-at idris-expression-skip-regexp)\n;; (skip-chars-forward idris-expression-skip-chars)\n;; (unless (or (looking-at \"[ \\n\\t\\r\\f]*$\")(looking-at idris-assignment-regexp))\n;; (idris--end-of-expression-intern orig)))\n;; ((and (eq (point) orig)\n;; (skip-chars-forward \" \\t\\r\\n\\f\")\n;; (< 0 (skip-chars-forward idris-expression-skip-chars)))\n;; (idris--end-of-expression-intern orig)))\n\n;; (unless (or (eq (point) orig)(and (eobp)(bolp)))\n;; (setq erg (point)))\n;; erg)))\n\n(defun idris-backward-partial-expression (&optional orig)\n \"Go to the beginning of a partial expression.\nOptional argument ORIG Position.\"\n (interactive)\n (let (erg)\n (and (< 0 (abs (skip-chars-backward \" \\t\\r\\n\\f\")))(not (bobp))(forward-char -1))\n (when (idris-in-comment-p)\n (idris-backward-comment)\n (skip-chars-backward \" \\t\\r\\n\\f\"))\n ;; part of idris-partial-expression-forward-chars\n (when (member (char-after) (list ?\\ ?\\\" ?' ?\\) ?} ?\\] ?: ?#))\n (forward-char -1))\n (skip-chars-backward idris-partial-expression-forward-chars)\n (when (< 0 (abs (skip-chars-backward idris-partial-expression-backward-chars)))\n (while (and (not (bobp)) (idris-in-comment-p)(< 0 (abs (skip-chars-backward idris-partial-expression-backward-chars))))))\n (when (< (point) orig)\n (unless\n (and (bobp) (member (char-after) (list ?\\ ?\\t ?\\r ?\\n ?\\f)))\n (setq erg (point))))\n (when (called-interactively-p 'interactive) (message \"%s\" erg))\n erg))\n\n(defun idris-forward-of-partial-expression ()\n \"Go to the end of a partial expression.\nOptional argument ORIG Position.\"\n (interactive)\n (let (erg)\n (skip-chars-forward idris-partial-expression-backward-chars)\n ;; group arg\n (and\n (looking-at \"[\\[{(]\")\n (goto-char (scan-sexps (point) 1)))\n (setq erg (point))\n (when (called-interactively-p 'interactive) (message \"%s\" erg))\n erg))\n\n(defun idris--beginning-of-expression-p (orig pps)\n \"Return position, if cursor is at the beginning of a `expression'.\n\nReturn nil otherwise.\nArgument ORIG Position.\nArgument PPS result of ‘parse-partial-sexp’.\"\n (let (erg)\n (or (and pps (setq erg (eq 0 (nth 0 pps))))\n (save-excursion\n (unless (and (eolp)(bolp))\n (idris-forward-statement)\n (idris-backward-statement))\n (when (eq orig (point))\n (setq erg orig))\n erg))))\n\n(defun idris--end-of-expression-p ()\n \"Return position, if cursor is at the end of a expression, nil otherwise.\"\n (let ((orig (point))\n erg)\n (save-excursion\n (idris-backward-statement)\n (idris-forward-statement)\n (when (eq orig (point))\n (setq erg orig))\n erg)))\n\n(defvar toplevel-nostart-chars (list ?-))\n\n(defun idris-backward-toplevel (&optional arg)\n \"Go to the beginning of a toplevel form.\n\nReturns position if successful, nil otherwise\nOptional argument ARG times\"\n (interactive \"p\")\n (unless (bobp)\n ;; (forward-line -1)\n ;; (beginning-of-line)\n (let* ((arg (or arg 1))\n (orig (point))\n (pps (parse-partial-sexp (point-min) (point)))\n ;; set ppss start point\n (limit (or (nth 8 pps) (point-min)))\n (comment-start (idris-fix-comment-start))\n erg this)\n ;; (unless (bobp)\n (while (and\n (prog1 (re-search-backward \"^[^ \\t\\n\\f\\r]\" nil 'move arg)\n (beginning-of-line))\n (or (ignore-errors (looking-at comment-start))(ignore-errors (looking-at comment-start-skip))\n (and (setq this (save-excursion (ignore-errors (nth 8 (parse-partial-sexp limit (point))))))\n (setq limit this))\n (member (char-after) toplevel-nostart-chars)))\n (forward-line -1)\n (beginning-of-line))\n (when (< (point) orig)\n (setq erg (point))\n (when (called-interactively-p 'interactive) (message \"%s\" erg)))\n erg)))\n\n(defun idris--forward-toplevel-intern (orig pps)\n (let (last)\n (unless (idris--beginning-of-expression-p orig pps)\n (idris-backward-expression))\n (unless (eq 0 (current-column))\n (idris-backward-toplevel))\n (unless (< orig (point))\n (while (and\n (not (eobp))\n (save-excursion\n (idris-forward-expression orig nil nil pps)\n (setq last (point)))\n (idris-down-expression)(< 0 (current-indentation)))))\n (and last (goto-char last))\n ))\n\n(defun idris-end-of-string (&optional beginning-of-string-position)\n \"Go to end of string at point if any, if successful return position.\nOptional argument BEGINNING-OF-STRING-POSITION Position.\"\n (interactive)\n ;; (when idris-debug-p (message \"(current-buffer): %s\" (current-buffer)))\n ;; (when idris-debug-p (message \"major-mode): %s\" major-mode))\n (let ((orig (point))\n (beginning-of-string-position (or beginning-of-string-position (and (nth 3 (parse-partial-sexp 1 (point)))(nth 8 (parse-partial-sexp 1 (point))))\n (and (looking-at \"\\\"\\\"\\\"\\\\|'''\\\\|\\\"\\\\|\\'\")(match-beginning 0))))\n erg)\n (if beginning-of-string-position\n (progn\n (goto-char beginning-of-string-position)\n (when\n ;; work around parse-partial-sexp error\n (and (nth 3 (parse-partial-sexp 1 (point)))(nth 8 (parse-partial-sexp 1 (point))))\n (goto-char (nth 3 (parse-partial-sexp 1 (point)))))\n (if (ignore-errors (setq erg (scan-sexps (point) 1)))\n (goto-char erg)\n (goto-char orig)))\n\n (error (concat \"idris-end-of-string: don't see end-of-string at \" (buffer-name (current-buffer)) \"at pos \" (point))))\n (when (and idris-verbose-p (called-interactively-p 'any)) (message \"%s\" erg))\n erg))\n\n(defun idris-forward-toplevel (&optional arg)\n \"Go to end of a toplevel form.\n\nReturns position if successful, nil otherwise\nOptional argument ARG times.\"\n (interactive \"p\")\n (unless (eobp)\n (let* ((arg (or arg 1))\n (orig (point))\n (pps (parse-partial-sexp (point-min) (point)))\n ;; set ppss start point\n (limit (or (nth 8 pps) (point-min)))\n (comment-start (idris-fix-comment-start))\n erg this)\n (idris-skip-blanks-and-comments)\n (while\n (and\n (progn (end-of-line)\n (setq erg (re-search-forward \"^[^ \\t\\n\\f\\r]\" nil 'move arg)))\n (or\n (progn\n (beginning-of-line)\n (nth 8 (parse-partial-sexp (point-min) (point))))\n (ignore-errors (when\n (looking-at comment-start)\n (forward-line 1)\n t))\n (ignore-errors (when (looking-at comment-start-skip)\n (forward-line 1)\n t))\n (and (setq this (ignore-errors (nth 8 (parse-partial-sexp limit (point)))))\n (setq limit this)))))\n (when erg\n (beginning-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (forward-line 1) (beginning-of-line))\n (when (< orig (point))\n (setq erg (point))\n (when (and idris-verbose-p (called-interactively-p 'interactive)) (message \"%s\" erg)))\n erg)))\n\n(defun idris-forward-toplevel-bol ()\n \"Go to beginning of line after end of a toplevel form.\n\nReturns position if successful, nil otherwise\"\n (interactive)\n (let ((orig (point))\n erg)\n (unless (eobp)\n (when (idris--forward-toplevel-intern orig (parse-partial-sexp (point-min) (point)))\n (if (eobp)\n (newline 1)\n (forward-line 1)\n (beginning-of-line)))\n (when (< orig (point))\n (setq erg (point))))\n (when (and idris-verbose-p (called-interactively-p 'interactive)) (message \"%s\" erg))\n erg))\n\n(defun idris-backward-statement (&optional orig done limit)\n \"Go to the initial line of a simple expression.\nOptional argument ORIG Position.\nOptional argument DONE status.\nOptional argument LIMIT limit.\"\n (interactive)\n (save-restriction\n (unless (bobp)\n (let* ((orig (or orig (point)))\n (this (point))\n (pps (progn (goto-char this)\n (parse-partial-sexp (or limit (point-min))(point))))\n (done done)\n erg)\n (unless done\n (and (< 0 (abs (skip-chars-backward \" \\t\\r\\n\\f\")))\n (setq pps (parse-partial-sexp (or limit (point-min))(point)))))\n (cond\n ((and (bolp)(eolp))\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (idris-backward-statement orig done limit))\n ((nth 8 pps)\n ;; inside string\n (and (nth 3 pps) (setq done t))\n (goto-char (nth 8 pps))\n (idris-backward-statement orig done limit))\n ((idris--preceding-line-backslashed-p)\n (forward-line -1)\n (back-to-indentation)\n (setq done t)\n (idris-backward-statement orig done limit))\n ;; BOL or at space before comment\n ((and (looking-at \"[ \\t]*#\")(looking-back \"^[ \\t]*\" (line-beginning-position)))\n (forward-comment -1)\n (while (and (not (bobp))\n (looking-at \"[ \\t]*#\")(looking-back \"^[ \\t]*\" (line-beginning-position)))\n (forward-comment -1))\n (unless (bobp)\n (idris-backward-statement orig done limit)))\n ;; at inline comment\n ((looking-at \"[ \\t]*#\")\n (when (idris--skip-to-semicolon-backward\n (save-excursion (back-to-indentation)(point)))\n (skip-chars-forward \" \\t\")\n (unless (bobp)\n (idris-backward-statement orig done limit))))\n ;; at beginning of string\n ((and (not done) (looking-at idris-literal-delim-re))\n (when (< 0 (abs (skip-chars-backward \" \\t\\r\\n\\f\")))\n (setq done t))\n (back-to-indentation)\n (idris-backward-statement orig done limit))\n ;; after end of expression\n ;; ((and (not done) (eq (char-before) ?\\;))\n ;; (skip-chars-backward \";\")\n ;; (idris-backward-statement orig done limit))\n ;; at current indent\n ((and (not done) (not (eq 0 (skip-chars-backward \" \\t\\r\\n\\f\"))))\n (idris-backward-statement orig done limit))\n ((and (member (char-after) (list ?\\\" ?\\'))\n (progn (back-to-indentation) (eq ?@ (char-after))))\n (back-to-indentation)\n (when (< (point) orig) (setq done t))\n (idris-backward-statement orig done limit))\n ((eq orig (point))\n (back-to-indentation)\n (when (< (point) orig)(setq done t))\n (idris-backward-statement orig done limit))\n )\n ;; return nil when before comment\n (unless (eq (current-indentation) (current-column))\n (back-to-indentation)\n (setq done t)\n (idris-backward-statement orig done limit))\n (unless (and (looking-at \"[ \\t]*#\") (looking-back \"^[ \\t]*\" (line-beginning-position)))\n (when (< (point) orig)(setq erg (point))))\n (when (and idris-verbose-p (called-interactively-p 'interactive)) (message \"%s\" erg))\n erg))))\n\n(defun idris-forward-statement (&optional orig done repeat)\n \"Go to the last char of current statement.\n\nOptional argument REPEAT, the number of loops DONE already,\nis checked for ‘idris-max-specpdl-size’ error.\nAvoid eternal loops due to missing string delimters etc.\nOptional argument ORIG Position.\"\n (interactive)\n (unless (eobp)\n (let ((repeat (or (and repeat (1+ repeat)) 0))\n (orig (or orig (point)))\n erg\n ;; use by scan-lists\n parse-sexp-ignore-comments\n forward-sexp-function\n pps err)\n (setq pps (parse-partial-sexp (point-min) (point)))\n (cond\n ((< idris-max-specpdl-size repeat)\n (error \"Ar-forward-statement reached loops max.\nIf no error, customize `idris-max-specpdl-size'\"))\n ;; string\n ((or (nth 3 pps)(eq (char-syntax (char-after)) 34))\n (when (idris-end-of-string)\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (setq pps (parse-partial-sexp (point-min) (point)))\n (unless (and done\n (not (or (nth 1 pps) (nth 8 pps)))\n (eolp))\n (idris-forward-statement orig done repeat))))\n ;; in comment\n ((or (nth 4 pps)(eq (char-syntax (char-after)) ?<))\n (idris-forward-comment)\n (idris-forward-statement orig done repeat))\n ((idris--current-line-backslashed-p)\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\" (line-beginning-position))\n (while (and (eq (char-before (point)) ?\\\\ )\n (idris--escaped-p))\n (forward-line 1)\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\" (line-beginning-position)))\n (unless (eobp)\n (idris-forward-statement orig done repeat)))\n ((eq orig (point))\n (or (and\n (< 0 (abs (skip-chars-forward (concat \" \\t\\r\\n\\f'\\\"\" comment-start))))\n (eolp) (setq done t))\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f$\"))\n (idris-forward-statement orig done repeat))\n ((eq (current-indentation) (current-column))\n (end-of-line)\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (setq done t)\n (idris-forward-statement orig done repeat))\n ;; list\n ((nth 1 pps)\n (unless done\n (goto-char (nth 1 pps))\n (ignore-errors (forward-sexp))\n (setq done t)\n (idris-forward-statement orig done repeat))))\n (unless\n (or\n (eq (point) orig)\n (member (char-before) (list 10 32 9)))\n (setq erg (point)))\n (if (and idris-verbose-p err)\n (message \"%s\" err)\n (and idris-verbose-p (called-interactively-p 'interactive) (message \"%s\" erg)))\n erg)))\n\n(provide 'idris-navigate)\n;;; idris-navigate.el ends here\n" }, { "path": "idris-prover.el", "content": ";;; idris-prover.el --- Prover mode for Idris -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013-2014, Hannes Mehnert and David Raymond Christiansen\n;; Author: Hannes Mehnert , David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n(require 'idris-core)\n(require 'idris-common-utils)\n(require 'idris-warnings)\n(require 'idris-settings)\n(require 'inferior-idris)\n\n(eval-when-compile (require 'cl-lib))\n\n; consisting of three buffers:\n; ------------------------------\n; | proof obligations |\n; |----------------------------|\n; | proof shell | proof script |\n; ------------------------------\n\n(defgroup idris-prover nil \"Idris Prover.\" :prefix 'idris :group 'idris)\n\n(defface idris-prover-processed-face\n '((t (:background \"PaleGreen1\")))\n \"Face for Idris proof script which is already processed.\"\n :group 'idris-faces)\n\n(defface idris-prover-processing-face\n '((t (:background \"gold\")))\n \"Face for Idris proof script which is currently processing.\"\n :group 'idris-faces)\n\n(defcustom idris-prover-restore-window-configuration t\n \"When non-nil, restore the window configuration after exiting the prover.\"\n :type 'boolean\n :group 'idris-prover)\n\n(defvar idris-prover-obligations-buffer-name (idris-buffer-name :proof-obligations)\n \"The name of the Idris proof obligation buffer.\")\n\n(defvar idris-prover-shell-buffer-name (idris-buffer-name :proof-shell)\n \"The name of the Idris proof shell buffer.\")\n\n(defvar idris-prover-script-buffer-name (idris-buffer-name :proof-script)\n \"The name of the Idris proof script buffer.\")\n\n(defvar idris-prover-currently-proving nil\n \"The hole that Idris has open in the interactive prover.\nNil if Idris is not proving anything.\")\n\n(defconst idris-prover-error-message-prefix \"Prover error: \"\n \"A prefix to show on minibuffer error messages that originate in the prover.\")\n\n(defun idris-prover-obligations-buffer ()\n (or (get-buffer idris-prover-obligations-buffer-name)\n (let ((buffer (get-buffer-create idris-prover-obligations-buffer-name)))\n (with-current-buffer buffer\n (setq buffer-read-only t))\n buffer)))\n\n(defun idris-prover-show-obligations ()\n (display-buffer (idris-prover-obligations-buffer)\n '(display-buffer-pop-up-window . nil)))\n\n(defun idris-prover-write-goals (goals)\n \"Write GOALS to the goal buffer.\nIf GOALS is a string, it is treated as undecorated text.\nOtherwise, it must be a two-element list whose car is a goal\nstring and whose cadr is highlighting information.\"\n (with-current-buffer (idris-prover-obligations-buffer)\n (let ((buffer-read-only nil))\n (erase-buffer)\n (when idris-show-help-text\n (setq header-line-format\n \"This is a read-only view of your proof state. Prove the lemma in the script buffer.\"))\n (let ((goals-string (car goals))\n (goals-spans (cadr goals)))\n (idris-propertize-spans (idris-repl-semantic-text-props goals-spans)\n (insert goals-string)))))\n (idris-prover-show-obligations))\n\n(defvar idris-prover-saved-window-configuration nil\n \"The saved window configuration from before running the prover.\")\n\n(defvar-local idris-prover-script-processed nil\n \"Marker for the processed part of proof script.\")\n\n(defvar-local idris-prover-script-processed-overlay nil\n \"Overlay for processed proof script.\")\n\n(defvar-local idris-prover-script-processing nil\n \"Marker for the processing part of proof script.\")\n\n(defvar-local idris-prover-script-processing-overlay nil\n \"Overlay for processing proof script.\")\n\n(defvar-local idris-prover-script-warning-overlay nil\n \"Overlay for warning in proof script.\")\n\n; invariant: point-min <= idris-prover-script-processed <= idris-prover-script-processing <= point-max\n\n(defvar-local idris-prover-prove-step 0\n \"Step counter of the proof.\")\n\n(defvar idris-prover-script-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"RET\") 'idris-prover-script-ret)\n (define-key map (kbd \"M-n\") 'idris-prover-script-forward)\n (define-key map (kbd \"M-p\") 'idris-prover-script-backward)\n (define-key map (kbd \"C-c C-q\") 'idris-prover-script-qed)\n (define-key map (kbd \"C-c C-k\") 'idris-prover-abandon)\n ;; Using (kbd \"\") in place of \"\\t\" makes emacs angry, and suggests\n ;; using the latter form.\n (define-key map \"\\t\" 'completion-at-point)\n map)\n \"Keymap used in Idris proof script mode.\")\n\n\n(defun idris-prover-complete ()\n \"Completion of the current input.\"\n (let* ((start (line-beginning-position))\n (input (buffer-substring-no-properties\n start\n (point)))\n (result (idris-eval `(:repl-completions ,input))))\n (cl-destructuring-bind (completions _partial) (car result)\n (if (null completions)\n nil\n (list start (point) completions)))))\n\n(defun idris-prover-find-tactic (start-pos)\n \"Use layout heuristics to find the tactic beginning at START-POS.\nReturn a pair consisting of the start and end positions of the tactic.\nTactics are required to begin at the left margin.\"\n (let (tactic-start tactic-end)\n (save-excursion\n (goto-char start-pos)\n\n ;; Ensure that we're at the next line beginning\n (beginning-of-line)\n (unless (= (point) start-pos)\n (forward-line))\n\n ;; Go forward until the current line begins a tactic\n (while (and (not (eobp)) (not (looking-at-p \"[a-zA-Z]\")))\n (forward-line))\n\n (if (eobp) ;; if at end of buffer, no tactic to be found!\n nil\n (setq tactic-start (point))\n\n ;; Go forward until end of buffer or non-blank line at left margin\n (forward-line)\n (while (and (not (eobp)) (not (looking-at-p \"[a-zA-Z]\")))\n (forward-line))\n\n ;; Go backward until a non-whitespace char is found - it is the end of\n ;; the tactic\n (backward-char)\n (while (looking-at-p \"\\\\s-\\\\|$\") (backward-char))\n (forward-char)\n (setq tactic-end (point))\n\n (cons tactic-start tactic-end)))))\n\n\n\n(defun idris-prover-script-backward ()\n \"Backward one piece of proof script.\"\n (interactive)\n (idris-eval-async (list :interpret (if idris-enable-elab-prover \":undo\" \"undo\"))\n #'(lambda (_result) t)\n #'(lambda (condition)\n (message (concat idris-prover-error-message-prefix condition)))))\n\n(defun idris-prover-script-forward ()\n \"Forward one piece of proof script.\"\n (interactive)\n (when (eobp) (newline)) ;; There must be a newline at the end\n (when idris-prover-script-warning-overlay\n (delete-overlay idris-prover-script-warning-overlay)\n (setq idris-prover-script-warning-overlay nil))\n (goto-char (+ 1 idris-prover-script-processed))\n (let ((prior-processed-position (marker-position idris-prover-script-processed)) ; to restore on error\n (next-tactic (idris-prover-find-tactic\n idris-prover-script-processed)))\n (if (null next-tactic)\n (user-error \"At the end of the proof script\")\n (let* ((tactic-start (car next-tactic))\n (tactic-end (cdr next-tactic))\n (tactic-text (buffer-substring-no-properties tactic-start\n tactic-end)))\n (set-marker idris-prover-script-processed tactic-start)\n (set-marker idris-prover-script-processing tactic-end)\n (let ((overlay (make-overlay idris-prover-script-processed\n idris-prover-script-processing)))\n (overlay-put overlay 'face 'idris-prover-processing-face)\n (setq idris-prover-script-processing-overlay overlay))\n (with-no-warnings\n (let ((tactic-cmd (replace-regexp-in-string\n \"\\\\`[ \\t\\n]*\" \"\"\n ;; replace Windows newlines with a space\n (replace-regexp-in-string \"\r\" \" \" tactic-text))))\n (idris-rex () (list :interpret tactic-cmd) nil\n ((:ok _result)\n (with-current-buffer (idris-prover-script-buffer)\n (when idris-prover-script-processing-overlay\n (delete-overlay idris-prover-script-processing-overlay)\n (setq idris-prover-script-processing-overlay nil))\n ;; Delete the region because it will be or has been\n ;; written with the proof state.\n (delete-region idris-prover-script-processed\n idris-prover-script-processing)\n ;; Put point at a useful spot for the next tactic\n (when (eql (marker-position idris-prover-script-processed) (point-max))\n (goto-char idris-prover-script-processed)\n (let ((inhibit-read-only t)) (insert \"\\n\")))\n (goto-char (1+ (marker-position idris-prover-script-processed)))\n (recenter)))\n ((:error condition &optional _spans)\n (with-current-buffer (idris-prover-script-buffer)\n (when idris-prover-script-processing-overlay\n (delete-overlay idris-prover-script-processing-overlay)\n (setq idris-prover-script-processing-overlay nil))\n (setq idris-prover-script-warning-overlay\n (idris-warning-create-overlay idris-prover-script-processed\n idris-prover-script-processing\n condition))\n ;; Restore the original position of the marker for\n ;; the processed region to prevent Emacs and Idris\n ;; from getting out of sync RE proof script contents\n (set-marker idris-prover-script-processed prior-processed-position))\n (message (concat idris-prover-error-message-prefix condition))\n t))))))))\n\n(defun idris-prover-script-ret ()\n \"Insert a newline at the end of buffer, even if it's read-only.\"\n (interactive)\n (if (equal (point) (marker-position idris-prover-script-processed))\n (let ((inhibit-read-only t)) (insert \"\\n\"))\n (newline)))\n\n(defun idris-prover-script-qed ()\n \"Send a QED command to Idris.\"\n (interactive)\n (if idris-prover-currently-proving\n (idris-eval-async (list :interpret (if idris-enable-elab-prover \":qed\" \"qed\"))\n #'(lambda (_result) t)\n #'(lambda (condition)\n (message (concat idris-prover-error-message-prefix condition))))\n (user-error \"No proof in progress\")))\n\n(easy-menu-define idris-prover-script-mode-menu idris-prover-script-mode-map\n \"Menu for Idris prover scripts.\"\n `(\"Idris Proof\"\n [\"Advance\" idris-prover-script-forward t]\n [\"Retract\" idris-prover-script-backward t]\n [\"QED\" idris-prover-script-qed t]\n [\"Abandon\" idris-prover-abandon t])\n )\n\n(define-derived-mode idris-prover-script-mode prog-mode \"Idris-Proof-Script\"\n \"Major mode for interacting with Idris proof script.\n\\\\{idris-prover-script-mode-map}\nInvokes `idris-prover-script-mode-hook'.\"\n :group 'idris-prover\n (set (make-local-variable 'completion-at-point-functions)\n '(idris-prover-complete))\n (set (make-local-variable 'indent-tabs-mode) nil))\n\n(defun idris-prover-script-buffer ()\n (or (get-buffer idris-prover-script-buffer-name)\n (let ((buffer (get-buffer-create idris-prover-script-buffer-name)))\n (with-current-buffer buffer\n (idris-prover-script-mode)\n (setq idris-prover-script-processing (make-marker))\n (setq idris-prover-script-processed (make-marker))\n (set-marker idris-prover-script-processing (point))\n (set-marker idris-prover-script-processed (point)))\n buffer)))\n\n(defun idris-prover-reset-prover-script-buffer ()\n \"Erase or initialize a proof script buffer, resetting all the prover state.\"\n (with-current-buffer (idris-prover-script-buffer)\n (when idris-prover-script-processed-overlay\n (delete-overlay idris-prover-script-processed-overlay)\n (setq idris-prover-script-processed-overlay nil))\n (when idris-prover-script-processing-overlay\n (delete-overlay idris-prover-script-processing-overlay)\n (setq idris-prover-script-processing-overlay nil))\n (setq idris-prover-prove-step 0)\n (erase-buffer)\n (when idris-show-help-text\n (setq header-line-format\n (let ((fwd (where-is-internal 'idris-prover-script-forward))\n (bak (where-is-internal 'idris-prover-script-backward))\n (qed (where-is-internal 'idris-prover-script-qed)))\n (concat \" Write your proof script here.\"\n (if (and fwd bak qed)\n (format \"Use %s to advance and %s to retract. %s saves a completed proof.\"\n (key-description (car fwd))\n (key-description (car bak))\n (key-description (car qed)))\n \"\")))))\n (unless idris-prover-script-processing\n (setq idris-prover-script-processing (make-marker)))\n (unless idris-prover-script-processed\n (setq idris-prover-script-processed (make-marker)))\n (set-marker idris-prover-script-processing (point))\n (set-marker idris-prover-script-processed (point))))\n\n(defun idris-prover-write-script (script count)\n \"Put the proof state recieved from Idris into the proof script buffer.\nSCRIPT is the list of tactics in the proof state, and COUNT is\nthe length reported by Idris.\"\n (interactive)\n (with-current-buffer (idris-prover-script-buffer)\n (let ((inhibit-read-only t))\n (put-text-property (point-min) (point-max) 'read-only nil))\n (cond ((< count idris-prover-prove-step)\n ;; this is actually the (count - 1) == Idris-prover-prove-step case!\n ;; in other words, we are undoing the final step.\n ;; can the other case(s) happen??\n (goto-char idris-prover-script-processed)\n (if (= (forward-line -1) 0)\n ;; we went back\n (end-of-line)\n ;; we did not go back - are thus at top of buffer and must\n ;; retract whole script\n (goto-char (point-min)))\n (set-marker idris-prover-script-processed (point)))\n ((> count idris-prover-prove-step)\n ;; Here we are inserting a newly-checked proof step.\n (goto-char idris-prover-script-processed)\n (while (< idris-prover-prove-step count)\n (let ((lelem (nth idris-prover-prove-step script)))\n (insert-before-markers lelem))\n (newline)\n (setq idris-prover-prove-step (1+ idris-prover-prove-step))))\n (t nil))\n (setq idris-prover-prove-step count)\n (unless (null idris-prover-script-processed-overlay)\n (delete-overlay idris-prover-script-processed-overlay))\n (let ((overlay (make-overlay 0 idris-prover-script-processed)))\n (overlay-put overlay 'face 'idris-prover-processed-face)\n (setq idris-prover-script-processed-overlay overlay))\n (let ((inhibit-read-only t))\n (put-text-property (point-min) idris-prover-script-processed 'read-only t))))\n\n(defun idris-prover-abandon ()\n \"Abandon an in-progress proof.\"\n (interactive)\n ;; Ask for confirmation when called interactively\n (when (or (not (called-interactively-p 'interactive))\n (yes-or-no-p \"Abandon proof and discard script? \"))\n (if idris-prover-currently-proving\n (idris-eval (list :interpret (if idris-enable-elab-prover \":abandon\" \"abandon\")) t)\n (user-error \"No proof in progress\"))))\n\n(defun idris-prover-end ()\n \"Remove buffers from proof mode and unset global state related to the prover.\"\n (interactive)\n (setq idris-prover-currently-proving nil)\n (let ((obligations (idris-prover-obligations-buffer))\n (script (idris-prover-script-buffer)))\n (when obligations\n (delete-windows-on obligations)\n (kill-buffer obligations))\n (when script (kill-buffer script)))\n (when (and idris-prover-restore-window-configuration\n (window-configuration-p\n idris-prover-saved-window-configuration))\n (set-window-configuration idris-prover-saved-window-configuration))\n (setq idris-prover-saved-window-configuration nil))\n\n\n(autoload 'idris-repl-write-string \"idris-repl.el\")\n(defun idris-prover-event-hook-function (event)\n \"Process an EVENT returned from Idris when the prover is running.\"\n (pcase event\n (`(:start-proof-mode ,name ,_target)\n (setq idris-prover-currently-proving name)\n (setq idris-prover-saved-window-configuration\n (current-window-configuration))\n (idris-prover-reset-prover-script-buffer)\n (idris-repl-write-string (format \"Start proof of %s\" name))\n (let* ((obligations-window (idris-prover-show-obligations))\n (script-window (split-window obligations-window)))\n (set-window-buffer script-window (idris-prover-script-buffer)))\n t)\n (`(:end-proof-mode ,msg ,_target)\n (let ((name (car msg))\n (proof (cadr msg)))\n (idris-perhaps-insert-proof-script proof)\n (idris-prover-end)\n (idris-repl-write-string (concat \"End proof of \" name))\n (run-hooks 'idris-prover-success-hook))\n t)\n (`(:write-proof-state ,msg ,_target)\n (cl-destructuring-bind (script count) msg\n (idris-prover-write-script script count))\n t)\n (`(:write-goal ,goal ,_target)\n (idris-prover-write-goals goal)\n t)\n (`(:abandon-proof ,_msg ,_target)\n (when (get-buffer idris-prover-script-buffer-name)\n (with-current-buffer idris-prover-script-buffer-name\n (copy-region-as-kill (point-min) (point-max))\n (message \"Proof saved to kill ring\")))\n (idris-prover-end)\n (idris-repl-write-string \"Abandoned proof\")\n t)\n (_ nil)))\n\n(defun idris-perhaps-insert-proof-script (proof)\n \"Prompt the user as to whether PROOF should be inserted into the buffer.\"\n (save-window-excursion\n (pop-to-buffer idris-currently-loaded-buffer)\n (delete-other-windows)\n (let ((proof-buffer (get-buffer-create \"*idris-finished-proof*\")))\n (unwind-protect\n (progn\n (pop-to-buffer proof-buffer)\n (insert proof)\n (if (y-or-n-p \"Keep this proof script?\")\n (idris-insert-proof-script idris-currently-loaded-buffer proof)\n (kill-new proof)\n (message \"Proof saved to kill ring\")))\n (kill-buffer proof-buffer)))))\n\n(defconst idris-proof-script-insertion-marker \"---------- Proofs ----------\"\n \"Look for this marker to insert proofs.\nShould agree with the one in the Idris compiler source.\")\n\n(defun idris-insert-proof-script (buffer proof)\n \"Insert PROOF into BUFFER.\"\n (with-current-buffer buffer\n (save-excursion\n (goto-char (point-min))\n (unless (re-search-forward idris-proof-script-insertion-marker nil t)\n (when (re-search-forward \"\\\\(\\\\s-*\\n\\\\)*\\\\'\")\n (replace-match (concat \"\\n\\n\" idris-proof-script-insertion-marker \"\\n\") nil nil)))\n (newline)\n (insert proof)\n (newline))))\n\n(provide 'idris-prover)\n" }, { "path": "idris-repl.el", "content": ";;; idris-repl.el --- Run an Idris interpreter using S-Expression communication protocol.-*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Mehnert and David Raymond Christiansen\n\n;; Author: Hannes Mehnert \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Code:\n\n(require 'cl-lib)\n(require 'prop-menu)\n\n(require 'idris-core)\n(require 'idris-settings)\n(require 'inferior-idris)\n(require 'idris-common-utils)\n(require 'idris-prover)\n(require 'idris-highlight-input)\n(require 'idris-xref)\n\n(eval-when-compile (require 'cl-lib))\n\n;;; Words of encouragement - strongly inspired by Slime\n(defun idris-user-first-name ()\n (let ((name (if (string= (user-full-name) \"\")\n (user-login-name)\n (user-full-name))))\n (string-match \"^[^ ]*\" name)\n (capitalize (match-string 0 name))))\n\n(defvar idris-words-of-encouragement\n `(\"Let the hacking commence!\"\n \"Hacks and glory await!\"\n \"Hack and be merry!\"\n ,(format \"%s, this could be the start of a beautiful program.\"\n (idris-user-first-name))\n ,(format \"%s, this could be the start of a beautiful proof.\"\n (idris-user-first-name))\n \"The terms have seized control of the means of computation - a glorious future awaits!\"\n \"It typechecks! Ship it!\"\n \"Do you know 'Land of My Fathers'?\"\n \"Constructors are red / Types are blue / Your code always works / Because Idris loves you\"))\n\n(defun idris-random-words-of-encouragement ()\n \"Return a random string of encouragement\"\n (nth (random (length idris-words-of-encouragement))\n idris-words-of-encouragement))\n\n(defvar idris-prompt-string \"Idris\"\n \"The prompt shown in the REPL.\")\n\n(defvar idris-repl-buffer-name (idris-buffer-name :repl)\n \"The name of the Idris REPL buffer.\")\n\n(defvar-local idris-prompt-start nil\n \"Marker for the start of the Idris prompt.\")\n\n(defvar-local idris-input-start nil\n \"Marker for the start of user input for Idris.\")\n\n(defun idris-repl-welcome-message ()\n \"The message to display as part of the Idris banner, if applicable.\"\n \"Welcome to the Idris REPL!\")\n\n(defun idris-repl-get-logo ()\n \"Return the path to the Idris logo if it exists, or nil if not.\"\n (let ((logo-path (concat idris-mode-path \"logo-small.png\")))\n (if (file-readable-p logo-path)\n logo-path\n nil)))\n\n(defun idris-repl-insert-logo ()\n \"Attempt to insert a graphical logo.\nReturns non-nil on success, nil on failure.\"\n (let ((logo (idris-repl-get-logo)))\n (if (and (display-graphic-p)\n (image-type-available-p 'png)\n logo)\n (progn (insert-image (create-image logo)\n (idris-repl-welcome-message))\n t)\n nil)))\n\n(defun idris-repl-animate-banner ()\n \"Insert a text banner using animation.\nReturns non-nil on success, nil on failure.\"\n (animate-string (idris-repl-welcome-message) 0 0)\n t)\n\n(defun idris-repl-text-banner ()\n \"Insert a text banner with no animation.\nReturns non-nil on success, nil on failure.\"\n (insert (idris-repl-welcome-message))\n t)\n\n(defun idris-repl-insert-banner ()\n \"Insert Idris banner into buffer.\"\n (when (zerop (buffer-size))\n ;; If a banner is inserted, add a newline too\n (when (run-hook-with-args-until-success 'idris-repl-banner-functions)\n (insert \"\\n\"))\n (let ((version-string (idris-get-idris-version-string)))\n (when (and idris-repl-show-idris-version\n version-string)\n (insert (propertize (concat \"Idris \" version-string)\n 'face 'italic)\n \"\\n\")))\n (when idris-display-words-of-encouragement\n (insert (idris-random-words-of-encouragement) \"\\n\"))))\n\n(defun idris-repl-insert-prompt (&optional always-insert)\n \"Insert or update Idris prompt in buffer.\nIf ALWAYS-INSERT is non-nil, always insert a prompt at the end of the buffer.\"\n ;; Put the prompt at the end, if no active prompt is present.\n (when always-insert\n (set-marker idris-prompt-start (point-max))\n (set-marker idris-input-start (point-max)))\n (goto-char idris-prompt-start)\n (let ((inhibit-read-only 'idris-repl-prompt))\n (delete-region idris-prompt-start idris-input-start))\n (unless (bolp) (insert \"\\n\"))\n (let ((prompt (if (and (equal idris-repl-prompt-style 'short)\n (not idris-prover-currently-proving))\n \"λΠ> \"\n (format \"%s> \" idris-prompt-string))))\n (set-marker idris-prompt-start (point))\n (idris-propertize-region\n `(face idris-repl-prompt-face\n read-only idris-repl-prompt\n intangible t\n idris-repl-prompt t\n help-echo ,idris-prompt-string\n rear-nonsticky (idris-repl-prompt read-only face intangible))\n (let ((inhibit-read-only t))\n (insert prompt)))\n (set-marker idris-input-start (point-max))\n (goto-char idris-input-start)\n (and (get-buffer-window)\n (set-window-point (get-buffer-window) idris-input-start))))\n\n(defun idris-repl-update-prompt (new-prompt)\n \"Update prompt string to NEW-PROMPT.\"\n (unless (equal idris-prompt-string new-prompt)\n (setq idris-prompt-string new-prompt)\n (with-current-buffer (idris-repl-buffer)\n (idris-repl-insert-prompt))))\n\n\n(defun idris-repl-buffer ()\n \"Return or create the Idris REPL buffer.\"\n (or (get-buffer idris-repl-buffer-name)\n (let ((buffer (get-buffer-create idris-repl-buffer-name)))\n (save-selected-window\n (when idris-repl-show-repl-on-startup\n (display-buffer buffer t))\n (with-current-buffer buffer\n (idris-repl-mode)\n (idris-repl-buffer-init))\n buffer))))\n\n(defun idris-repl-clear-buffer ()\n \"Clear prior output from the Idris REPL buffer.\"\n (interactive)\n (with-current-buffer (idris-repl-buffer)\n (let ((inhibit-read-only t)\n (current-input (idris-repl-current-input)))\n (erase-buffer)\n (idris-repl-insert-prompt)\n (insert current-input))))\n\n(defun idris-switch-to-repl ()\n \"Select the output buffer and scroll to bottom.\"\n (interactive)\n (pop-to-buffer (idris-repl-buffer))\n (goto-char (point-max)))\n\n(define-obsolete-function-alias 'idris-switch-to-output-buffer 'idris-switch-to-repl \"2022-12-28\")\n\n(autoload 'idris-run \"idris-commands.el\")\n;;;###autoload\n(defun idris-repl ()\n (interactive)\n (idris-run)\n (idris-switch-to-repl))\n\n(defvar idris-repl-mode-map\n (let ((map (make-sparse-keymap)))\n (define-key map (kbd \"\") 'idris-repl-return)\n ;; (define-key map (kbd \"\") ...) makes the debugger complain, and\n ;; suggests this method of binding instead.\n (define-key map \"\\t\" 'completion-at-point)\n (define-key map (kbd \"\") 'idris-repl-begin-of-prompt)\n (define-key map (kbd \"C-a\") 'idris-repl-begin-of-prompt)\n (define-key map (kbd \"M-p\") 'idris-repl-backward-history)\n (define-key map (kbd \"\") 'idris-repl-backward-history)\n (define-key map (kbd \"M-n\") 'idris-repl-forward-history)\n (define-key map (kbd \"\") 'idris-repl-forward-history)\n (define-key map (kbd \"C-c M-o\") 'idris-repl-clear-buffer)\n (cl-loop for keyer\n in '(idris-define-docs-keys\n idris-define-general-keys\n idris-define-active-term-keys)\n do (funcall keyer map))\n (substitute-key-definition 'idris-switch-to-repl\n 'idris-switch-to-last-idris-buffer\n map)\n map)\n \"Keymap used in Idris REPL mode.\")\n\n(easy-menu-define idris-repl-mode-menu idris-repl-mode-map\n \"Menu for the Idris REPL mode.\"\n `(\"Idris REPL\"\n (\"Interpreter options\" :active idris-process\n [\"Show implicits\" (idris-set-option :show-implicits t)\n :visible (not (idris-get-option :show-implicits))]\n [\"Hide implicits\" (idris-set-option :show-implicits nil)\n :visible (idris-get-option :show-implicits)]\n [\"Show error context\" (idris-set-option :error-context t)\n :visible (not (idris-get-option :error-context))]\n [\"Hide error context\" (idris-set-option :error-context nil)\n :visible (idris-get-option :error-context)])\n [\"Show term interaction widgets\" idris-add-term-widgets t]\n [\"Customize idris-mode\" (customize-group 'idris) t]\n [\"Quit inferior Idris process\" idris-quit t]\n ))\n\n(define-derived-mode idris-repl-mode fundamental-mode \"Idris-REPL\"\n \"Major mode for interacting with Idris.\n\\\\{idris-repl-mode-map}\nInvokes `idris-repl-mode-hook'.\"\n ;syntax-table?\n :group 'idris-repl\n (set (make-local-variable 'indent-tabs-mode) nil)\n (add-hook 'idris-event-hooks 'idris-repl-event-hook-function)\n (add-hook 'kill-buffer-hook 'idris-repl-remove-event-hook-function nil t)\n (when (idris-repl-history-file-f)\n (idris-repl-safe-load-history)\n (add-hook 'kill-buffer-hook\n 'idris-repl-safe-save-history nil t))\n (add-hook 'kill-emacs-hook 'idris-repl-save-all-histories)\n (set (make-local-variable 'completion-at-point-functions) '(idris-repl-complete))\n (setq mode-name `(\"Idris-REPL\" (:eval (if idris-rex-continuations \"!\" \"\"))))\n (set (make-local-variable 'prop-menu-item-functions)\n '(idris-context-menu-items))\n (add-hook 'xref-backend-functions #'idris-xref-backend nil 'local))\n\n(defun idris-repl-remove-event-hook-function ()\n (setq idris-prompt-string \"Idris\")\n (remove-hook 'idris-event-hooks 'idris-repl-event-hook-function))\n\n(defun idris-repl-event-hook-function (event)\n (pcase event\n (`(:write-string ,output ,_target)\n (idris-repl-write-string output)\n t)\n (`(:set-prompt ,prompt ,_target)\n (idris-repl-update-prompt prompt)\n t)\n (`(:warning ,output ,_target)\n (when (member 'warnings-repl idris-warnings-printing)\n (pcase output\n (`(,fname (,start-line ,start-col) (,_end-line ,_end-col) ,msg ,_spans)\n (idris-repl-write-string (format \"Error: %s line %d (col %d):\\n%s\"\n fname\n (1+ start-line)\n (1+ start-col)\n msg)))\n ;; Keeping this old format for backward compatibility.\n ;; Probably we can remove it at some point.\n (_ (idris-repl-write-string (format \"Error: %s line %d (col %d):\\n%s\"\n (nth 0 output)\n (nth 1 output)\n (if (eq (safe-length output) 3)\n 0\n (nth 2 output))\n (car (last output))))))))\n (`(:run-program ,file ,_target)\n (idris-execute-compiled-program file))\n (_ nil)))\n\n(defun idris-execute-compiled-program (filename)\n (let* ((name (concat \"idris-\" filename))\n (buffer (make-comint-in-buffer name nil filename)))\n (pop-to-buffer buffer)))\n\n(defun idris-repl-update-banner ()\n (idris-repl-insert-banner)\n (goto-char (point-max))\n (idris-repl-insert-prompt t))\n\n(defun idris-repl-buffer-init ()\n (dolist (markname '(idris-prompt-start\n idris-input-start))\n (set markname (make-marker))\n (set-marker (symbol-value markname) (point)))\n (idris-repl-update-banner))\n\n(defun idris-repl-return ()\n \"Send command over to Idris.\"\n (interactive)\n (goto-char (point-max))\n (let ((end (point)))\n (idris-repl-add-to-input-history (buffer-substring idris-input-start end))\n (let ((overlay (make-overlay idris-input-start end)))\n (overlay-put overlay 'face 'idris-repl-input-face)))\n (let ((input (idris-repl-current-input))\n (input-start (marker-position idris-input-start)))\n (goto-char (point-max))\n (if (string-match-p \"^\\\\s-*$\" input)\n (delete-region (point) idris-input-start)\n (insert \"\\n\")\n (set-marker idris-prompt-start (point))\n (set-marker idris-input-start (point))\n (idris-repl-eval-string input input-start))))\n\n(defun idris-repl-complete ()\n \"Completion of the current input.\"\n (when idris-completion-via-compiler\n (let* ((input (idris-repl-current-input))\n (result (idris-eval `(:repl-completions ,input))))\n (cl-destructuring-bind (completions partial) (car result)\n (if (null completions)\n nil\n (list (+ idris-input-start (length partial)) (point-max) completions))))))\n\n(defun idris-repl-begin-of-prompt ()\n \"Go to the beginning of line or the prompt.\"\n (interactive)\n (cond ((and (>= (point) idris-input-start)\n (idris-same-line-p (point) idris-input-start))\n (goto-char idris-input-start))\n (t (beginning-of-line 1))))\n\n(defun idris-repl-current-input ()\n \"Return the current input as string.\"\n (buffer-substring-no-properties idris-input-start (point-max)))\n\n(defun idris-repl-highlight-input (start-pos start-line start-col end-line end-col props)\n \"Apply semantic highlighting to the REPL input beginning at START-POS using\nthe Idris location information START-LINE, START-COL, END-LINE, and END-COL\nand semantic annotations PROPS.\"\n (let ((buffer (get-buffer idris-repl-buffer-name)))\n (with-current-buffer buffer\n (save-restriction\n (widen)\n (let* ((input-line (save-excursion\n (goto-char start-pos)\n (beginning-of-line)\n (count-lines (point-min) start-pos)))\n (input-col (save-excursion\n (goto-char start-pos)\n (current-column)))\n (start-line-repl (+ input-line start-line -1))\n (start-col-repl (+ input-col start-col))\n (end-line-repl (+ input-line end-line -1))\n (end-col-repl (+ input-col end-col)))\n (idris-highlight-input-region start-line-repl start-col-repl\n end-line-repl end-col-repl\n props))))))\n\n(defun idris-repl-eval-string (string start)\n \"Evaluate STRING on the inferior Idris, where input was at position START.\"\n (idris-rex (start) (list :interpret string) t\n ((:ok result &optional spans)\n (pcase result\n (`(:highlight-source ,hs) ;; Semantic highlighting\n (when start\n (dolist (h hs)\n ;; Compute positions relative to the input start for\n ;; semantic highlighting\n (pcase h\n (`(((:filename ,_fn)\n (:start ,start-line ,start-col)\n (:end ,end-line ,end-col))\n ,props)\n (idris-repl-highlight-input\n start start-line start-col end-line end-col props))))))\n (_ (idris-repl-insert-result (or result \"\") spans)))) ;; The actual result\n ((:error condition &optional spans)\n (idris-repl-show-abort condition spans))))\n\n(defun idris-repl-show-abort (condition &optional highlighting)\n (with-current-buffer (idris-repl-buffer)\n (save-excursion\n (goto-char idris-prompt-start)\n (idris-propertize-spans (idris-repl-semantic-text-props highlighting)\n (insert-before-markers condition)))\n (idris-repl-insert-prompt)\n (idris-repl-show-maximum-output)))\n\n\n(defun idris-repl-write-string (string)\n \"Append STRING to output.\"\n (with-current-buffer (idris-repl-buffer)\n (save-excursion\n (goto-char idris-prompt-start)\n (idris-propertize-region\n `(face idris-repl-output-face\n read-only idris-repl-output\n rear-nonsticky (face read-only))\n (insert-before-markers string))\n (when (and (= (point) idris-prompt-start)\n (not (bolp)))\n (insert-before-markers \"\\n\")))\n (idris-repl-insert-prompt)\n (idris-repl-show-maximum-output)))\n\n\n(defun idris-repl-insert-result (string &optional highlighting)\n \"Insert STRING and mark it as evaluation result.\nOptional argument HIGHLIGHTING is a collection of semantic\nhighlighting information from Idris.\"\n (with-current-buffer (idris-repl-buffer)\n (save-excursion\n (goto-char (point-max))\n (when (and (not (bolp))\n (not (string-equal string \"\")))\n (insert-before-markers \"\\n\"))\n (idris-propertize-region '(read-only idris-repl-output\n rear-nonsticky (face read-only))\n (idris-propertize-spans (idris-repl-semantic-text-props highlighting)\n (idris-propertize-region\n '(face idris-repl-result-face\n rear-nonsticky (face))\n (insert-before-markers string)))))\n (idris-repl-insert-prompt)\n (idris-repl-show-maximum-output)))\n\n\n(defun idris-repl-show-maximum-output ()\n \"Put the end of the buffer at the bottom of the window.\"\n (when (eobp)\n (let ((win (if (eq (window-buffer) (current-buffer))\n (selected-window)\n (get-buffer-window (current-buffer) t))))\n (when win\n (with-selected-window win\n (set-window-point win (point-max))\n (recenter -1)\n (goto-char idris-input-start))))))\n\n\n;;; history\n\n(defvar-local idris-repl-input-history '()\n \"History list of strings entered into the REPL buffer.\")\n\n(defun idris-repl-add-to-input-history (string)\n \"Add input STRING to history.\"\n (unless (equal string \"\")\n (setq idris-repl-input-history\n (remove string idris-repl-input-history)))\n (unless (equal string (car idris-repl-input-history))\n (push string idris-repl-input-history)))\n\n(defvar-local idris-repl-input-history-position -1\n \"Newer items have smaller indices.\")\n\n(defun idris-repl-delete-current-input ()\n \"Delete all text from the prompt.\"\n (interactive)\n (delete-region idris-input-start (point-max)))\n\n(defun idris-repl-replace-input (string)\n (idris-repl-delete-current-input)\n (insert-and-inherit string))\n\n(defun idris-repl-history-replace (direction)\n \"Replace the current input with the next line in DIRECTION.\nDIRECTION is `forward' or `backward' (in the history list).\"\n (let* ((min-pos -1)\n (max-pos (length idris-repl-input-history))\n (prefix (idris-repl-history-prefix))\n (pos0 (if (idris-repl-history-search-in-progress-p)\n idris-repl-input-history-position\n min-pos))\n (pos (idris-repl-position-in-history pos0 direction prefix))\n (msg nil))\n (cond ((and (< min-pos pos) (< pos max-pos))\n (idris-repl-replace-input (nth pos idris-repl-input-history))\n (setq msg (format \"History item: %d\" pos)))\n (t\n (setq pos (if (= pos min-pos) max-pos min-pos))\n (setq msg \"Wrapped history\")))\n (message \"%s (prefix is: %s)\" msg prefix)\n (setq idris-repl-input-history-position pos)\n (setq this-command 'idris-repl-history-replace)))\n\n(defvar-local idris-repl-history-prefix-data \"\"\n \"Current history prefix.\")\n\n(defun idris-repl-history-prefix ()\n \"Return the prefix we want to look for in the history.\"\n (if (idris-repl-history-search-in-progress-p)\n idris-repl-history-prefix-data\n (setq idris-repl-history-prefix-data (idris-repl-current-input))\n idris-repl-history-prefix-data))\n\n(defun idris-repl-history-search-in-progress-p ()\n (eq last-command 'idris-repl-history-replace))\n\n(defun idris-repl-position-in-history (start-pos direction prefix)\n \"Return the position of the history item matching the PREFIX.\nReturn -1 resp. the length of the history if no item matches.\"\n ;; Loop through the history list looking for a matching line\n (let* ((step (cl-ecase direction\n (forward -1)\n (backward 1)))\n (history idris-repl-input-history)\n (len (length history)))\n (cl-loop for pos = (+ start-pos step) then (+ pos step)\n if (< pos 0) return -1\n if (<= len pos) return len\n for history-item = (nth pos history)\n if (string-prefix-p prefix history-item)\n return pos)))\n\n(defun idris-repl-backward-history ()\n \"Cycle backward through history.\"\n (interactive)\n (idris-repl-history-replace 'backward))\n\n(defun idris-repl-forward-history ()\n \"Cycle forward through history.\"\n (interactive)\n (idris-repl-history-replace 'forward))\n\n\n;; persistent history\n(defun idris-repl-save-all-histories ()\n \"Save the history in each repl buffer.\"\n (dolist (b (buffer-list))\n (with-current-buffer b\n (when (eq major-mode 'idris-repl-mode)\n (idris-repl-safe-save-history)))))\n\n(defun idris-repl-safe-save-history ()\n (idris-repl-call-with-handler\n #'idris-repl-save-history\n \"%S while saving the history. Continue? \"))\n\n(defun idris-repl-safe-load-history ()\n (idris-repl-call-with-handler\n #'idris-repl-load-history\n \"%S while loading the history. Continue? \"))\n\n(defun idris-repl-call-with-handler (fun query)\n \"Call FUN in the context of an error handler.\nThe handler will use qeuery to ask the use if the error should be ingored.\"\n (condition-case err\n (funcall fun)\n (error\n (if (y-or-n-p (format query (error-message-string err)))\n nil\n (signal (car err) (cdr err))))))\n\n(defun idris-repl-history-file-f ()\n \"Return repl history file.\n\nUse `idris-repl-history-file' if set or fallback\n to filepath computed from the `idris-interpreter-path'.\"\n (or idris-repl-history-file\n (idris-file-name-concat \"~\"\n (concat \".\" (file-name-nondirectory idris-interpreter-path))\n \"idris-history.eld\")))\n\n(defun idris-repl-read-history-filename ()\n (read-file-name \"Use Idris REPL history from file: \"\n (idris-repl-history-file-f)))\n\n(defun idris-repl-load-history (&optional filename)\n \"Set the current Idris REPL history.\nIt can be read either from FILENAME or `idris-repl-history-file' or\nfrom a user defined filename.\"\n (interactive (list (idris-repl-read-history-filename)))\n (let ((file (or filename (idris-repl-history-file-f))))\n (setq idris-repl-input-history (idris-repl-read-history file))))\n\n(defun idris-repl-read-history (&optional filename)\n \"Read and return the history from FILENAME.\nThe default value for FILENAME is `idris-repl-history-file'.\"\n (let ((file (or filename (idris-repl-history-file-f))))\n (cond ((not (file-readable-p file)) '())\n (t (with-temp-buffer\n (insert-file-contents file)\n (read (current-buffer)))))))\n\n(defun idris-repl-save-history (&optional filename history)\n \"Save the current Idris REPL HISTORY to a FILENAME.\nWhen Idris is setup to always load the old history and one uses only\none instance of Idris all the time, there is no need to merge the\nfiles and this function is sufficient.\"\n (interactive (list (idris-repl-read-history-filename)))\n (let ((file (or filename (idris-repl-history-file-f)))\n (hist (or history idris-repl-input-history)))\n (unless (file-writable-p file)\n (user-error (format \"History file not writable: %s\" file)))\n (let ((hist (cl-subseq hist 0 (min (length hist) idris-repl-history-size))))\n (with-temp-file file\n (let ((cs idris-repl-history-file-coding-system)\n (print-length nil) (print-level nil))\n (setq buffer-file-coding-system cs)\n (insert (format \";; -*- coding: %s -*-\\n\" cs))\n (insert \";; History for Idris REPL. Automatically written.\\n\"\n \";; Edit only if you know what you're doing\\n\")\n (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))))\n\n(provide 'idris-repl)\n;;; idris-repl.el ends here\n" }, { "path": "idris-settings.el", "content": ";;; idris-settings.el --- Contains settings for idris-mode -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Mehnert and David Raymond Christiansen\n\n;; Author: Hannes Mehnert and David Raymond Christiansen \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n(require 'idris-core)\n(require 'idris-keys)\n\n;;;; Main settings\n\n(defgroup idris nil \"Idris mode\" :prefix 'idris :group 'languages)\n\n(defcustom idris-interpreter-path \"idris\"\n \"The path to the Idris interpreter.\"\n :type 'file\n :group 'idris)\n\n(defcustom idris-interpreter-flags '()\n \"The command line arguments passed to the Idris interpreter.\"\n :type '(repeat string)\n :group 'idris)\n\n(defcustom idris-warnings-printing (list 'warnings-tree)\n \"How to print warnings: tree view ('warnings-tree) in REPL ('warnings-repl).\"\n :group 'idris\n :type '(repeat symbol)\n :options '(warnings-tree warnings-repl))\n\n(defcustom idris-pretty-printer-width 100\n \"The default width to use for pretty-printing.\"\n :group 'idris\n :type '(choice (integer :tag \"Columns\")\n (const :tag \"Unlimited\" nil)))\n\n\n(defcustom idris-show-help-text t\n \"Show explanatory text in idris-mode's auxiliary buffers if non-nil.\nAdvanced users may wish to disable this.\"\n :group 'idris\n :type 'boolean)\n\n(defcustom idris-stay-in-current-window-on-compiler-error nil\n \"Stay in current window if type checking fails.\"\n :group 'idris\n :type 'boolean)\n\n(defcustom idris-semantic-source-highlighting t\n \"Use the Idris compiler's semantic source information to highlight Idris code.\nIf `debug', log failed highlighting to buffer `*Messages*'.\"\n :group 'idris\n :type '(choice (boolean :tag \"Enable\")\n (const :tag \"Debug\" debug)))\n\n(defcustom idris-semantic-source-highlighting-max-buffer-size 32768 ;; (expt 2 15)\n \"Disable semantic source highlighting if the buffer exceeds the allotted size.\nThis is to reduce lag when loading large Idris files.\"\n :group 'idris\n :type 'integer)\n\n(defcustom idris-log-events nil\n \"If non-nil, communications between Emacs and Idris are logged.\n\nThe log is placed in `idris-event-buffer-name'.\"\n :group 'idris\n :type 'boolean)\n\n(defcustom idris-completion-via-compiler t\n \"Use the compiler to make suggestions.\"\n :type 'boolean\n :group 'idris)\n\n(defcustom idris-display-words-of-encouragement t\n \"Send words of encouragement.\"\n :type 'boolean\n :group 'idris)\n\n;;; Faces\n(defface idris-active-term-face\n '((((background light))\n :background \"lightgray\")\n (((background dark))\n :background \"darkgray\"))\n \"The face to highlight active terms.\"\n :group 'idris-faces)\n\n(defface idris-semantic-type-face\n '((((background light))\n :foreground \"blue\")\n (((background dark))\n :foreground \"cornflower blue\"))\n \"The face to be used to highlight types.\"\n :group 'idris-faces)\n\n(defface idris-semantic-data-face\n '((((background light))\n :foreground \"red\")\n (((background dark))\n :foreground \"firebrick1\"))\n \"The face to be used to highlight data and constructors.\"\n :group 'idris-faces)\n\n(defface idris-semantic-function-face\n '((((background light))\n :foreground \"darkgreen\")\n (((background dark))\n :foreground \"#A6E22E\"))\n \"The face to be used to highlight defined functions.\"\n :group 'idris-faces)\n\n(defface idris-semantic-postulate-face\n '((t (:inherit idris-unsafe-face :weight semi-bold)))\n \"The face to be used to highlight postulated values.\"\n :group 'idris-faces)\n\n(defface idris-semantic-bound-face\n '((((background light))\n :foreground \"purple\")\n (((background dark))\n :foreground \"MediumPurple1\"))\n \"The face to be used to highlight bound variables.\"\n :group 'idris-faces)\n\n(defface idris-semantic-implicit-face\n '((t (:underline t)))\n \"The face to be used to highlight implicit arguments.\"\n :group 'idris-faces)\n\n(defface idris-semantic-namespace-face\n '((t (:italic t)))\n \"The face to be used to highlight namespace declarations.\"\n :group 'idris-faces)\n\n(defface idris-semantic-module-face\n '((t :inherit idris-semantic-namespace-face))\n \"The face to be used to highlight namespace declarations.\"\n :group 'idris-faces)\n\n(defface idris-quasiquotation-face nil\n \"The face to be used to highlight quasiquotations in Idris source code.\"\n :group 'idris-faces)\n\n(defface idris-antiquotation-face nil\n \"The face to be used to highlight antiquotations in Idris source code.\"\n :group 'idris-faces)\n\n(defface idris-loaded-region-face nil\n \"The face to use for the currently-loaded region of a buffer.\nSince semantic highlighting has been added, this face defaults to nothing,\nbut is provided for users who prefer the old behavior.\"\n :group 'idris-faces)\n\n(defface idris-inline-doc-face\n '((t :inherit font-lock-doc-face))\n \"The face shown for IdrisDoc while editing Idris files.\"\n :group 'idris-faces)\n\n(defface idris-link-face\n '((t :inherit button))\n \"The face shown for Web links in Idris documentation.\"\n :group 'idris-faces)\n\n(defface idris-info-title-face\n '((t :inherit header-line))\n \"Face for Idris headers and titles.\"\n :group 'idris-faces)\n\n;;; Mode hooks\n(defcustom idris-mode-hook '(turn-on-idris-simple-indent\n turn-on-eldoc-mode)\n \"Hook to run upon entering Idris mode.\nYou should choose at most one indentation style.\"\n :type 'hook\n :options '(turn-on-idris-simple-indent\n turn-on-eldoc-mode)\n :group 'idris)\n\n(defcustom idris-mode-lidr-hook '()\n \"Hook to run after opening a literate Idris file.\nUse this to customize the display of non-code text.\"\n :type 'hook\n :group 'idris)\n\n(defcustom idris-info-mode-hook ()\n \"Hook to run when setting up Idris info buffers.\"\n :type 'hook\n :options ()\n :group 'idris)\n\n(defcustom idris-repl-mode-hook ()\n \"Hook to run when setting up the Idris REPL.\"\n :type 'hook\n :options ()\n :group 'idris)\n\n(defcustom idris-compiler-notes-mode-hook ()\n \"Hook to run when setting up the compiler notes buffers.\"\n :type 'hook\n :options ()\n :group 'idris)\n\n(defgroup idris-hole-list nil\n \"Options related to the Idris hole list buffer.\"\n :group 'idris)\n\n(defcustom idris-hole-list-mode-hook ()\n \"Hook to run when setting up the list of holes.\"\n :type 'hook\n :options ()\n :group 'idris-hole-list)\n\n(defcustom idris-hole-show-on-load t\n \"Show the current holes on successful load.\"\n :type 'boolean\n :group 'idris)\n\n(defcustom idris-hole-list-show-expanded t\n \"Show the hole list fully expanded by default.\nThis may be useful on wide monitors with lots of space for the hole buffer.\"\n :type 'boolean\n :group 'idris-hole-list)\n\n(defcustom idris-enable-elab-prover nil\n \"Whether or not to enable the interactive prover for elaborator reflection.\nDisabled by default until Idris 0.9.19 because it requires a\nchange to ordinary prover interaction.\"\n :type 'boolean\n :group 'idris)\n\n;;;; Other hooks\n\n(autoload 'idris-set-current-pretty-print-width \"idris-commands.el\")\n(defcustom idris-run-hook '(idris-set-current-pretty-print-width)\n \"A hook to run when Idris is started.\"\n :type 'hook\n :group 'idris\n :options '(idris-set-current-pretty-print-width))\n\n(defcustom idris-load-file-success-hook '(idris-list-holes\n idris-set-current-pretty-print-width)\n \"Functions to call when loading a file is successful.\nWhen `idris-hole-show-on-load' is set to nil the function `idris-list-holes'\nwill be removed from the list automatically and will not be executed.\"\n :type 'hook\n :options '(idris-list-holes\n idris-set-current-pretty-print-width)\n :group 'idris)\n\n(defcustom idris-prover-success-hook '(idris-list-holes)\n \"Functions to call when completing a proof.\nWhen `idris-hole-show-on-load' is set to nil the function `idris-list-holes'\nwill be removed from the list automatically and will not be executed.\"\n :type 'hook\n :options '(idris-list-holes)\n :group 'idris-prover)\n\n;;;; REPL settings\n\n(defgroup idris-repl nil \"Idris REPL\" :prefix 'idris :group 'idris)\n\n(defcustom idris-repl-banner-functions '(idris-repl-insert-logo\n idris-repl-animate-banner\n idris-repl-text-banner)\n \"A list of functions that can attempt to insert a banner into the REPL.\nIf a function cannot insert a banner (for instance, if it is supposed\nto insert a graphical banner but the current Emacs has no image support),\nit returns nil. The functions in this list are run in order,\nuntil one returns non-nil. Set to nil for no banner.\"\n :type 'hook\n :group 'idris-repl\n :options '(idris-repl-insert-logo\n idris-repl-animate-banner\n idris-repl-text-banner))\n\n(defcustom idris-repl-show-idris-version t\n \"Whether to show the Idris version on REPL startup.\"\n :type 'boolean\n :group 'idris-repl)\n\n(defface idris-repl-prompt-face\n '((t (:inherit font-lock-keyword-face)))\n \"Face for the prompt in the Idris REPL.\"\n :group 'idris-repl)\n\n(defface idris-repl-output-face\n '((t (:inherit font-lock-string-face)))\n \"Face for Idris output in the Idris REPL.\"\n :group 'idris-repl)\n\n(defface idris-repl-input-face\n '((t (:bold t)))\n \"Face for previous input in the Idris REPL.\"\n :group 'idris-repl)\n\n(defface idris-repl-result-face\n '((t ()))\n \"Face for the result of an evaluation in the Idris REPL.\"\n :group 'idris-repl)\n\n(defcustom idris-repl-history-file nil\n \"File to save the persistent REPL history to.\n\nBy default we assume Idris' default configuration home is:\n\n $HOME/.idris/idris-history.eld.\n\nIf you have installed/configured Idris differently, or are\nusing Idris2, then you may wish to customise this variable.\"\n\n :type 'string\n :group 'idris-repl)\n\n(defcustom idris-repl-history-size 200\n \"Maximum number of lines for persistent REPL history.\"\n :type 'integer\n :group 'idris-repl)\n\n(defcustom idris-repl-history-file-coding-system\n 'utf-8-unix\n \"The coding system for the history file.\"\n :type 'symbol\n :group 'idris-repl)\n\n(defcustom idris-repl-prompt-style 'short\n \"What sort of prompt to show.\n`long' shows the Idris REPL prompt, while `short' shows a shorter one.\"\n :options '(short long)\n :type 'symbol\n :group 'idris-repl)\n\n(defcustom idris-repl-show-repl-on-startup t\n \"If non-nil, show the REPL window when Idris starts.\nIf nil, only do this when `idris-repl' was called interactively.\"\n :type 'boolean\n :group 'idris-repl)\n\n(provide 'idris-settings)\n" }, { "path": "idris-simple-indent.el", "content": ";;; idris-simple-indent.el --- Simple indentation module for Idris Mode -*- lexical-binding: t -*-\n\n;; Copyright (C) 1998 Heribert Schuetz, Graeme E Moss\n\n;; Author: Heribert Schuetz \n;; Graeme E Moss \n;; Hacked for Idris by David Raymond Christiansen \n;; Keywords: indentation files Idris\n\n;; This file is not part of GNU Emacs.\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; Purpose:\n;;\n;; To support simple indentation of Idris scripts.\n;;\n;;\n;; Installation:\n;;\n;; To bind TAB to the indentation command for all Idris buffers, add\n;; this to .emacs:\n;;\n;; (add-hook 'idris-mode-hook 'turn-on-idris-simple-indent)\n;;\n;; Otherwise, call `turn-on-idris-simple-indent'.\n;;\n;;\n;; Customisation:\n;;\n;; None supported.\n;;\n;;\n;; History:\n;;\n;; Version 0.1 - Initial version:\n;; Imported from haskell-simple-indent 1.2\n;;\n;; Present Limitations/Future Work (contributions are most welcome!):\n;;\n;; (None so far.)\n\n;;; Code:\n\n;; All functions/variables start with\n;; `(turn-(on/off)-)idris-simple-indent'.\n\n(require 'idris-common-utils)\n\n(defgroup idris-simple-indent nil\n \"Simple Idris indentation.\"\n :link '(custom-manual \"(idris-mode)Indentation\")\n :group 'idris\n :prefix \"idris-simple-indent-\")\n\n;; Version.\n(defconst idris-simple-indent-version \"0.1\"\n \"`idris-simple-indent' version number.\")\n(defun idris-simple-indent-version ()\n \"Echo the current version of `idris-simple-indent' in the minibuffer.\"\n (interactive)\n (message \"Using idris-simple-indent version %s\"\n idris-simple-indent-version))\n\n(defun idris-simple-indent-current-indentation ()\n \"Return the indentation of the current line.\nTakes into account literate Idris syntax.\"\n (save-excursion\n (move-to-column 0)\n (looking-at (if (idris-lidr-p) \">\\\\s-*\" \"\\\\s-*\"))\n (length (match-string 0))))\n\n(defun idris-simple-indent-indent-line-to (column)\n \"Indent current line to COLUMN.\nJust like `indent-line-to', but ignoring the leading > for literate Idris.\"\n (if (idris-lidr-p)\n (if (save-excursion (move-to-column 0) (looking-at \">\")) ;; lidr code line - look out for >\n (progn\n (save-excursion (move-to-column 0)\n (re-search-forward \">\\\\s-*\" nil t)\n (replace-match (concat \">\"\n (if (<= column 1)\n \" \"\n (make-string (1- column) ? ))) nil nil))\n (move-to-column column))\n (indent-line-to column)) ;; in text part, do normal indent\n (indent-line-to column))) ;; not lidr, do normal indent\n\n(defun idris-simple-indent-tab-to-tab-stop ()\n \"A version of `tab-to-tab-stop' that takes literate Idris into account.\"\n (let ((indent (idris-simple-indent-current-indentation))\n (stops tab-stop-list)\n indent-to)\n (while (and stops (>= indent (car stops)))\n (setq stops (cdr stops)))\n (setq indent-to (if stops (car stops) 0))\n (idris-simple-indent-indent-line-to indent-to)))\n\n;; Partly stolen from `indent-relative' in indent.el:\n(defun idris-simple-indent ()\n \"Space out to under next visible indent point.\nIndent points are positions of non-whitespace following whitespace in\nlines preceeding point. A position is visible if it is to the left of\nthe first non-whitespace of every nonblank line between the position and\nthe current line. If there is no visible indent point beyond the current\ncolumn, `tab-to-tab-stop' is done instead.\"\n (interactive)\n ;; just insert two spaces for lidr if not on a code line\n (if (and (idris-lidr-p)\n (save-excursion (beginning-of-line) (not (looking-at-p \">\"))))\n (progn (beginning-of-line)\n (insert \" \")\n (skip-chars-forward \" \"))\n ;; otherwise we're in code - do code indenting\n (let* ((start-column (current-column))\n (invisible-from nil) ; nil means infinity here\n (indent\n (catch 'idris-simple-indent-break\n (save-excursion\n (while (progn (beginning-of-line)\n (not (bobp)))\n (forward-line -1)\n (if (not (if (idris-lidr-p) ;; if this line isn't whitespace-only\n (or (looking-at \">[ \\t]*\\n\") ;; whitespace only\n (looking-at \"[^>]\")) ;; not code\n (looking-at \"[ \\t]*\\n\")))\n (let ((this-indentation (idris-simple-indent-current-indentation)))\n (if (or (not invisible-from)\n (< this-indentation invisible-from))\n (if (> this-indentation start-column)\n (setq invisible-from this-indentation)\n (let ((end (line-beginning-position 2)))\n (skip-chars-forward \" \\t\" end)\n ;; Current indent + 2 is a valid stop\n (if (= (current-column) start-column)\n (forward-char 2)\n (progn\n (move-to-column start-column)\n ;; Is start-column inside a tab on this line?\n (if (> (current-column) start-column)\n (backward-char 1))\n (or (looking-at \"[ \\t]\")\n (skip-chars-forward \"^ \\t\" end))\n (skip-chars-forward \" \\t\" end)))\n (let ((col (current-column)))\n (throw 'idris-simple-indent-break\n (if (or (= (point) end)\n (and invisible-from\n (> col invisible-from)))\n invisible-from\n col)))))))))))))\n (if indent\n (let ((opoint (point-marker)))\n (idris-simple-indent-indent-line-to indent)\n (if (> opoint (point))\n (goto-char opoint))\n (set-marker opoint nil))\n (idris-simple-indent-tab-to-tab-stop)))))\n\n(defun idris-simple-indent-backtab ()\n \"Indent backwards. Dual to `idris-simple-indent'.\"\n (interactive)\n (let ((current-indent (idris-simple-indent-current-indentation))\n (indent-to (cons 0 0)))\n (idris-simple-indent-indent-line-to 0)\n (while (and (< (idris-simple-indent-current-indentation) (1- current-indent))\n (<= (cdr indent-to) (car indent-to)))\n (idris-simple-indent)\n (setf (cdr indent-to) (car indent-to))\n (setf (car indent-to) (idris-simple-indent-current-indentation)))\n (idris-simple-indent-indent-line-to (cdr indent-to))))\n\n\n(defun idris-simple-indent-newline-same-col ()\n \"Make a newline and go to the same column as the current line.\"\n (interactive)\n (let ((start-end\n (save-excursion\n (let* ((start (line-beginning-position))\n (end (progn (goto-char start)\n (search-forward-regexp\n \"[^ ]\" (line-end-position) t 1))))\n (when end (cons start (1- end)))))))\n (newline)\n (if start-end\n (insert (buffer-substring-no-properties\n (car start-end) (cdr start-end))))))\n\n\n;;;###autoload\n(define-minor-mode idris-simple-indent-mode\n \"Simple Idris indentation mode that uses simple heuristic.\nIn this minor mode, `indent-for-tab-command' (bound to by\ndefault) will move the cursor to the next indent point in the\nprevious nonblank line, whereas `idris-simple-indent-backtab'\n\\ (bound to by default) will move the cursor the\nprevious indent point. An indent point is a non-whitespace\ncharacter following whitespace.\n\nRuns `idris-simple-indent-hook' on activation.\"\n :lighter \" Ind\"\n :group 'idris-simple-indent\n :keymap '(([backtab] . idris-simple-indent-backtab))\n (kill-local-variable 'indent-line-function)\n (when idris-simple-indent-mode\n (set (make-local-variable 'indent-line-function) 'idris-simple-indent)\n (run-hooks 'idris-simple-indent-hook)))\n\n;; The main functions.\n;;;###autoload\n(defun turn-on-idris-simple-indent ()\n \"Turn on function `idris-simple-indent-mode'.\"\n (interactive)\n (idris-simple-indent-mode))\n\n(defun turn-off-idris-simple-indent ()\n \"Turn off function `idris-simple-indent-mode'.\"\n (interactive)\n (idris-simple-indent-mode 0))\n\n;; Provide ourselves:\n\n(provide 'idris-simple-indent)\n\n;;; idris-simple-indent.el ends here\n" }, { "path": "idris-syntax.el", "content": ";; idris-syntax.el --- idris syntax highlighting -*- lexical-binding: t -*-\n;;\n;; Copyright (C) 2013 tim dixon, David Raymond Christiansen and Hannes Mehnert\n;;\n;; Authors: tim dixon ,\n;; David Raymond Christiansen ,\n;; Hannes Mehnert \n;;\n;; This program is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n(require 'idris-core)\n(require 'idris-common-utils)\n(require 'cl-lib)\n\n(defgroup idris-faces nil\n \"Fonts and colors for Idris code.\n\nBecause Idris's highlighting is semantic rather than syntactic,\nthere aren't really very good defaults to appeal to from\nfont-lock. You may need to change these settings to work well\nwith your favorite theme. If you do so, please consider\ncontributing the settings upstream to the theme maintainer.\"\n :prefix 'idris :group 'idris)\n\n(defface idris-identifier-face\n '((t nil))\n \"The face to highlight Idris identifiers with.\"\n :group 'idris-faces)\n\n(defface idris-hole-face\n '((t (:inherit idris-identifier-face)))\n \"The face to highlight Idris holes with.\"\n :group 'idris-faces)\n\n(defface idris-keyword-face\n '((t (:inherit font-lock-keyword-face)))\n \"The face to highlight Idris keywords with.\"\n :group 'idris-faces)\n\n(defface idris-module-face\n '((t (:inherit font-lock-variable-name-face)))\n \"The face to highlight Idris module names with.\"\n :group 'idris-faces)\n\n(defface idris-directive-face\n '((t (:inherit font-lock-keyword-face)))\n \"The face to highlight Idris compiler directives.\"\n :group 'idris-faces)\n\n(defface idris-directive-argument-face\n '((t (:inherit font-lock-preprocessor-face)))\n \"The face to highlight arguments to Idris directives.\"\n :group 'idris-faces)\n\n(defface idris-definition-face\n '((t (:inherit font-lock-function-name-face)))\n \"The face to highlight things being defined in.\"\n :group 'idris-faces)\n\n(defface idris-parameter-face\n '((t (:inherit font-lock-constant-face)))\n \"The face to highlight formal parameters to function definitions with.\"\n :group 'idris-faces)\n\n(defface idris-colon-face\n '((t (:inherit font-lock-variable-name-face)))\n \"The face to highlight ':' in type annotations with.\"\n :group 'idris-faces)\n\n(defface idris-equals-face\n '((t (:inherit font-lock-variable-name-face)))\n \"The face to highlight '=' in definitions with.\"\n :group 'idris-faces)\n\n(defface idris-operator-face\n '((t (:inherit font-lock-variable-name-face)))\n \"The face to highlight operators with.\"\n :group 'idris-faces)\n\n(defface idris-char-face\n '((t (:inherit font-lock-string-face)))\n \"The face used to highlight character literals in Idris\"\n :group 'idris-faces)\n\n(defface idris-unsafe-face\n '((t (:inherit font-lock-warning-face)))\n \"The face used to highlight unsafe Idris features, such as %assert_total.\"\n :group 'idris-faces)\n\n\n(defvar idris-definition-keywords\n '(\"data\" \"codata\" \"constructor\" \"interface\" \"record\" \"postulate\")\n \"Keywords that introduce some identifier.\")\n\n(defvar idris-operator-regexp\n (let ((op \"-!#$%&*+./<=>@\\\\\\\\^|~:\"))\n (concat \"\\\\?[\" op \"]+\" ; starts with ?, has at least one more opchar\n \"\\\\|\" \"[\"op\"][\" op \"?]*\")) ; doesn't start with ?\n \"A regular expression matching an Idris operator.\")\n\n(defconst idris-syntax-table\n (let ((st (make-syntax-table)))\n\n ;; Matching parens\n (modify-syntax-entry ?\\( \"()\" st)\n (modify-syntax-entry ?\\) \")(\" st)\n (modify-syntax-entry ?\\[ \"(]\" st)\n (modify-syntax-entry ?\\] \")[\" st)\n\n ;; Matching {}, but with nested comments\n (modify-syntax-entry ?\\{ \"(} 1bn\" st)\n (modify-syntax-entry ?\\} \"){ 4bn\" st)\n (modify-syntax-entry ?\\n \">\" st)\n\n ;; ' and _ can be part of names, so give them symbol constituent syntax\n (modify-syntax-entry ?' \"_\" st)\n (modify-syntax-entry ?_ \"_\" st)\n\n ;; Idris operator chars get punctuation syntax\n (mapc #'(lambda (ch) (modify-syntax-entry ch \".\" st))\n \"!#$%&*+./<=>@^|~:\")\n ;; - is an operator char but may also be 1st or 2nd char of comment starter\n ;; -- and the 1st char of comment end -}\n (modify-syntax-entry ?\\- \". 123\" st)\n\n ;; Whitespace is whitespace\n (modify-syntax-entry ?\\ \" \" st)\n (modify-syntax-entry ?\\t \" \" st)\n\n ;; ;; Strings\n (modify-syntax-entry ?\\\" \"\\\"\" st)\n (modify-syntax-entry ?\\\\ \"/\" st)\n\n st))\n\n(defconst idris-keywords\n '(\"abstract\" \"case\" \"covering\" \"default\" \"do\" \"dsl\" \"else\" \"export\" \"if\"\n \"implementation\" \"implicit\" \"import\" \"in\" \"infix\" \"infixl\" \"infixr\"\n \"module\" \"mutual\" \"namespace\" \"of\" \"let\" \"parameters\" \"partial\"\n \"pattern\" \"prefix\" \"private\" \"proof\" \"public\" \"rewrite\" \"syntax\"\n \"tactics\" \"then\" \"total\" \"using\" \"where\" \"with\"))\n\n\n(defconst idris-special-char-regexp\n (let ((idris-special-chars\n (cl-loop for code\n across \"0abfnrtv\\\"'\\\\\"\n collecting (concat \"'\\\\\" (string code) \"'\")))\n (idris-ascii-escapes\n (cl-loop for esc\n in '(\"NUL\" \"SOH\" \"STX\" \"ETX\" \"EOT\" \"ENQ\"\n \"ACK\" \"BEL\" \"BS\" \"HT\" \"LF\" \"VT\" \"FF\"\n \"CR\" \"SO\" \"SI\" \"DLE\" \"DC1\" \"DC2\"\n \"DC3\" \"DC4\" \"NAK\" \"SYN\" \"ETB\" \"CAN\"\n \"EM\" \"SUB\" \"ESC\" \"FS\" \"GS\" \"RS\" \"US\"\n \"SP\" \"DEL\")\n collecting (concat \"'\\\\\" esc \"'\"))))\n (concat \"\\\\(?:'\\\"'\\\\)\"\n \"\\\\|\"\n \"\\\\(?:'\\\\\\\\[0-9]+'\\\\)\"\n \"\\\\|\"\n \"\\\\(?:'\\\\\\\\o[0-7]+'\\\\)\"\n \"\\\\|\"\n \"\\\\(?:'\\\\\\\\x[0-9a-fA-F]+'\\\\)\"\n \"\\\\|\"\n \"\\\\(?:'[^'\\\\]'\\\\)\"\n \"\\\\|\"\n (regexp-opt (append idris-ascii-escapes idris-special-chars)))))\n\n(defun idris-syntax-propertize-function (begin end)\n \"Add syntax properties to a region of the buffer that the\nsyntax table won't support, such as characters.\"\n (save-excursion\n (goto-char begin)\n (while (re-search-forward idris-special-char-regexp end t)\n (let ((open (match-beginning 0))\n (close (match-end 0)))\n (add-text-properties open (1+ open) '(syntax-table (7 . ?\\')))\n (add-text-properties (1- close) close '(syntax-table (7 . ?\\')))))\n ;; Backslash \\ is not escaping in \\(x, y) -> x + y.\n (goto-char begin)\n (while (re-search-forward \"\\\\\\\\(\" end t)\n (let ((open (match-beginning 0)))\n (add-text-properties open (1+ open) '(syntax-table (1 . nil)))))))\n\n(defconst idris-font-lock-keyword-regexp\n (regexp-opt (append idris-definition-keywords\n idris-keywords)\n 'words)\n \"A regexp for matching Idris keywords.\")\n\n(defun idris-font-lock-literate-search (regexp lidr limit)\n \"Find REGEXP in Idris source between point and LIMIT.\nLIDR is non-nil for literate files.\n\nSee the documentation for search-based fontification,\nesp. `font-lock-defaults', for details.\"\n (if (re-search-forward regexp limit t)\n (if (or (and (not lidr) ;; normal syntax - ensure not in docs\n (save-excursion\n (move-beginning-of-line nil)\n (not (looking-at-p \"^\\\\s-*|||\"))))\n (and lidr\n (save-excursion ;; LIDR syntax - ensure in code, not in docs\n (move-beginning-of-line nil)\n (and (looking-at-p \"^> \")\n (not (looking-at-p \"^>\\\\s-*|||\"))))))\n t\n (idris-font-lock-literate-search regexp lidr limit))\n nil))\n\n;; This should be a function so that it evaluates `idris-lidr-p' at the correct time\n(defun idris-font-lock-defaults ()\n (cl-flet ((line-start (regexp)\n (if (idris-lidr-p)\n (concat \"^>\" regexp)\n (concat \"^\" regexp))))\n `('(\n ;; Imports\n (,(line-start \"\\\\(import\\\\)\\\\s-+\\\\(public\\\\)\")\n (1 'idris-keyword-face)\n (2 'idris-keyword-face))\n ;; Documentation comments.\n (,(line-start \"\\\\s-*\\\\(|||\\\\)\\\\(.*\\\\)$\")\n (1 font-lock-comment-delimiter-face)\n (2 'idris-inline-doc-face))\n (,(apply-partially #'idris-font-lock-literate-search \"\\\\s-*\\\\(|||\\\\)\\\\(.*\\\\)$\" (idris-lidr-p))\n (1 font-lock-comment-delimiter-face)\n (2 'idris-inline-doc-face))\n (,(line-start \"\\\\s-*\\\\(|||\\\\)\\\\s-*\\\\(@\\\\)\\\\s-*\\\\(\\\\sw+\\\\)\")\n (1 font-lock-comment-delimiter-face t)\n (2 font-lock-comment-delimiter-face t)\n (3 'idris-parameter-face t))\n ;; %assert_total\n (\"%assert_total\" . 'idris-unsafe-face)\n ;; Expression-like directives: %runElab and %unify_log\n (,(apply-partially #'idris-font-lock-literate-search\n (regexp-opt '(\"%runElab\" \"%unify_log\"))\n (idris-lidr-p))\n (0 'idris-directive-face))\n ;; `%access`, `%default`, etc\n (,(line-start \"\\\\s-*\\\\(%\\\\w+\\\\)\\\\s-*\\\\(.*\\\\)\")\n (1 'idris-directive-face)\n (2 'idris-directive-argument-face))\n ;; Keywords\n (,(apply-partially #'idris-font-lock-literate-search idris-font-lock-keyword-regexp (idris-lidr-p))\n (1 'idris-keyword-face))\n ;; Operators\n (,(apply-partially #'idris-font-lock-literate-search idris-operator-regexp (idris-lidr-p)) . 'idris-operator-face)\n ;; Holes\n (,(apply-partially #'idris-font-lock-literate-search \"\\\\?[a-zA-Z_]\\\\w*\" (idris-lidr-p)) . 'idris-hole-face)\n ;; Identifiers\n (,(apply-partially #'idris-font-lock-literate-search \"[a-zA-Z_]\\\\w*\" (idris-lidr-p)) . 'idris-identifier-face)\n ;; Scary stuff\n (,(apply-partially #'idris-font-lock-literate-search\n (regexp-opt '(\"believe_me\" \"really_believe_me\" \"assert_total\" \"assert_smaller\" \"prim__believe_me\"))\n (idris-lidr-p))\n 0 'idris-unsafe-face t)\n ))))\n\n\n\n(provide 'idris-syntax)\n" }, { "path": "idris-tree-info.el", "content": ";;; idris-info.el --- Facilities for showing Idris help information -*- lexical-binding: t -*-\n\n;; Copyright (C) 2015 David Raymond Christiansen\n\n;; Author: David Raymond Christiansen \n;; Keywords: languages, tools\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; This module contains facilities for showing tree-structured output\n;; from Idris, because the ordinary Idris info buffers don't support\n;; maintaining overlays and markers.\n\n;;; Code:\n(require 'cl-lib)\n(require 'prop-menu)\n\n(require 'idris-core)\n(require 'idris-common-utils)\n(require 'idris-settings)\n(require 'idris-keys)\n(require 'idris-warnings-tree)\n\n(defvar idris-tree-info-buffer-name (idris-buffer-name :tree-viewer)\n \"The buffer used to show general, tree-structured command output.\")\n\n(defun idris-tree-info-quit ()\n \"Quit the Idris tree info viewer.\"\n (interactive)\n (idris-kill-buffer idris-tree-info-buffer-name))\n\n(defvar idris-tree-info-mode-map\n (let ((map (make-keymap)))\n (suppress-keymap map) ; remove the self-inserting char commands\n (define-key map (kbd \"q\") 'idris-tree-info-quit)\n ;;; Allow buttons to be clicked with the left mouse button in tree buffers\n (define-key map [follow-link] 'mouse-face)\n (cl-loop for keyer\n in '(idris-define-docs-keys\n idris-define-general-keys\n idris-define-active-term-keys)\n do (funcall keyer map))\n map))\n\n(easy-menu-define idris-tree-info-mode-menu idris-tree-info-mode-map\n \"Menu for the Idris tree viewer buffer.\"\n `(\"Idris Tree Viewer\"\n [\"Show term interaction widgets\" idris-add-term-widgets t]\n [\"Close Idris tree viewer buffer\" idris-tree-info-quit t]))\n\n(define-derived-mode idris-tree-info-mode fundamental-mode \"Idris Tree\"\n \"Major mode used for transient Idris tree viewers.\n\\\\{idris-tree-info-mode-map}\nInvokes `idris-tree-info-mode-hook'.\n\nThis mode should be used to display tree-structured output,\nbecause the history feature of `idris-info-mode' is incompatible\nwith overlays and markers, which the trees need..\"\n (setq-local buffer-read-only t)\n (setq-local prop-menu-item-functions '(idris-context-menu-items)))\n\n(defun idris-tree-info-buffer ()\n \"Return the Idris tree viewer buffer, creating one if it does not exist.\nEnsure that the buffer is in `idris-tree-info-mode'.\"\n (let ((buffer (get-buffer-create idris-tree-info-buffer-name)))\n (with-current-buffer buffer\n (when (not (eq major-mode 'idris-tree-info-mode))\n (idris-tree-info-mode)))\n buffer))\n\n(defun idris-tree-info-buffer-visible-p ()\n \"Return non-nil if the tree viewer is visible in any window.\"\n (if (get-buffer-window idris-tree-info-buffer-name 'visible) t nil))\n\n(defun idris-tree-info-show-multiple (trees &optional title)\n \"Show zero or more TREES in a buffer with title TITLE.\n\nThe first argument, TREES, should be an list of instances of the\nstruct `idris-tree'. If non-nil, TITLE will be shown on top of\nthe buffer.\"\n (cl-assert (cl-typep trees 'list) t)\n (with-current-buffer (idris-tree-info-buffer)\n (let ((inhibit-read-only t))\n (erase-buffer)\n (when title\n (insert (propertize title 'face 'idris-info-title-face)\n \"\\n\"))\n (dolist (tree trees)\n (cl-assert (idris-tree-p tree) t)\n (idris-tree-insert tree \"\")))\n (goto-char (point-min)))\n (unless (idris-tree-info-buffer-visible-p)\n (pop-to-buffer (idris-tree-info-buffer))\n (message \"Press q to close the tree viewer.\")))\n\n(defun idris-tree-info-show (tree &optional title)\n \"Show an instance of TREE in a buffer with title TITLE.\n\nThe first argument, `tree', should be an instance of the struct\n`idris-tree'. If non-nil, `title' will be shown on top of the\nbuffer.\"\n (cl-assert (idris-tree-p tree) t)\n (idris-tree-info-show-multiple (list tree) title))\n\n(provide 'idris-tree-info)\n;;; idris-tree-info.el ends here\n" }, { "path": "idris-warnings-tree.el", "content": ";;; idris-warnings-tree.el --- Tree view of warnings reported by Idris in buffers -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 Hannes Mehnert\n\n;; Author: Hannes Mehnert \n;; (modified slime-compiler-notes-tree.el by Helmut Eller )\n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Code:\n(require 'cl-lib)\n(require 'prop-menu)\n\n(require 'idris-core)\n(require 'idris-warnings)\n(require 'idris-common-utils)\n\n(defvar idris-notes-buffer-name (idris-buffer-name :notes)\n \"The name of the buffer containing Idris errors.\")\n\n(defvar idris-tree-printer 'idris-tree-default-printer)\n\n(defun idris-compiler-notes-list-show (notes)\n (with-current-buffer (get-buffer-create idris-notes-buffer-name)\n (idris-compiler-notes-mode)\n (let ((inhibit-read-only t)\n (window (get-buffer-window))\n (root (idris-compiler-notes-to-tree notes)))\n (erase-buffer)\n (if (null notes)\n (when window (quit-window nil window))\n (idris-tree-insert root \"\")\n (insert \"\\n\\n\")\n (message \"Press q to close, return or mouse on error to navigate to source\")\n (goto-char (point-min))\n (display-buffer idris-notes-buffer-name)))))\n\n(defun idris-tree-for-note (note)\n (let* ((buttonp (> (length (nth 0 note)) 0)) ;; if empty source location\n (button-text `(,(format \"%s line %s col %s:\" (nth 0 note) (nth 1 note) (nth 2 note))\n help-echo \"go to source location\"\n action ,#'(lambda (_)\n (idris-goto-source-location (nth 0 note)\n (nth 1 note)\n (nth 2 note))))))\n (make-idris-tree :item (nth 3 note)\n :highlighting (if (> (length note) 4) (nth 4 note) '())\n :button (if buttonp button-text nil)\n :after-button (if buttonp \"\\n\" nil)\n :plist (list 'note note)\n :print-fn idris-tree-printer\n :preserve-properties '(idris-tt-term))))\n\n(defun idris-compiler-notes-to-tree (notes)\n (make-idris-tree :item (format \"Errors (%d)\" (length notes))\n :kids (mapcar #'idris-tree-for-note notes)\n :preserve-properties '(idris-tt-term)))\n\n(defvar idris-compiler-notes-mode-map\n (let ((map (make-sparse-keymap)))\n ;;; Allow buttons to be clicked with the left mouse button in the compiler notes\n (define-key map [follow-link] 'mouse-face)\n (cl-loop for keyer\n in '(idris-define-docs-keys\n idris-define-general-keys\n idris-define-active-term-keys)\n do (funcall keyer map))\n map)\n \"Keymap used in Idris Compiler Notes mode.\")\n\n(easy-menu-define idris-compiler-notes-mode-menu idris-compiler-notes-mode-map\n \"Menu for Idris compiler notes buffers.\"\n `(\"Idris Notes\"\n [\"Show term interaction widgets\" idris-add-term-widgets t]\n [\"Close Idris info buffer\" idris-notes-quit t]))\n\n(defun idris-notes-quit ()\n (interactive)\n (idris-kill-buffer idris-notes-buffer-name))\n\n(define-derived-mode idris-compiler-notes-mode special-mode \"Compiler-Notes\"\n \"Major mode for displaying Idris compiler notes.\n\\\\{idris-compiler-notes-mode-map}\nInvokes `idris-compiler-notes-mode-hook'.\"\n (setq-local prop-menu-item-functions '(idris-context-menu-items)))\n\n(defun idris-compiler-notes-show-details ()\n (interactive)\n (let* ((tree (idris-tree-at-point))\n (note (plist-get (idris-tree.plist tree) 'note))\n (inhibit-read-only t))\n (cond ((not (idris-tree-leaf-p tree))\n (idris-tree-toggle tree))\n (t\n (idris-goto-source-location (nth 0 note) (nth 1 note) (nth 2 note))))))\n\n(defun idris-goto-location (filename)\n \"Opens buffer for FILENAME.\"\n (let ((fullpath (concat (file-name-as-directory idris-process-current-working-directory)\n filename)))\n (or (get-buffer filename)\n (get-file-buffer fullpath)\n (find-file-noselect fullpath))))\n\n(defun idris-goto-source-location (filename lineno col)\n \"Move to the source location FILENAME LINENO COL.\n\nIf the buffer containing the file is narrowed and the location is hidden,\nshow a preview and offer to widen.\"\n (let ((buf (idris-goto-location filename)))\n (set-buffer buf)\n (pop-to-buffer buf t)\n (pcase-let* ((old-start (point-min)) ; The start and end taking\n (old-end (point-max)) ; narrowing into account\n (`(,new-location . ,widen-p)\n (save-excursion\n (save-restriction\n (widen)\n (goto-char (point-min))\n (let* ((start (line-beginning-position lineno))\n (location (goto-char (+ start col))))\n ;; If the location is invisible, offer to make it visible\n (if (or (< location old-start) (> location old-end))\n (if (y-or-n-p \"Location is not visible. Widen? \")\n (cons location t)\n (cons nil nil))\n (cons location nil)))))))\n (when new-location\n (when widen-p (widen))\n (goto-char new-location)))))\n\n;;;;;; Tree Widget\n\n(cl-defmacro with-struct ((conc-name &rest slots) struct &body body)\n \"Like `with-slots' but works only for structs.\n\\(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)\"\n (declare (indent 2))\n (let ((struct-var (gensym \"struct\")))\n `(let ((,struct-var ,struct))\n (cl-symbol-macrolet\n ,(mapcar (lambda (slot)\n (cl-etypecase slot\n (symbol `(,slot (,(intern (concat (symbol-name conc-name) (symbol-name slot))) ,struct-var)))\n (cons `(,(car slot) (,(intern (concat (symbol-name conc-name) (symbol-name (cadr slot))))\n ,struct-var)))))\n slots)\n . ,body))))\n\n(cl-defstruct (idris-tree (:conc-name idris-tree.))\n item\n highlighting\n (print-fn #'idris-tree-default-printer :type function)\n (kids '() :type (or list function))\n (collapsed-p nil :type boolean)\n (prefix \"\" :type string)\n (start-mark nil)\n (end-mark nil)\n (plist '() :type list)\n (active-p t :type boolean)\n (button nil :type list)\n (after-button \"\" :type string)\n (preserve-properties '() :type list))\n\n(defun idris-tree-leaf-p (tree)\n \"Evaluate the kids of TREE to see if we are at a leaf.\"\n (when (functionp (idris-tree.kids tree))\n (setf (idris-tree.kids tree) (funcall (idris-tree.kids tree))))\n (cl-assert (listp (idris-tree.kids tree)))\n (null (idris-tree.kids tree)))\n\n(defun idris-tree-default-printer (tree)\n (when (idris-tree.button tree)\n (apply #'insert-button (idris-tree.button tree))\n (insert (idris-tree.after-button tree)))\n (idris-propertize-spans (idris-repl-semantic-text-props (idris-tree.highlighting tree))\n (insert (idris-tree.item tree))))\n\n(defun idris-tree-decoration (tree)\n (cond ((idris-tree-leaf-p tree) \"--\")\n ((idris-tree.collapsed-p tree) \"[+]\")\n (t \"- +\")))\n\n(defun idris-tree-insert-list (list prefix)\n \"Insert a list of trees.\"\n (cl-loop for (elt . rest) on list\n do (cond (rest\n (insert prefix \" |\")\n (idris-tree-insert elt (concat prefix \" |\"))\n (insert \"\\n\"))\n (t\n (insert prefix \" `\")\n (idris-tree-insert elt (concat prefix \" \"))))))\n\n(defun idris-tree-insert-decoration (tree)\n (with-struct (idris-tree. print-fn kids collapsed-p start-mark end-mark active-p) tree\n (let ((deco (idris-tree-decoration tree)))\n (if (and active-p kids)\n (insert-button deco 'action #'(lambda (_)\n (setq buffer-read-only nil)\n (idris-tree-toggle tree)\n (setq buffer-read-only t))\n 'help-echo (if collapsed-p \"expand\" \"collapse\"))\n (insert deco))\n (insert \" \"))))\n\n(defun idris-tree-indent-item (start end prefix &optional preserve-props)\n \"Insert PREFIX at the beginning of each but the first line\nbetween START and END, copying the text properties in PRESERVE-PROPS.\nThis is used for labels spanning multiple lines.\"\n (save-excursion\n (goto-char end)\n (beginning-of-line)\n (while (< start (point))\n (let* ((props-here (text-properties-at (point)))\n (props (cl-loop for p in preserve-props\n for val = (plist-get props-here p)\n when val\n append(list p val))))\n (insert-before-markers (apply #'propertize prefix props))\n (forward-line -1)))))\n\n(defun idris-tree-insert (tree prefix)\n \"Insert TREE prefixed with PREFIX at point.\"\n (unless (idris-tree-p tree) (error \"%s is not an idris-tree\" tree))\n (with-struct (idris-tree. print-fn kids collapsed-p start-mark end-mark active-p preserve-properties)\n tree\n (let ((line-start (line-beginning-position)))\n (setf start-mark (point-marker))\n (idris-tree-insert-decoration tree)\n (funcall print-fn tree)\n (idris-tree-indent-item start-mark (point) (concat prefix \" \") preserve-properties)\n (add-text-properties line-start (point) (list 'idris-tree tree))\n (set-marker-insertion-type start-mark t)\n (when (not collapsed-p)\n (when (functionp kids)\n (setf kids (funcall kids))\n (cl-assert (listp kids)))\n (when kids\n (terpri (current-buffer))\n (idris-tree-insert-list kids prefix)))\n (setf (idris-tree.prefix tree) prefix)\n (setf end-mark (point-marker)))))\n\n(defun idris-tree-at-point ()\n (cond ((get-text-property (point) 'idris-tree))\n (t (error \"No tree at point\"))))\n\n(defun idris-tree-delete (tree)\n \"Delete the region for TREE.\"\n (delete-region (idris-tree.start-mark tree)\n (idris-tree.end-mark tree)))\n\n(defun idris-tree-toggle (tree)\n \"Toggle the visibility of TREE's children.\"\n (with-struct (idris-tree. collapsed-p start-mark end-mark prefix) tree\n (save-excursion\n (setf collapsed-p (not collapsed-p))\n (goto-char start-mark)\n (idris-tree-delete tree)\n (insert-before-markers \" \") ; move parent's end-mark\n (backward-char 1)\n (idris-tree-insert tree prefix)\n (delete-char 1))\n (goto-char start-mark)))\n\n(provide 'idris-warnings-tree)\n;;; idris-warnings-tree.el ends here\n" }, { "path": "idris-warnings.el", "content": ";;; idris-warnings.el --- Mark warnings reported by Idris in buffers -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Mehnert\n\n;; Author: Hannes Mehnert \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n(require 'idris-core)\n(require 'idris-common-utils)\n(require 'cl-lib)\n\n(defface idris-warning-face\n '((((supports :underline (:style wave)))\n :underline (:style wave :color \"red\"))\n (t\n :inherit warning))\n \"Face for warnings from the compiler.\"\n :group 'idris-faces)\n\n(defvar idris-warnings-buffers '() \"All buffers which have warnings.\")\n(defvar-local idris-warnings '() \"All warnings in the current buffer.\")\n(defvar idris-raw-warnings '() \"All warnings from Idris.\")\n\n(defun idris-warning-event-hook-function (event)\n (pcase event\n (`(:warning ,output ,_target)\n (idris-warning-overlay output)\n t)\n (_ nil)))\n\n(defun idris-warning-reset-all ()\n (mapc #'idris-warning-reset-buffer idris-warnings-buffers)\n (setq idris-raw-warnings '())\n (setq idris-warnings-buffers '()))\n\n(defun idris-warning-reset-buffer (buffer)\n (when (buffer-live-p buffer)\n (with-current-buffer buffer (idris-warning-reset))))\n\n(defun idris-warning-reset ()\n (mapc #'delete-overlay idris-warnings)\n (setq idris-warnings '())\n (delq (current-buffer) idris-warnings-buffers))\n\n(defun idris-warning-overlay-p (overlay)\n (overlay-get overlay 'idris-warning))\n\n(defun idris-warning-overlay-at-point (point)\n \"Return the overlay for a note starting at POINT, otherwise nil.\"\n (cl-find point (cl-remove-if-not 'idris-warning-overlay-p (overlays-at point))\n :key 'overlay-start))\n\n(defun idris-warning-overlay (warning)\n \"Add a compiler warning to the buffer as an overlay.\nMay merge overlays, if there's already one in the same location.\nWARNING is of form (filename (startline startcolumn) (endline endcolumn)\nmessage &optional highlighting-spans).\nAs of 20140807 (Idris 0.9.14.1-git:abee538) (endline endcolumn)\nis mostly the same as (startline startcolumn)\"\n (cl-destructuring-bind (filename sl1 sl2 message spans) warning\n (let ((startline (if (>=-protocol-version 2 1)\n (1+ (nth 0 sl1))\n (nth 0 sl1)))\n (startcol (if (>=-protocol-version 2 1)\n (nth 1 sl1)\n (1- (nth 1 sl1))))\n (endline (if (>=-protocol-version 2 1)\n (1+ (nth 0 sl2))\n (nth 0 sl2)))\n (endcol (if (>=-protocol-version 2 1)\n (nth 1 sl2)\n (1- (nth 1 sl2)))))\n (push (list filename startline startcol message spans) idris-raw-warnings)\n (let* ((fullpath (concat (file-name-as-directory idris-process-current-working-directory)\n filename))\n (buffer (get-file-buffer fullpath)))\n (when (not (null buffer))\n (with-current-buffer buffer\n (save-excursion\n (save-restriction\n (widen) ;; Show errors at the proper location in narrowed buffers\n (goto-char (point-min))\n (let* ((startp (line-beginning-position startline))\n (endp (line-end-position startline))\n (start (+ startp startcol))\n (end (if (and (= startline endline) (= startcol endcol))\n ;; a hack to have warnings, which point to empty lines, reported\n (if (= startp endp)\n (progn (goto-char startp)\n (insert \" \")\n (1+ endp))\n endp)\n (+ (line-beginning-position endline) endcol)))\n (overlay (idris-warning-overlay-at-point startp)))\n (if overlay\n (idris-warning-merge-overlays overlay message)\n (idris-warning-create-overlay start end message)))))))))))\n\n(defun idris-warning-merge-overlays (overlay message)\n (overlay-put overlay 'help-echo\n (concat (overlay-get overlay 'help-echo) \"\\n\" message)))\n\n(defun idris-warning-create-overlay (start end message)\n (let ((overlay (make-overlay start end)))\n (overlay-put overlay 'idris-warning message)\n (overlay-put overlay 'help-echo message)\n (overlay-put overlay 'face 'idris-warning-face)\n (overlay-put overlay 'mouse-face 'highlight)\n (push overlay idris-warnings)\n (unless (memq (current-buffer) idris-warnings-buffers)\n (push (current-buffer) idris-warnings-buffers))\n overlay))\n\n(provide 'idris-warnings)\n" }, { "path": "idris-xref.el", "content": ";;; idris-xref.el --- Xref backend for Idris -*- lexical-binding: t -*-\n;; Copyright (C) 2022 Marek L.\n\n;; Author: Marek L \n;; Keywords: languages, Idris, Xref\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n;;\n\n;;; Code:\n\n(require 'xref)\n(require 'inferior-idris)\n(require 'idris-common-utils)\n\n;; TODO: Define as idris-file-extension\n(defconst idris-xref-idris-file-extension \"idr\")\n\n(defgroup idris-xref nil \"Idris Xref Backend.\" :prefix 'idris :group 'idris)\n\n(defcustom idris-xref-idris-source-location \"\"\n \"Path to local Idris language codebase repository.\"\n :type 'directory\n :group 'idris-xref)\n\n(defcustom idris-xref-idris-source-locations '()\n \"List of additional directories to perform lookup for a term.\nTo support jump to definition for Idris build-in types\nset `idris-xref-idris-source-location' instead.\"\n :type '(repeat directory)\n :group 'idris-xref)\n\n;; TODO: Memoize\n(defun idris-xref-idris-source-directories ()\n \"Return list of directories from Idris repository to do lookup for a term.\"\n (when (and idris-xref-idris-source-location (file-directory-p idris-xref-idris-source-location))\n (let ((src-dir (expand-file-name \"src\" idris-xref-idris-source-location))\n (libs-dir (expand-file-name \"libs\" idris-xref-idris-source-location)))\n (when (and (file-directory-p src-dir) (file-directory-p libs-dir))\n (cons src-dir\n (seq-filter #'file-directory-p\n (mapcar (lambda (dir) (expand-file-name dir libs-dir))\n (seq-remove (lambda (dir) (string-match-p \"\\\\.\" dir))\n (directory-files libs-dir)))))))))\n\n(defun idris-xref-backend ()\n \"An `xref-backend-functions' implementation for `idris-mode'.\"\n 'idris)\n\n(cl-defmethod xref-backend-identifier-at-point ((_backend (eql idris)))\n \"Alias for `idris-name-at-point'.\"\n (idris-name-at-point))\n\n(cl-defmethod xref-backend-definitions ((_backend (eql idris)) symbol)\n \"Return a list of Xref objects candidates matching SYMBOL.\"\n\n (mapcar #'idris-xref-make-xref\n (mapcar #'idris-xref-normalise (idris-xref-find-definitions symbol))))\n\n(cl-defmethod xref-backend-apropos ((_backend (eql idris)))\n \"Not yet supported.\"\n nil)\n\n(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql idris)))\n \"Not yet supported.\"\n nil)\n\n(defun idris-xref-find-definitions (symbol)\n \"Return a list of Idris candidate locations matching SYMBOL.\"\n (car (idris-eval `(:name-at ,symbol))))\n\n(defun idris-xref-normalise (candidate)\n \"Return normalised CANDIDATE.\n\nIt will try add filename absolute path if not present and\nupdate coordinates to be indexed from 1 as expected by Emacs.\"\n (pcase-let ((`(,term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,end-line ,end-col))\n candidate))\n (let ((new-fn (idris-xref-filepath term fn)))\n `(,term (:filename ,new-fn)\n (:start ,(1+ start-line) ,start-col)\n (:end ,(1+ end-line) ,end-col)))))\n\n(defun idris-xref-make-xref (location)\n \"Return a new Xref object from LOCATION.\"\n (pcase-let ((`(,term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,_end-line ,_end-col))\n location))\n (xref-make term\n (if (file-exists-p fn)\n (xref-make-file-location fn start-line start-col)\n (xref-make-bogus-location (format \"%s : %s\" term fn))))))\n\n(defun idris-xref-filepath (term file)\n \"Return filepath for TERM.\nIf FILE is path to existing file returns the FILE.\nOtherwise try find the corresponding FILE for TERM in `idris-xref-directories'.\"\n (if (file-exists-p file)\n file\n (let ((file-paths (idris-xref-abs-filepaths term (idris-xref-directories))))\n (if (null file-paths)\n file\n ;; TODO: Instead of getting the first filepath build list of candidates\n (car file-paths)))))\n\n(defun idris-xref-directories ()\n \"List of directories to perform lookup for file containing a term.\nThe list consist of `idris-process-current-working-directory',\n`idris-xref-idris-source-directories' and `idris-xref-idris-source-locations'.\"\n (append\n (and idris-process-current-working-directory (list idris-process-current-working-directory))\n (idris-xref-idris-source-directories)\n (seq-filter #'file-directory-p idris-xref-idris-source-locations)))\n\n(defun idris-xref-relative-filepath-from-term (term)\n \"Return relative Idris file path created from TERM.\"\n (let* ((term-parts (reverse (butlast (split-string term \"\\\\.\"))))\n (file-base (pop term-parts))\n (file-name (concat file-base \".\" idris-xref-idris-file-extension)))\n (apply 'idris-file-name-concat (reverse (cons file-name term-parts)))))\n\n(defun idris-xref-abs-filepaths (term locations)\n \"Return absolute filepaths build from TERM and LOCATIONS.\"\n (let ((rel-path (idris-xref-relative-filepath-from-term term)))\n ;; TODO: Check also the content of file for presence of the term\n (seq-filter #'file-exists-p\n (mapcar (lambda (loc) (expand-file-name rel-path loc))\n locations))))\n\n(provide 'idris-xref)\n;;; idris-xref.el ends here\n" }, { "path": "inferior-idris.el", "content": ";;; inferior-idris.el --- Run an Idris interpreter using S-Expression communication protocol -*- lexical-binding: t -*-\n\n;; Copyright (C) 2013 Hannes Mehnert\n\n;; Author: Hannes Mehnert \n\n;; License:\n;; Inspiration is taken from SLIME/DIME (http://common-lisp.net/project/slime/) (https://github.com/dylan-lang/dylan-mode)\n;; Therefore license is GPL\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This file is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs; see the file COPYING. If not, write to\n;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\n;; Boston, MA 02111-1307, USA.\n\n;;; Commentary:\n;; Handle connection to Idris and expose `idris-eval' and `idris-eval-sync'\n;; functions to be used by other modules for communication with Idris.\n;;\n\n(require 'idris-core)\n(require 'idris-settings)\n(require 'idris-common-utils)\n(require 'cl-lib)\n(require 'idris-events)\n(require 'idris-log)\n(require 'idris-warnings)\n\n;;; Code:\n\n(defvar idris-process nil\n \"The Idris process.\")\n\n(defvar idris-connection nil\n \"The Idris connection.\")\n\n(defvar idris-process-buffer-name (idris-buffer-name :process)\n \"The name of the Idris process buffer.\")\n\n(defvar idris-connection-buffer-name (idris-buffer-name :connection)\n \"The name of the Idris connection buffer.\")\n\n(defun idris-version-hook-function (event)\n (pcase event\n (`(:protocol-version ,version ,minor)\n (setf idris-protocol-version version)\n (setf idris-protocol-version-minor minor)\n (remove-hook 'idris-event-hooks 'idris-version-hook-function)\n t)))\n\n(defvar-local idris-load-packages nil\n \"The list of packages to be loaded by Idris.\nSet using file or directory variables.\")\n\n(defun idris-compute-flags ()\n \"Calculate the command line options to use when running Idris.\"\n (append (cl-loop for p in idris-load-packages\n collecting \"-p\"\n collecting p)\n idris-interpreter-flags\n (cl-mapcan #'funcall\n idris-command-line-option-functions)))\n\n(defvar idris-current-flags nil\n \"The list of `command-line-args' actually passed to Idris.\nThis is maintained to restart Idris when the arguments change.\")\n\n(defun idris-connect (port)\n \"Establish a connection with a Idris REPL at PORT.\"\n (when (not idris-connection)\n (setq idris-connection\n (open-network-stream \"Idris IDE support\" idris-connection-buffer-name \"127.0.0.1\" port))\n (add-hook 'idris-event-hooks 'idris-version-hook-function)\n (add-hook 'idris-event-hooks 'idris-log-hook-function)\n (add-hook 'idris-event-hooks 'idris-warning-event-hook-function)\n (add-hook 'idris-event-hooks 'idris-prover-event-hook-function)\n\n (if idris-hole-show-on-load\n (progn\n (add-hook 'idris-load-file-success-hook 'idris-list-holes)\n (add-hook 'idris-prover-success-hook 'idris-list-holes))\n (remove-hook 'idris-load-file-success-hook 'idris-list-holes-on-load)\n (remove-hook 'idris-load-file-success-hook 'idris-list-holes)\n ;; TODO: In future decouple prover sucess hook from being affected by\n ;; idris-hole-show-on-load variable\n (remove-hook 'idris-prover-success-hook 'idris-list-holes-on-load)\n (remove-hook 'idris-prover-success-hook 'idris-list-holes))\n\n (set-process-filter idris-connection 'idris-output-filter)\n (set-process-sentinel idris-connection 'idris-sentinel)\n (set-process-query-on-exit-flag idris-connection t)\n (setq idris-process-current-working-directory \"\")\n (run-hooks 'idris-run-hook)\n (message \"Connection to Idris established.\")))\n\n(defun idris-sentinel (_process msg)\n (message \"Idris disconnected: %s\" (substring msg 0 -1))\n (when idris-connection\n (delete-process idris-connection)\n (setq idris-connection nil))\n (when idris-process\n (delete-process idris-process)\n (setq idris-process nil)))\n\n(defvar idris-process-port-output-regexp (rx (? (group (+ any (not num)))) (group (+ (any num))))\n \"Regexp used to match the port of an Idris process.\")\n(defvar idris-process-exact-port-output-regexp (rx bol (group (+ (any num))) eol)\n \"Regexp to match port number.\")\n(defvar idris-exact-port-matcher 1\n \"Port number matcher.\")\n\n(defvar idris-process-port-with-warning-output-regexp\n (rx (? (group (+ any (not num)))) (group (** 3 4 (any num)))))\n;; ^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^\n;; ^ ^\n;; | |\n;; | +---- port number\n;; +------------------------------- warning message\n(defvar idris-warning-matcher 1\n \"Warning from Idris.\")\n\n(defvar idris-warning-port-matcher 2\n \"Port number matcher with warning.\")\n\n;; idris-process-filter is broken in theoreticaly.\n(defun idris-process-filter (string)\n \"Accept STRING output from the process.\"\n (if idris-connection\n string\n ;; Idris sometimes prints a warning prior to the port number, which causes\n ;; `string-match' to return 0\n (cl-flet ((idris-warn (msg)\n (unless (or (null msg) (string-blank-p msg))\n (message \"Warning from Idris: %s\" msg))))\n (if (string-match idris-process-exact-port-output-regexp string)\n (idris-connect (string-to-number (match-string idris-exact-port-matcher string)))\n (if (not (string-match idris-process-port-with-warning-output-regexp string))\n (idris-warn string)\n (idris-warn (match-string idris-warning-matcher string))\n (idris-connect (string-to-number (match-string idris-warning-port-matcher string)))))\n \"\")))\n\n(defun idris-show-process-buffer (string)\n \"Show the Idris process buffer if STRING is non-empty.\"\n (when (> (length string) 0)\n (pop-to-buffer (get-buffer idris-process-buffer-name))))\n\n(defun idris-output-filter (process string)\n \"Accept STRING output from the socket and PROCESS all complete messages.\"\n (with-current-buffer (process-buffer process)\n (goto-char (point-max))\n (insert string))\n (idris-connection-available-input process))\n\n(defun idris-connection-available-input (process)\n \"Process all complete messages which arrived from Idris PROCESS.\"\n (while (idris-have-input-p process)\n (let ((event (idris-receive process)))\n (idris-event-log event nil)\n (idris-dispatch-event event process))))\n\n(defun idris-have-input-p (process)\n \"Return `true' if a complete message is available in PROCESS buffer.\"\n (with-current-buffer (process-buffer process)\n (goto-char (point-min))\n (and (>= (buffer-size) 6)\n (>= (- (buffer-size) 6) (idris-decode-length)))))\n\n(defun idris-receive (process)\n \"Read a message from the Idris PROCESS.\"\n (with-current-buffer (process-buffer process)\n (goto-char (point-min))\n (let* ((length (idris-decode-length))\n (start (+ 6 (point)))\n (end (+ start length)))\n (cl-assert (cl-plusp length))\n (prog1 (save-restriction\n (narrow-to-region start end)\n (read (current-buffer)))\n (delete-region (point-min) end)))))\n\n(defun idris-decode-length ()\n \"Read a 24-bit hex-encoded integer from buffer.\"\n (string-to-number (buffer-substring-no-properties (point) (+ (point) 6)) 16))\n\n(defun idris-send (sexp proc)\n \"Send a SEXP to Idris over the PROC. This is the lowest level of communication.\"\n (let* ((msg (concat (idris-prin1-to-string sexp) \"\\n\"))\n (string (concat (idris-encode-length (string-bytes msg)) msg)))\n (idris-event-log sexp t)\n (process-send-string proc string)))\n\n(defun idris-encode-length (n)\n \"Encode an N (integer) into a 24-bit hex string.\"\n (format \"%06x\" n))\n\n(defun idris-prin1-to-string (sexp)\n \"Like `prin1-to-string', but don't octal-escape non-ascii characters.\"\n (with-temp-buffer\n (let (print-escape-nonascii\n print-escape-newlines\n print-length\n print-level)\n (prin1 sexp (current-buffer))\n (buffer-string))))\n\n(defvar idris-rex-continuations '()\n \"List of (ID FUNCTION [FUNCTION]) continuations waiting for RPC results.\nThe first function will be called with a final result, and the second\n (if present) will be called with intermediate output results.\")\n\n(defvar idris-continuation-counter 1\n \"Continuation serial number counter.\")\n\n(defvar idris-event-hooks '())\n\n(defun idris-dispatch-event (event process)\n (or (run-hook-with-args-until-success 'idris-event-hooks event)\n (destructure-case event\n ((:emacs-rex form continuation &optional output-continuation)\n (let ((id (cl-incf idris-continuation-counter)))\n (idris-send `(,form ,id) process)\n (push (if output-continuation\n (list id continuation output-continuation)\n (list id continuation))\n idris-rex-continuations)))\n ((:output value id)\n (let ((rec (assq id idris-rex-continuations)))\n ;; Commands that don't ask for :output don't get it\n (when (and rec (nth 2 rec))\n (funcall (nth 2 rec) value))))\n ((:return value id)\n (let ((rec (assq id idris-rex-continuations)))\n (cond (rec (setf idris-rex-continuations\n (remove rec idris-rex-continuations))\n (funcall (cadr rec) value))\n (t (error \"Unexpected reply: %S %S\" id value))))))))\n\n(cl-defmacro idris-rex ((&rest saved-vars) sexp intermediate &rest continuations)\n \"Remote Execute SEXP.\n\n\\\\(idris-rex (VAR ...) (SEXP) INTERMEDIATE CONTINUATIONS ...)\n\nSAVED-VARS are a list of saved variables visible in the other forms.\nEach VAR is either a symbol or a list (VAR INIT-VALUE).\n\nSEXP is evaluated and the `princ'-ed version is sent to Idris.\n\nIf INTERMEDIATE is non-nil, also register for intermediate results.\n\nCONTINUATIONS is a list of patterns with same syntax as `destructure-case'.\nThe result of the evaluation of SEXP is dispatched on CONTINUATIONS.\nThe result is either a sexp of the form (:ok VALUE) or (:error CONDITION).\nCONTINUATIONS are executed asynchronously.\n\nNote: don't use backquote syntax for SEXP, because various Emacs\nversions cannot deal with that.\"\n (declare (indent 3))\n (let ((result (gensym)))\n `(let ,(cl-loop for var in saved-vars\n collect (cl-etypecase var\n (symbol (list var var))\n (cons var)))\n (idris-dispatch-event\n (list :emacs-rex ,sexp\n (lambda (,result)\n (destructure-case ,result\n ,@continuations))\n ,@(when intermediate\n `((lambda (,result)\n (destructure-case ,result\n ,@continuations)))))\n idris-connection))))\n\n(defun idris-eval-async (sexp cont &optional failure-cont)\n \"Evaluate SEXP on the superior Idris and call CONT or FAILURE-CONT.\"\n (idris-rex (cont (buffer (current-buffer)) failure-cont)\n sexp t\n ((:ok result)\n (when cont\n (set-buffer buffer)\n (funcall cont result)))\n ((:error condition &optional _spans)\n (when failure-cont\n (set-buffer buffer)\n (funcall failure-cont condition))\n (message \"Evaluation returned an error: %s.\" condition))))\n\n;;; Synchronous requests are implemented in terms of asynchronous\n;;; ones. We make an asynchronous request with a continuation function\n;;; that `throw's its result up to a `catch' and then enter a loop of\n;;; handling I/O until that happens.\n\n(defvar idris-stack-eval-tags nil\n \"List of stack-tags of continuations waiting on the stack.\")\n\n(autoload 'idris-list-compiler-notes \"idris-commands.el\")\n(defun idris-eval (sexp &optional no-errors)\n \"Evaluate SEXP on the inferior Idris and return the result.\nIf `NO-ERRORS' is non-nil, don't trigger warning buffers and\n don't call `ERROR' if there was an Idris error.\"\n (let* ((tag (gensym (format \"idris-result-%d-\"\n (1+ idris-continuation-counter))))\n (idris-stack-eval-tags (cons tag idris-stack-eval-tags)))\n (apply\n #'funcall\n (catch tag\n (idris-rex (tag sexp)\n sexp nil\n ((:ok value &optional spans)\n (if (member tag idris-stack-eval-tags)\n (throw tag (list #'identity (cons value spans)))\n (if no-errors\n nil\n (error \"Reply to canceled synchronous eval request tag=%S sexp=%S\"\n tag sexp))))\n ((:error condition &optional _spans)\n (if no-errors\n (throw tag (list #'identity nil))\n (when (member 'warnings-tree idris-warnings-printing)\n (idris-list-compiler-notes))\n (throw tag (list #'error \"%s (synchronous Idris evaluation failed)\" condition)))))\n (let ((debug-on-quit t)\n (inhibit-quit nil))\n (while t\n (when (eq (process-status idris-process) 'exit)\n (error \"Idris process exited unexpectedly\"))\n (accept-process-output idris-connection 0.1)))))))\n\n(defvar idris-options-cache '()\n \"An alist caching the Idris interpreter options.\")\n\n(defun idris-update-options-cache ()\n (idris-eval-async '(:get-options)\n #'(lambda (opts) (setq idris-options-cache opts))))\n\n(defun idris-get-options ()\n (idris-eval '(:get-options)))\n\n(defun idris-get-option (opt)\n ;; First check the local cache\n (let ((local-val (assoc opt idris-options-cache)))\n (if local-val\n (equal (cadr local-val) :True)\n (let ((remote-val (assoc opt (car (idris-get-options)))))\n (if remote-val\n (equal (cadr remote-val) :True)\n (error \"Unknown Idris option %s\" opt))))))\n\n(defun idris-set-option (opt b)\n (let ((bi (if b :True :False)))\n (idris-rex ((buffer (current-buffer)) opt b bi)\n `(:set-option ,opt ,bi) nil\n ((:ok _res)\n (set-buffer buffer)\n (let ((cache-elt (assoc opt idris-options-cache)))\n (if cache-elt\n (setf (cadr cache-elt) bi)\n (add-to-list 'idris-options-cache (list opt bi)))))\n ((:error condition &optional _spans)\n (message \"Setting option %s to %s returned an error: %s.\" opt b condition)))))\n\n(defun idris-get-idris-version ()\n \"Ask the Idris compiler for its version information.\nReturns a cons cell whose car is a list of version number\ncomponents and whose cdr is a list of prerelease identifiers, if applicable.\nReturns nil if the version of Idris used doesn't support asking for versions.\"\n (pcase (idris-eval :version t)\n (`((,version ,prerelease)) (cons version prerelease))\n (_ nil)))\n\n(defun idris-get-idris-version-string ()\n \"Ask the Idris compiler for its version information.\nReturns result as a user-friendly string.\nReturns nil if the version of Idris used doesn't support asking for versions.\"\n (let ((version (idris-get-idris-version)))\n (if (consp version) ; returns nil on older versions of Idris\n (let* ((version-number (car version))\n (version-prerelease (cdr version)))\n (concat (mapconcat #'number-to-string version-number \".\")\n (if version-prerelease\n (concat \"-\" (mapconcat #'identity version-prerelease \"-\"))\n \"\")))\n nil)))\n\n\n(provide 'inferior-idris)\n;;; inferior-idris.el ends here\n" }, { "path": "readme.markdown", "content": "[![MELPA Stable](http://stable.melpa.org/packages/idris-mode-badge.svg)](http://stable.melpa.org/#/idris-mode) [![MELPA](http://melpa.org/packages/idris-mode-badge.svg)](http://melpa.org/#/idris-mode)\n\n[![Idris1 on Ubuntu](https://github.com/idris-hackers/idris-mode/actions/workflows/idris1.yml/badge.svg)](https://github.com/idris-hackers/idris-mode/actions/workflows/idris1.yml)\n\n[![Idris2 on Ubuntu](https://github.com/idris-hackers/idris-mode/actions/workflows/idris2.yml/badge.svg)](https://github.com/idris-hackers/idris-mode/actions/workflows/idris2.yml)\n\n\n\n# idris-mode for emacs\n\nThis is an emacs mode for editing [Idris] code.\n\nThis mode was original designed to work with version 1 of the language through an IDE-Protocol.\nIdris2 uses the next iteration of the same protocol.\nIdris-mode tries to maintain compatibility with both protocol versions, however, not all the features from the IDE-Protocol have been realised in Idris2.\nWhen using idris-mode with Idris2 your experience might be a bit clunky.\n\nPRs to both projects to get things working smoothly are more than welcome!\n\n## Note on Syntax Highlighting.\n\nSyntax highlighting functional languages is a little quirky; I've\ndeferred to haskell-mode for some things\n(e.g. `font-lock-variable-name-face` for operators) and done some\nother things as appropriate for Idris. `font-lock-type-face` isn't\nused at all, for example, and data types declared with `data` use the\nsame face as functions and values defined with `=`.\n\n\n\n## Changes\n\nSee the file [CHANGES.markdown](CHANGES.markdown) in the repository root for user-visible\nchanges between versions, starting at version 0.9.18.\n\n## Documentation\n\nThere are some docstrings spread around the mode, thus C-h m is helpful and returns the available key bindings.\nThe REPL also supports tab completion, thus pressing tab opens a buffer with the available completions.\n\nThe [extended abstract] for DTP14 gives overview of the features of idris-mode. The underlying [protocol] is described in the Idris documentation.\n\n[extended abstract]: http://davidchristiansen.dk/pubs/dtp2014-idris-mode.pdf\n[protocol]: http://docs.idris-lang.org/en/latest/reference/ide-protocol.html\n\nCertain areas of `idris-mode` show explanatory help text. When you've learned how to use `idris-mode`, you can turn these off by setting `idris-show-help-text` to `nil`.\n\n## Inferior Idris\n\nThere is now support for running an Idris interpreter in a buffer. Use\n`C-c C-l` to load the current Idris buffer into the interpreter. This will\nspawn an inferior Idris process and load the buffer. It will report warnings\nif idris reports any. Pressing `C-c C-l` again will reload that buffer - if you\nswitch to a different buffer and press `C-c C-l`, that buffer will be loaded\ninstead.\n\nCustomize `idris-interpreter-path` if Idris is not on your default path.\n\n[Idris]: http://www.idris-lang.org\n\n## Highlighting\n`idris-mode` provides two forms of source code highlighting, that work together: conventional Emacs `font-lock` to highlight things like keywords and code that has not yet been type checked, and compiler-supported semantic highlighting of identifiers (as known from Agda). Semantic highlighting is controlled by the variable `idris-semantic-source-highlighting`.\n\n## Keybindings\n`idris-mode` follows conventions from SLIME whenever possible. In particular:\n\n* For ease of typing, any sequence of three keys allows the final key to be pressed with or without the control key, unless the last key is `h`. For example, `C-c C-d d` can also be typed `C-c C-d C-d`.\n* Documentation-related commands are prefixed with `C-c C-d`.\n* Commands related to **b**uilding packages are prefixed with `C-c C-b`.\n\n## Contextual menus\n`idris-mode` makes use of semantic information from the Idris compiler to display contextual menus. By default, the graphical contextual menu is bound to the right mouse button and the textual contextual menu is bound to `C-c C-SPC`. Using these commands will display commands that are available based on what is under the mouse pointer or what is at point, respectively.\n\n## Error messages\n\nWhen loading a buffer, `idris-mode` will decorate errors from the Idris compiler with underlines. Tooltips show the error message.\nThe following error message commands are available:\n\n* `M-n`: Move the point to the next compiler note\n* `M-p`: Move the point to the previous compiler note\n\n## Colors and fonts\nIdris mode displays output from the Idris compiler with full semantic highlighting. It is quite possible that this is ugly in your color scheme. If that is the case, you can use `M-x customize-group RET idris-faces RET` to modify them. In particular, some users don't like the background color for the currently loaded region of the buffer. This is controlled by `idris-loaded-region-face`. Remove all its properties to make it disappear.\n\n## Interactive editing\n\n\n\nThe following commands are available when there is an inferior Idris process (which is started on demand by the commands):\n\n* `C-c C-l`: Load the current file into Idris. A prefix argument causes Idris to only load the portion of the file up to point.\n* `C-u C-u C-c C-l`: Obliterate the loading marker, switching back to loading the whole buffer.\n* `C-c C-n`, `C-c C-p`: Extend and contract the region to be loaded, if such a region exists, one line at a time.\n* `C-c C-s`: Create an initial pattern match clause for a type declaration\n* `C-c C-m`: Add missing pattern-match cases to an existing definition\n* `C-c C-a`: Attempt to solve a hole automatically. A plain prefix argument prompts for hints, while a numeric prefix argument sets the recursion depth.\n* `C-c C-S-a`: (Idris 2 only) Replace the previous proof search answer with a different attempt by the compiler. If no further attempts are available it leaves the last one unchanged.\n* `C-c C-e`: Extract a hole or provisional definition name to an explicit top level definition\n* `C-c C-c`: Case split the pattern variable under point, or fill the hole at point with a case expression.\n* `C-c C-t`: Get the type for the identifier under point. A prefix argument prompts for the name.\n* `C-c C-w`: Add a with block for the pattern-match clause under point\n* `C-c C-h a`: Search names, types, and docstrings for a given string.\n* `C-c C-z`: Pop to a presently open REPL buffer or to last Idris code buffer if invoked in REPL buffer.\n\n## Online documentation\n\nThe Idris compiler supports documentation. The following commands access it:\n* `C-c C-d d`: Show the documentation for the name under point (`:doc` at the REPL). A prefix argument prompts for the name.\n* `C-c C-d a`: Search the documentation for a string (`:apropos` at the REPL).\n* `C-c C-d t`: Search for documentation regarding a particular type (`:search` at the REPL).\n\nAdditionally, `idris-mode` integrates with `eldoc-mode`, which shows documentation overviews and type signatures in the minibuffer.\n(Eldoc support is yet to be implemented in the Idris2.)\n\n## Completion\n\n`M-Tab` or whatever you have `completion-at-point` bound to will ask the running Idris process for completions for the current identifier. Note that this command requires that the Idris interpreter is already running, because attempting to load an incomplete buffer would probably not work.\n\n## Active terms\n\nSome terms output by the Idris compiler are *active*, meaning that `idris-mode` is aware of their original representation. For these terms, commands exist to normalise them and show or hide their implicit arguments.\n\nTo see the active terms available, use the command `idris-add-term-widgets`, which is also found in the menu. To issue term commands, right-click on the triangle that points at the term. The widgets can be removed again using `idris-remove-term-widgets`.\n\nThe following keybindings are available:\n* `C-c C-m n`: Normalize the term at point (`M-x idris-normalize-term`)\n* `C-c C-m i`: Show implicits for the term at point (`M-x idris-show-term-implicits`)\n* `C-c C-m h`: Hide implicits for the term at point (`M-x idris-hide-term-implicits`)\n* `C-c C-m c`: Show the core language for the term at point (`M-x idris-show-core-term`)\n\n## Package files\n\nIdris's build system, which consists of package files ending in `.ipkg`, has rudimentary support from `idris-mode`.\nThe following commands are available in Idris buffers or package buffers; if they are run from an Idris buffer, then `idris-mode` will attempt to locate the package file automatically.\nThe mnemonic for `C-b` in the prefix is \"build\".\n* `C-c C-b c`: Clean the package, removing `.ibc` files\n* `C-c C-b b`: Build the package\n* `C-c C-b i`: Install the package to the user's repository, building first if necessary\n\nThe following commands are available in `idris-ipkg-mode`:\n* `C-c C-f`: Insert a field, with completion support. Completion for field names is also available by pressing `M-TAB`.\n\nWhen a package is present, `idris-mode` gains a few convenience features. In particular, the Idris compiler's working directory is set based on the `sourcedir` directive in the package file, and certain filenames or module names become clickable buttons, to conveniently open them.\n\nAdditionally, the command `M-x idris-start-project` will create a directory structure and initial package file for a new project.\n\n## Using packages\n`idris-mode` supports setting the packages to be loaded by the Idris process. Specifically, the buffer-local variable `idris-load-packages` is expected to contain a list of package names to be loaded. When the buffer is loaded, if the current packages loaded by the Idris process don't agree with the contents of the variable, Idris is restarted with the correct `-p` options.\n\nYou can set this variable interactively using the command `M-x idris-set-idris-load-packages`. This will add the variable as a file-local variable, so that it will be set automatically when the file is loaded in the future.\n\n## Installation\n\nIdris mode uses lexical binding and other features not available in versions of Emacs prior to 24. Thus, only Emacs 24 and up are supported.\n\nYou can install pre-built packages from [MELPA](http://melpa.org/) or [MELPA Stable](http://stable.melpa.org): `idris-mode` will automatically be enabled in `.idr` files without any further configuration. Please install a version corresponding to the version of Idris that you use. The current Git (and therefore MELPA) version of `idris-mode` will work with the current Git version of Idris, while the latest release on Hackage will work with the corresponding tagged version of `idris-mode`.\n\nIf you are using Emacs 24.4 or newer with released versions of Idris, but you want other packages from MELPA, then you can pin the version of `idris-mode` to the one found in MELPA Stable. For details, please consult the documentation for `package-pinned-packages` (`C-h v package-pinned-packages RET`).\n\nAlternatively, download the elisp files, and place them somewhere in your load path. If you're installing manually, then you also need to install the [`prop-menu` package](https://github.com/david-christiansen/prop-menu-el), which `idris-mode` uses to create contextual menus. Installation from MELPA will automatically install dependencies.\n\nIf you want `idris-mode` to be enabled by default, add the line `(require 'idris-mode)` to your `~/.emacs` or `~/.emacs.d/init.el` file.\n\nIdris mode is heavily dependent on the Idris compiler for its more advanced features. Thus, please ensure that Emacs can see your Idris binary. Emacs looks for executables in the directories specified in the variable `exec-path`, which is initialized from your PATH at startup. If Idris is not on your `PATH`, then you may need to add it to `exec-path` manually. E.g.: if you installed idris with cabal into `~/.cabal/bin`, then add the line `(add-to-list 'exec-path \"~/.cabal/bin\")` to your emacs initialization file. Alternatively, you can customize the variable `idris-interpreter-path` and provide an absolute path.\n\nExample of installation and setup for Idris2 with `use-package` package from MELPA.\n\n```elisp\n(use-package idris-mode\n :ensure t\n\n :custom\n (idris-interpreter-path \"idris2\"))\n```\n\nExample of installation and setup for Idris2 with `use-package` package directly from source.\n\n```elisp\n(use-package idris-mode\n :init (require 'idris-mode)\n :load-path \"path-to/idris-mode/root/source-code-directory/relative-to-current-file\"\n\n :custom\n (idris-interpreter-path \"idris2\"))\n```\n\n## Customization\n\nCustomize various aspects of the mode using `M-x customize-group RET idris RET`.\n\nAdditionally, you may want to update your Emacs configuration so that it does not open Idris bytecode files by default. You can do this by adding `\".ibc\"` to the variable `completion-ignored-extensions`, either in customize or by adding `(add-to-list 'completion-ignored-extensions \".ibc\")` to your `init.el`. If you use `ido`, then you may also need to set `ido-ignore-extensions` to `t`.\n\n## Keybinding conventions\n\nAll three-letter keybindings are available in versions with and without `C-` on the final key, following the convention from SLIME.\n\n## Integration with other Emacs packages\n\n### Evil mode support (Vim compatibility)\nThere is emulation for idris-vim commands in idris-mode. To enable this support please install the `evil` and `evil-leader` packages from MELPA (or your favorite source of packages) and then add `(idris-define-evil-keys)` to `init.el`.\n\nThe following commands are supported (taken from idris-vim):\n\n* `r`: Reload file\n\n* `t`: Show type\n\n* `d`: Add initial pattern-match clause\n\n* `c`: Case split\n\n* `w`: Add `with` clause\n\n* `m`: Add missing pattern-match cases\n\n* `p`: Proof search\n\n* `h`: Show documentation\n\n### Helm\n\n[`helm-idris`](https://www.github.com/david-christiansen/helm-idris) builds on `idris-mode` to provide an alternative interface to looking up documentation. It supports incremental searching in documentation and names, similar to the built-in `:apropos` and `idris-apropos` commands.\n\n### Pop Win\n\n[Pop Win](http://www.emacswiki.org/emacs/PopWin) is an Emacs utility to manage ephemeral buffers, such as completion and compilation buffers. It provides tools for controlling their position and lifetime. Pop Win requires configuration to work with `idris-mode`. An incomplete example configuration follows:\n\n```elisp\n(push 'idris-compiler-notes-mode\n popwin:special-display-config)\n(push '(idris-repl-mode\n :height 0.2\n :noselect nil\n :position bottom\n :stick t)\n popwin:special-display-config)\n```\n\n### Spacemacs\nWe have received reports that the `idris-stay-in-current-window-on-compiler-error` setting does not function properly for users of Spacemacs. The following user configuration can fix it:\n\n```elisp\n(defun dotspacemacs/user-config ()\n ; ...\n (with-eval-after-load 'idris-mode\n (setq idris-stay-in-current-window-on-compiler-error t)\n (dolist (x '(\"*idris-notes*\" \"*idris-holes*\" \"*idris-info*\"))\n (plist-put (cdr (assoc x popwin:special-display-config)) :noselect t))))\n```\n\n\n### [`frames-only-mode`](https://github.com/davidshepherd7/frames-only-mode) and many buffer pop-ups\n\n[`frames-only-mode`](https://github.com/davidshepherd7/frames-only-mode) obviates the need for emacs internal windows so that emacs can get along better with tiling managers - such as [xmonad](https://github.com/xmonad/xmonad) - by using emacs' frames instead of windows.\n\nThroughout a session with `idris-mode`, many frames will accumulate, such as `*idris-holes*`, and over time these clutter your screen. A quick simple solution is to add the following to your emacs configuration:\n\n```elisp\n(defun my-idris-mode-hook ()\n\n ;; This makes it so that especially errors reuse their frames\n ;; https://emacs.stackexchange.com/questions/327/how-can-i-block-a-frame-from-being-split/338\n ;; alternatively, add this to certain frames: (set-frame-parameter nil 'unsplittable t)\n ;; (without this, Idris throws out tons of new frames)\n (add-to-list 'display-buffer-alist\n '(\".*\". (display-buffer-reuse-window . ((reusable-frames . t)))))\n (setq idris-stay-in-current-window-on-compiler-error t)\n (setq idris-prover-restore-window-configuration t)\n\n ;; If you kill a buffer (eg, hit \"q\"), frames with these names wil also be killed\n (add-to-list 'frames-only-mode-kill-frame-when-buffer-killed-buffer-list \"*idris-repl*\")\n (add-to-list 'frames-only-mode-kill-frame-when-buffer-killed-buffer-list \"*idris-notes*\")\n (add-to-list 'frames-only-mode-kill-frame-when-buffer-killed-buffer-list \"*idris-info*\")\n (add-to-list 'frames-only-mode-kill-frame-when-buffer-killed-buffer-list \"*idris-holes*\"))\n\n(add-hook 'idris-mode-hook #'my-idris-mode-hook)\n```\n\n### Flycheck (asynchronous syntax checks in buffer)\n\nTo enable on-the-fly syntax checking of Idris code using `flycheck` add these lines to your configuration:\n\n```elisp\n(require 'flycheck-idris)\n(add-hook 'idris-mode-hook #'flycheck-mode)\n```\n\nExample using `use-package` package:\n```elisp\n(use-package idris-mode\n :ensure t\n\n :config\n (require 'flycheck-idris) ;; Syntax checker\n (add-hook 'idris-mode-hook #'flycheck-mode))\n```\n\n### Xref (Cross-referencing commands)\n\nJump to definitions `xref-find-definitions` (`M-.`) in current file or project is supported as long as Idris compiler returns file path to the definition.\nTo support jump to definitions for which Idris could not find relevant source file you may want customise `idris-xref-idris-source-location` and `idris-xref-idris-source-locations`.\nYou can do that interactively using `M-x customize-group` [enter] -> idris-xref [enter] command or\nprogramatically.\nExample using `use-package` package.\n\n```elisp\n(use-package idris-mode\n :ensure t ;; Installing from (M)ELPA\n\n :custom\n (idris-interpreter-path \"idris2\")\n\n ;; Assuming you did `git clone git@github.com:idris-lang/Idris2.git ~/sources/idris2`\n (idris-xref-idris-source-location \"~/sources/idris2\")\n ;; Paths to random additional idris packages you may be using\n (idris-xref-idris-source-locations '(\"~/sources/idris-ncurses/src\"\n \"~/sources/idris-foo/src\")))\n```\n\n### Hideshow Minor Mode (hs-minor-mode)\n\nIf you have enabled hs-minor-mode globally you may want to disable it for Idris prover buffers\nas it may cause errors in some situations (When invoking `idris-quit` command for example).\nExample of enabling `hs-minor-mode` for all buffers derived from `prog-mode` except the\n`idris-prover` buffers.\n\n```elisp\n\n(add-hook 'prog-mode-hook\n #'(lambda ()\n (if (derived-mode-p 'idris-prover-script-mode)\n (hs-minor-mode -1)\n (hs-minor-mode))))\n```\n" }, { "path": "test/idris-commands-test.el", "content": ";;; idris-commands-test.el --- Tests for interactive commands -*- lexical-binding: t -*-\n\n;; Keywords: languages\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; This is a collection of tests for interactive commands in idris-mode.\n\n;;; Code:\n\n;; to load idris-test-utils\n(let ((test-dir (file-name-directory (or load-file-name buffer-file-name))))\n (add-to-list 'load-path test-dir))\n\n(require 'idris-commands)\n(require 'idris-test-utils)\n\n(require 'ert)\n(require 'cl-lib)\n\n(defun normalised-buffer-list ()\n \"Buffer list without randomly appearing internal buffer(s).\"\n (cl-delete-if (lambda (b) (string-match-p \"code-conversion-work\" (buffer-name b)))\n (buffer-list)))\n\n(ert-deftest idris-test-idris-run ()\n (let ((buffer (find-file \"test-data/Empty.idr\")))\n (should buffer)\n (with-current-buffer buffer\n (idris-run)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (should idris-process)\n (should idris-connection))\n (idris-delete-ibc t)\n (kill-buffer))\n (idris-quit))\n\n(ert-deftest idris-test-idris-quit ()\n \"Ensure that running Idris and quitting doesn't leave behind unwanted buffers.\"\n (let ((before (normalised-buffer-list))\n (idris-log-events nil))\n (idris-repl)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (idris-quit)\n (let* ((after (normalised-buffer-list))\n (extra (cl-set-difference after before)))\n (should (= (length extra) 0)))))\n\n(ert-deftest idris-test-idris-quit-logging-enabled ()\n \"Ensure that running Idris and quitting doesn't leave behind unwanted buffers.\nIn particular, only *idris-events* should remain.\"\n (let ((before (normalised-buffer-list))\n (idris-event-buffer-name \"*idris-test-idris-events*\")\n (idris-log-events t)\n (expected-difference ))\n (idris-repl)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (idris-quit)\n (let* ((after (normalised-buffer-list))\n (extra (cl-set-difference after before)))\n (should (= (length extra) 1))\n (should (string= (buffer-name (car extra)) idris-event-buffer-name)))\n\n ;; Cleanup\n (kill-buffer idris-event-buffer-name)))\n\n(ert-deftest idris-load-file-idris-hole-show-on-load-enabled ()\n \"Test that the holes buffer is created.\"\n (let ((buffer (find-file-noselect \"test-data/MetavarTest.idr\"))\n (idris-hole-show-on-load t))\n (with-current-buffer buffer\n (idris-load-file)\n\n ;; Allow async stuff to happen\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (let ((mv-buffer (get-buffer idris-hole-list-buffer-name)))\n ;; The buffer exists and contains characters\n (should (bufferp mv-buffer))\n (should (> (buffer-size mv-buffer) 10)))\n\n ;; Clean up\n (idris-delete-ibc t)\n (kill-buffer)\n (idris-quit))))\n\n(ert-deftest idris-load-file-idris-hole-show-on-load-disabled ()\n \"Test that holes buffer is not created.\"\n (let ((buffer (find-file-noselect \"test-data/MetavarTest.idr\"))\n (idris-hole-show-on-load nil))\n (with-current-buffer buffer\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (let ((mv-buffer (get-buffer idris-hole-list-buffer-name)))\n (should-not (bufferp mv-buffer))\n (should (null mv-buffer)))\n\n ;; Clean up\n (idris-delete-ibc t)\n (kill-buffer)\n (idris-quit))))\n\n(ert-deftest idris-list-holes ()\n \"Test `idris-list-holes' command.\"\n (let ((other-buffer (find-file-noselect \"test-data/MakeWithBlock.idr\"))\n (buffer (find-file-noselect \"test-data/MetavarTest.idr\")))\n\n ;; Test that hole info is present without need to load file manually\n (with-current-buffer buffer\n (idris-list-holes)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (let ((holes-buffer (get-buffer idris-hole-list-buffer-name)))\n (should (bufferp holes-buffer))\n (should (> (buffer-size holes-buffer) 10)))\n (idris-delete-ibc t))\n\n ;; Test that the hole info is updated for the other current buffer\n (with-current-buffer other-buffer\n (idris-list-holes)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (let ((holes-buffer (get-buffer idris-hole-list-buffer-name)))\n (should (not (bufferp holes-buffer))))\n (idris-delete-ibc t))\n\n (kill-buffer buffer)\n (kill-buffer other-buffer)\n (idris-quit)))\n\n(when (string-match-p \"idris$\" idris-interpreter-path)\n (ert-deftest idris-test-proof-search ()\n \"Test that proof search works.\"\n :expected-result (if (string-match-p \"idris2$\" idris-interpreter-path)\n :failed\n :passed)\n (skip-unless (string-match-p \"idris$\" idris-interpreter-path))\n\n (let ((buffer (find-file \"test-data/ProofSearch.idr\")))\n (with-current-buffer buffer\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (goto-char (point-min))\n (re-search-forward \"search_here\")\n (goto-char (match-beginning 0))\n (idris-proof-search)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (should (looking-at-p \"lteSucc (lteSucc (lteSucc (lteSucc (lteSucc lteZero))))\"))\n (move-beginning-of-line nil)\n (delete-region (point) (line-end-position))\n (insert \"prf = ?search_here\")\n (save-buffer)\n (idris-delete-ibc t)\n (kill-buffer)))\n\n ;; More cleanup\n (idris-quit)))\n\n(ert-deftest idris-test-idris-type-search ()\n \"Test that `idris-type-search' produces output in Idris info buffer.\"\n (idris-run)\n (funcall-interactively 'idris-type-search \"Nat\")\n (with-current-buffer (get-buffer idris-info-buffer-name)\n (goto-char (point-min))\n (should (re-search-forward \"Zero\" nil t)))\n (idris-quit))\n\n(ert-deftest idris-test-idris-add-clause ()\n \"Test that `idris-add-clause' generates definition with hole.\"\n (let ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (buffer-content (with-temp-buffer\n (insert-file-contents \"test-data/AddClause.idr\")\n (buffer-string))))\n (with-current-buffer buffer\n (goto-char (point-min))\n (re-search-forward \"test :\")\n (goto-char (match-beginning 0))\n (funcall-interactively 'idris-add-clause nil)\n (should (looking-at-p \"test \\\\w+ = \\\\?test_rhs\"))\n (idris-delete-ibc t)\n\n (re-search-forward \"(-) :\")\n (goto-char (1+ (match-beginning 0)))\n (funcall-interactively 'idris-add-clause nil)\n (should (looking-at-p \"(-) = \\\\?\\\\w+_rhs\"))\n (idris-delete-ibc t)\n\n ;; Test that response with indentation (Idris2) are aligned correctly\n ;; Idris1 response: \"revAcc xs ys = ?revAcc_rhs\"\n ;; Idris2 response: \" revAcc xs ys = ?revAcc_rhs\"\n (goto-char (point-max))\n (insert \"\nmyReverse : List a -> List a\nmyReverse xs = revAcc [] xs where\n revAcc : List a -> List a -> List a\")\n (search-backward \"evAcc\")\n (funcall-interactively 'idris-add-clause nil)\n (beginning-of-line)\n (should (looking-at-p \"^ revAcc xs ys = \\\\?revAcc_rhs\"))\n\n ;; Cleanup\n (erase-buffer)\n (insert buffer-content)\n (save-buffer)\n (kill-buffer))\n (idris-quit)))\n\n(ert-deftest idris-test-idris-add-clause-lidr ()\n \"Test that `idris-add-clause' generates definition with proper indentation.\"\n :expected-result (if (string-match-p \"idris2$\" idris-interpreter-path)\n :passed\n :failed)\n (let ((buffer (find-file-noselect \"test-data/Literate.lidr\"))\n (buffer-content (with-temp-buffer\n (insert-file-contents \"test-data/Literate.lidr\")\n (buffer-string))))\n (with-current-buffer buffer\n (goto-char (point-min))\n (re-search-forward \"test :\")\n (goto-char (match-beginning 0))\n (funcall-interactively 'idris-load-file-sync)\n (funcall-interactively 'idris-add-clause nil)\n (should (looking-at-p \"> test \\\\w+ = \\\\?test_rhs\"))\n ;; Cleanup\n (idris-delete-ibc t)\n (erase-buffer)\n (insert buffer-content)\n (save-buffer)\n (kill-buffer))\n (idris-quit)))\n\n(ert-deftest idris-test-idris-refine ()\n \"Test that `idris-refine' works as expected.\"\n (let* ((buffer (find-file \"test-data/Refine.idr\"))\n (buffer-content (buffer-substring-no-properties (point-min) (point-max))))\n (goto-char (point-min))\n (search-forward \"test : T\")\n (beginning-of-line)\n (funcall-interactively 'idris-add-clause nil)\n (should (looking-at-p \"test \\\\w+ = \\\\?test_rhs\"))\n (idris-delete-ibc t)\n (search-forward \"?test\")\n (funcall-interactively 'idris-refine \"x\")\n (should (looking-at-p\n (if (>=-protocol-version 2 1)\n \"x\"\n \"?test_rhs1\")))\n\n ;; Cleanup\n (idris-delete-ibc t)\n (erase-buffer)\n (insert buffer-content)\n (save-buffer)\n (kill-buffer)\n (idris-quit)))\n\n(ert-deftest idris-test-idris-type-at-point ()\n \"Test that `idris-type-at-point' works.\"\n (let ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n file-loaded-p\n eval-args)\n (cl-flet ((idris-load-file-sync-stub () (setq file-loaded-p t) nil)\n (idris-eval-stub (&optional &rest args)\n (setq eval-args args)\n '(\"Test : Type\"\n (0 4 ((:name \"AddClause.Test\")\n (:implicit :False)\n (:key \"AQAAAAAAAAAA\")\n (:decor :type)\n (:doc-overview \"\")\n (:type \"Type\")\n (:namespace \"AddClause\")))\n (7 4 ((:decor :type)\n (:type \"Type\")\n (:doc-overview \"The type of types\")\n (:name \"Type\")))\n (7 4 ((:tt-term \"AAAAAAAAAAAHAAAAAAA\"))))))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n (unwind-protect\n (with-current-buffer buffer\n (switch-to-buffer buffer)\n (goto-char (point-min))\n (re-search-forward \"data Test\")\n (funcall-interactively 'idris-type-at-point nil)\n (should (eq file-loaded-p t))\n (should (equal eval-args '((:type-of \"Test\"))))\n (with-current-buffer idris-info-buffer-name\n (should (string-match-p \"Test : Type\" (buffer-string)))))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)\n (kill-buffer buffer)\n (idris-quit)))))\n\n(ert-deftest idris-test-idris-start-project ()\n \"Test generating valid .ipkg file.\"\n (let ((mock-project-name \"TestProject\")\n (mock-package-file-name \"test-project.ipkg\")\n (mock-source-directory \"src\")\n (mock-first-module \"TestModule\")\n (mock-directory-name \"test-start-project\"))\n (unwind-protect\n (save-window-excursion\n (cl-letf (((symbol-function 'read-string)\n (lambda (prompt &rest _)\n (cond ((string-prefix-p \"Project name:\" prompt)\n mock-project-name)\n ((string-prefix-p \"Package file name\" prompt)\n mock-package-file-name)\n ((string-prefix-p \"Source directory\" prompt)\n mock-source-directory)\n ((string-prefix-p \"First module name\" prompt)\n mock-first-module))))\n ((symbol-function 'read-directory-name)\n (lambda (&rest _) mock-directory-name)))\n (idris-start-project)\n (with-current-buffer mock-package-file-name\n (goto-char (point-min))\n (should (search-forward \"package test-project\"))\n (should (search-forward \"opts = \\\"\\\"\"))\n (should (search-forward \"sourcedir = \\\"src\\\"\"))\n (should (search-forward \"modules = TestModule\"))\n (kill-buffer))))\n (if (get-buffer (concat mock-first-module \".idr\"))\n (kill-buffer (concat mock-first-module \".idr\")))\n (delete-directory mock-directory-name t)\n (idris-quit))))\n\n(ert-deftest idris-test-idris-make-lemma ()\n \"Test `idris-make-lemma' replacing a hole with a metavariable lemma.\"\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (&optional &rest args)\n '((:metavariable-lemma\n (:replace-metavariable \"closeDistance_rhs s1 s2\")\n (:definition-type \"closeDistance_rhs : String -> String -> IO Bool\")))))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n (unwind-protect\n (progn\n (with-temp-buffer\n (insert \"closeDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = ?closeDistance_rhs\")\n (goto-char (point-min))\n (re-search-forward \"closeDistance_rh\")\n (funcall-interactively 'idris-make-lemma)\n (should (string= \"closeDistance_rhs : String -> String -> IO Bool\n\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = closeDistance_rhs s1 s2\"\n (buffer-substring-no-properties (point-min) (point-max)))))\n\n (with-temp-buffer\n (insert \"something_else\n\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = ?closeDistance_rhs\")\n (goto-char (point-min))\n (re-search-forward \"closeDistance_rh\")\n (funcall-interactively 'idris-make-lemma)\n (should (string= \"something_else\n\ncloseDistance_rhs : String -> String -> IO Bool\n\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = closeDistance_rhs s1 s2\"\n (buffer-substring-no-properties (point-min) (point-max)))))\n\n (with-temp-buffer\n (insert \"something_else\n\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = ?closeDistance_rhs\")\n (goto-char (point-min))\n (re-search-forward \"closeDistance_rh\")\n (funcall-interactively 'idris-make-lemma)\n (should (string= \"something_else\n\ncloseDistance_rhs : String -> String -> IO Bool\n\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = closeDistance_rhs s1 s2\"\n (buffer-substring-no-properties (point-min) (point-max)))))\n\n (with-temp-buffer\n (insert \"||| Check if two strings are close enough to be similar,\n||| using the namespace distance criteria.\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = ?closeDistance_rhs\")\n (goto-char (point-min))\n (re-search-forward \"closeDistance_rh\")\n (funcall-interactively 'idris-make-lemma)\n (should (string= \"closeDistance_rhs : String -> String -> IO Bool\n\n||| Check if two strings are close enough to be similar,\n||| using the namespace distance criteria.\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = closeDistance_rhs s1 s2\"\n (buffer-substring-no-properties (point-min) (point-max)))))\n\n (with-temp-buffer\n (insert \"something_else\n\n||| Check if two strings are close enough to be similar,\n||| using the namespace distance criteria.\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = ?closeDistance_rhs\")\n (goto-char (point-min))\n (re-search-forward \"closeDistance_rh\")\n (funcall-interactively 'idris-make-lemma)\n ;; (message \"%s\" (buffer-substring-no-properties (point-min) (point-max)))\n (should (string= \"something_else\n\ncloseDistance_rhs : String -> String -> IO Bool\n\n||| Check if two strings are close enough to be similar,\n||| using the namespace distance criteria.\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = closeDistance_rhs s1 s2\"\n (buffer-substring-no-properties (point-min) (point-max)))))\n\n (with-temp-buffer\n (insert \"something else\n\n-- some inline comment\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = ?closeDistance_rhs\")\n (goto-char (point-min))\n (re-search-forward \"closeDistance_rh\")\n (funcall-interactively 'idris-make-lemma)\n (should (string= \"something else\n\ncloseDistance_rhs : String -> String -> IO Bool\n\n-- some inline comment\ncloseDistance : String -> String -> IO Bool\ncloseDistance s1 s2 = closeDistance_rhs s1 s2\"\n (buffer-substring-no-properties (point-min) (point-max))))))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub))))\n\n(ert-deftest idris-filename-to-load-test ()\n \"Test `idris-filename-to-load' under different project setups.\"\n (let ((default-directory \"/some/path/to/idris-project/src/Component\")\n (idris-protocol-version 0) ;; default unless overridden\n ;; control variables that the stubs will read\n current-src-dir\n current-ipkg-files)\n\n ;; Override project-related functions once for all scenarios.\n (cl-letf (((symbol-function 'idris-ipkg-find-src-dir)\n (lambda () current-src-dir))\n ((symbol-function 'idris-find-file-upwards)\n (lambda (_ex) current-ipkg-files))\n ((symbol-function 'buffer-file-name)\n (lambda () \"/some/path/to/idris-project/src/Component/Foo.idr\")))\n\n ;; ── Scenario 1: no ipkg, no sourcedir ───────────────\n (setq current-src-dir nil\n current-ipkg-files nil\n idris-protocol-version 0)\n (let ((result (idris-filename-to-load)))\n (should (equal default-directory (car result)))\n (should (equal \"Foo.idr\" (cdr result))))\n\n ;; ── Scenario 2: ipkg sourcedir is set ───────────────\n (setq current-src-dir \"/some/path/to/idris-project/src\"\n current-ipkg-files nil\n idris-protocol-version 0)\n (let ((result (idris-filename-to-load)))\n (should (equal current-src-dir (car result)))\n (should (equal \"Component/Foo.idr\" (cdr result))))\n\n ;; ── Scenario 3: ipkg sourcedir set, protocol v>1 ────\n (setq current-src-dir \"/some/path/to/idris-project/src\"\n current-ipkg-files '(\"/some/path/to/idris-project/baz.ipkg\")\n idris-protocol-version 2)\n (let ((result (idris-filename-to-load)))\n (should (equal \"/some/path/to/idris-project\" (car result)))\n (should (equal \"src/Component/Foo.idr\" (cdr result))))\n\n ;; ── Scenario 4: multiple ipkg files, first one wins ─\n (setq current-src-dir \"/some/path/to/idris-project/src\"\n current-ipkg-files '(\"/some/path/to/idris-project/zzz.ipkg\"\n \"/some/path/to/idris-project/not-selected/baz.ipkg\")\n idris-protocol-version 2)\n (let ((result (idris-filename-to-load)))\n ;; Should pick the directory of the *first* ipkg\n (should (equal \"/some/path/to/idris-project\" (car result)))\n (should (equal \"src/Component/Foo.idr\" (cdr result)))))))\n\n(ert-deftest idris-generate-def-next ()\n \"Test `idris-generate-def-next'.\"\n (skip-unless (string-match-p \"idris2$\" idris-interpreter-path))\n (let (eval-result)\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (sexp &optional no-errors)\n (apply #'funcall eval-result)))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n (unwind-protect\n (with-temp-buffer\n (insert \"data Foo = A | B\n\ntestf : Foo -> Int\n\")\n (goto-char (point-min))\n (re-search-forward \"test\")\n (setq eval-result (list #'identity '(\"testf A = testf B\\ntestf B = testf A\")))\n (funcall-interactively 'idris-generate-def)\n\n (setq eval-result (list #'identity '(\"testf A = 1\\ntestf B = 2\")))\n (funcall-interactively 'idris-generate-def-next)\n (should (string= \"data Foo = A | B\n\ntestf : Foo -> Int\ntestf A = 1\ntestf B = 2\n\"\n (buffer-substring-no-properties (point-min) (point-max))))\n (setq eval-result (list #'identity '(\"third definition\")))\n (funcall-interactively 'idris-generate-def-next)\n (message \"%s\" (buffer-substring-no-properties (point-min) (point-max)))\n (should (string= \"data Foo = A | B\n\ntestf : Foo -> Int\nthird definition\n\"\n (buffer-substring-no-properties (point-min) (point-max))))\n (setq eval-result (list #'error \"%s (synchronous Idris evaluation failed)\" \"No more results\"))\n (should-error (funcall-interactively 'idris-generate-def-next)))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)))))\n\n;; Tests by Yasuhiko Watanabe\n;; https://github.com/idris-hackers/idris-mode/pull/537/files\n(idris-ert-command-action \"test-data/CaseSplit.idr\" idris-case-split idris-test-eq-buffer)\n(idris-ert-command-action \"test-data/MakeLemma.idr\" idris-make-lemma idris-test-eq-buffer)\n(when (string-match-p \"idris2$\" idris-interpreter-path)\n (idris-ert-command-action \"test-data/GenerateDef.idr\" idris-generate-def idris-test-eq-buffer))\n(idris-ert-command-action2 \"test-data/AddClause.idr\" idris-add-clause idris-test-eq-buffer)\n\n(provide 'idris-commands-test)\n;;; idris-commands-test.el ends here\n" }, { "path": "test/idris-info-test.el", "content": ";;; idris-info-test.el --- Tests related to Idris info buffer -*- lexical-binding: t -*-\n;; Copyright (C) 2022 Marek L.\n\n;; Author: Marek L \n;; Keywords: languages, Idris, help-mode, Ert\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Code:\n\n(require 'ert)\n(require 'idris-info)\n\n(ert-deftest idris-show-info ()\n \"Test displaying information in `idris-info-buffer'.\"\n (let ((info-str \"Bool : Type\")\n (info-spans '((0 4 ((:name \"Prelude.Bool.Bool\")\n (:implicit :False)\n (:key \"AQA\")\n (:decor :type)\n (:doc-overview \"Boolean Data Type\")\n (:type \"Type\")\n (:namespace \"Prelude.Bool\")))\n (7 4 ((:decor :type)\n (:type \"Type\")\n (:doc-overview \"The type of types\")\n (:name \"Type\")))\n (7 4 ((:tt-term \"AAA\"))))))\n\n (idris-show-info info-str info-spans)\n\n (should (window-valid-p (get-buffer-window (get-buffer idris-info-buffer-name))))\n\n (with-current-buffer (get-buffer idris-info-buffer-name)\n (should (string-match-p info-str (buffer-string))))\n ;; TODO: Assert styling, context menu etc.\n\n ;; Cleanup\n (kill-buffer idris-info-buffer-name)))\n\n(ert-deftest idris-info-buffer-history ()\n \"Test displaying information in `idris-info-buffer'.\"\n (let ((info-str \"First information\")\n (info-str2 \"Second information\"))\n\n (idris-show-info info-str)\n\n (with-current-buffer (get-buffer idris-info-buffer-name)\n (should (string-match-p info-str (buffer-string)))\n (should (not (string-match-p \"back\" (buffer-string))))\n\n (idris-show-info info-str2)\n (should (string-match-p info-str2 (buffer-string)))\n (should (string-match-p \"back\" (buffer-string)))\n (help-go-back)\n\n (should (string-match-p info-str (buffer-string)))\n (should (string-match-p \"forward\" (buffer-string))))\n\n ;; Cleanup\n (kill-buffer idris-info-buffer-name)))\n\n(provide 'idris-info-test)\n\n;;; idris-info-test.el ends here\n" }, { "path": "test/idris-navigate-test.el", "content": ";;; idris-navigate-test.el --- Tests for idris-navigate -*- lexical-binding: t -*-\n\n(require 'idris-mode)\n(require 'idris-navigate)\n\n(require 'ert)\n(require 'idris-test-utils)\n\n;;; Code:\n\n(ert-deftest idris-backard-toplevel-navigation-test-2pTac9 ()\n \"Test idris-backard-toplevel navigation command.\"\n (idris-test-with-temp-buffer\n \"interface DataStore (m : Type -> Type) where\n data Store : Access -> Type\n\n connect : ST m Var [add (Store LoggedOut)]\n disconnect : (store : Var) -> ST m () [remove store (Store LoggedOut)]\n\n readSecret : (store : Var) -> ST m String [store ::: Store LoggedIn]\n login : (store : Var) ->\n ST m LoginResult [store ::: Store LoggedOut :->\n (\\\\res => Store (case res of\n OK => LoggedIn\n BadPassword => LoggedOut))]\n logout : (store : Var) ->\n ST m () [store ::: Store LoggedIn :-> Store LoggedOut]\n\ngetData : (ConsoleIO m, DataStore m) =>\n (failcount : Var) -> ST m () [failcount ::: State Integer]\ngetData failcount\n = do st <- call connect\n OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n disconnect st\n getData failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n disconnect st\n getData failcount\n\ngetData2 : (ConsoleIO m, DataStore m) =>\n (st, failcount : Var) ->\n ST m () [st ::: Store {m} LoggedOut, failcount ::: State Integer]\ngetData2 st failcount\n = do OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n getData2 st failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n getData2 st failcount\"\n (goto-char (point-max))\n (idris-backward-toplevel)\n (should (looking-at \"getData2 st\"))\n ;; (goto-char (point-max))\n (search-backward \"Number\")\n (idris-backward-toplevel)\n (should (looking-at \"getData failcount\"))\n (search-backward \"LoggedIn\")\n (idris-backward-toplevel)\n (should (looking-at \"interface DataStore\"))\n ))\n\n(ert-deftest idris-forward-toplevel-navigation-test-2pTac9 ()\n \"Test idris-forard-toplevel navigation command.\"\n (idris-test-with-temp-buffer-point-min\n \"interface DataStore (m : Type -> Type) where\n data Store : Access -> Type\n\n connect : ST m Var [add (Store LoggedOut)]\n disconnect : (store : Var) -> ST m () [remove store (Store LoggedOut)]\n\n readSecret : (store : Var) -> ST m String [store ::: Store LoggedIn]\n login : (store : Var) ->\n ST m LoginResult [store ::: Store LoggedOut :->\n (\\\\res => Store (case res of\n OK => LoggedIn\n BadPassword => LoggedOut))]\n logout : (store : Var) ->\n ST m () [store ::: Store LoggedIn :-> Store LoggedOut]\n\ngetData : (ConsoleIO m, DataStore m) =>\n (failcount : Var) -> ST m () [failcount ::: State Integer]\ngetData failcount\n = do st <- call connect\n OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n disconnect st\n getData failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n disconnect st\n getData failcount\n\ngetData2 : (ConsoleIO m, DataStore m) =>\n (st, failcount : Var) ->\n ST m () [st ::: Store {m} LoggedOut, failcount ::: State Integer]\ngetData2 st failcount\n = do OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n getData2 st failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n getData2 st failcount\"\n (search-forward \"DataStore\")\n (idris-forward-toplevel)\n (should (empty-line-p))\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (should (looking-back \"Store LoggedOut]\" (line-beginning-position)))\n (idris-forward-toplevel)\n (should (looking-at \"getData failcount\"))\n (idris-forward-toplevel)\n (should (empty-line-p))\n (skip-chars-backward \" \\t\\r\\n\\f\")\n (should (looking-back \"getData failcount\" (line-beginning-position)))\n ;; (goto-char (point-max))\n (search-forward \"Number\")\n (idris-forward-toplevel)\n (should (looking-back \"getData2 st failcount\" (line-beginning-position)))\n ))\n\n(ert-deftest idris-backard-statement-navigation-test-2pTac9 ()\n \"Test idris-backard-statement navigation command.\"\n (idris-test-with-temp-buffer\n \"interface DataStore (m : Type -> Type) where\n data Store : Access -> Type\n\n connect : ST m Var [add (Store LoggedOut)]\n disconnect : (store : Var) -> ST m () [remove store (Store LoggedOut)]\n\n readSecret : (store : Var) -> ST m String [store ::: Store LoggedIn]\n login : (store : Var) ->\n ST m LoginResult [store ::: Store LoggedOut :->\n (\\\\res => Store (case res of\n OK => LoggedIn\n BadPassword => LoggedOut))]\n logout : (store : Var) ->\n ST m () [store ::: Store LoggedIn :-> Store LoggedOut]\n\ngetData : (ConsoleIO m, DataStore m) =>\n (failcount : Var) -> ST m () [failcount ::: State Integer]\ngetData failcount\n = do st <- call connect\n OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n disconnect st\n getData failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n disconnect st\n getData failcount\n\ngetData2 : (ConsoleIO m, DataStore m) =>\n (st, failcount : Var) ->\n ST m () [st ::: Store {m} LoggedOut, failcount ::: State Integer]\ngetData2 st failcount\n = do OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n getData2 st failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n getData2 st failcount\"\n (goto-char (point-max))\n (idris-backward-statement)\n (should (looking-at \"getData2 st\"))\n (search-backward \"Number\")\n (idris-backward-statement)\n (should (looking-at \"putStrLn (\"))\n (idris-backward-statement)\n (should (looking-at \"write failcount\"))\n (search-backward \"BadPassword\")\n (idris-backward-statement)\n (should (looking-at \"| BadPassword\"))\n (idris-backward-statement)\n (should (looking-at \"= do OK\"))\n (idris-backward-statement)\n (should (looking-at \"getData2 st\"))\n (idris-backward-statement)\n (should (looking-at \"ST m ()\"))\n ))\n\n(ert-deftest idris-forward-statement-navigation-test-2pTac9 ()\n \"Test idris-forard-statement navigation command.\"\n (idris-test-with-temp-buffer-point-min\n \"interface DataStore (m : Type -> Type) where\n data Store : Access -> Type\n\n connect : ST m Var [add (Store LoggedOut)]\n disconnect : (store : Var) -> ST m () [remove store (Store LoggedOut)]\n\n readSecret : (store : Var) -> ST m String [store ::: Store LoggedIn]\n login : (store : Var) ->\n ST m LoginResult [store ::: Store LoggedOut :->\n (\\\\res => Store (case res of\n OK => LoggedIn\n BadPassword => LoggedOut))]\n logout : (store : Var) ->\n ST m () [store ::: Store LoggedIn :-> Store LoggedOut]\n\ngetData : (ConsoleIO m, DataStore m) =>\n (failcount : Var) -> ST m () [failcount ::: State Integer]\ngetData failcount\n = do st <- call connect\n OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n disconnect st\n getData failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n disconnect st\n getData failcount\n\ngetData2 : (ConsoleIO m, DataStore m) =>\n (st, failcount : Var) ->\n ST m () [st ::: Store {m} LoggedOut, failcount ::: State Integer]\ngetData2 st failcount\n = do OK <- login st\n | BadPassword => do putStrLn \\\"Failure\\\"\n fc <- read failcount\n write failcount (fc + 1)\n putStrLn (\\\"Number of failures: \\\" ++ show (fc + 1))\n getData2 st failcount\n secret <- readSecret st\n putStrLn (\\\"Secret is: \\\" ++ show secret)\n logout st\n getData2 st failcount\"\n (search-forward \"DataStore\")\n (idris-forward-statement)\n (should (looking-back \"where\" (line-beginning-position)))\n (idris-forward-statement)\n (should (looking-back \"Access -> Type\" (line-beginning-position)))\n (idris-forward-statement)\n (should (looking-back \"Store LoggedOut)]\" (line-beginning-position)))\n ))\n\n(provide 'idris-navigate-test)\n;;; idris-navigate-test.el ends here\n" }, { "path": "test/idris-repl-test.el", "content": ";;; idris-repl-test.el --- Tests for idris-repl -*- lexical-binding: t -*-\n\n(require 'ert)\n(require 'idris-repl)\n\n;; in order to use `idris-quit`\n;; TODO: rewrite the test so it is not needed\n(require 'idris-commands)\n\n(ert-deftest idris-repl-buffer ()\n ;; Useful while debugging\n ;; (and (get-buffer idris-repl-buffer-name) (kill-buffer idris-repl-buffer-name))\n (let ((idris-repl-prompt-style 'short))\n (cl-flet ((idris-get-idris-version-stub () '((1 3 3))))\n (advice-add 'idris-get-idris-version :override #'idris-get-idris-version-stub)\n\n (unwind-protect\n (let* ((buffer (idris-repl-buffer)))\n (with-current-buffer buffer\n (display-buffer buffer)\n\n ;; Assert the short default prompt is present\n (should (string-match-p \"λΠ> \"\n (buffer-substring-no-properties (point-min) (point-max))))\n\n (with-selected-window (get-buffer-window)\n (should (eq (point) (point-max))))\n\n (idris-repl-update-prompt \"TTT\")\n (with-selected-window (get-buffer-window)\n (should (eq (point) (point-max))))\n\n ;; Assert the prompt did not change after update\n (should (string-match-p \"λΠ> \"\n (buffer-substring-no-properties (point-min) (point-max))))\n\n ;; when Idris repl prompt style is not 'short\n (let ((idris-repl-prompt-style 'long))\n (idris-repl-update-prompt \"FooBar\")\n\n (with-selected-window (get-buffer-window)\n (should (eq (point) (point-max))))\n\n ;; Assert the prompt does change after update\n (should (string-match-p \"FooBar> \"\n (buffer-substring-no-properties (point-min) (point-max)))))\n\n ;; Cleanup\n (kill-buffer))\n (advice-remove 'idris-get-idris-version #'idris-get-idris-version-stub)\n (setq idris-prompt-string nil))))))\n\n(ert-deftest idris-repl-event-hook-function ()\n (let* ((msg \"We are about to implicitly bind the following lowercase names.\")\n (event `(:warning\n (\"Flycheck.idr\"\n (4 2)\n (4 3)\n ,msg\n ((186 17 ((:decor :type)))\n (205 3 ((:decor :type)))\n (235 3 ((:decor :type)))\n (262 3 ((:decor :type)))\n (268 3 ((:decor :type)))\n (302 3 ((:decor :type)))\n (328 1 ((:text-formatting :bold) (:decor :postulate)))))\n 69))\n (output (cadr event))\n (idris-warnings-printing '(warnings-repl warnings-tree)))\n ;; start repl and create connection to Idris\n (idris-repl)\n (idris-repl-event-hook-function event)\n (with-current-buffer \"*idris-repl*\"\n ;; Assert\n (let ((str (buffer-substring-no-properties (point-min) (point-max))))\n (should (string-match-p \"Flycheck.idr\" str))\n (should (string-match-p msg str))))\n (idris-quit)))\n\n;; https://github.com/idris-hackers/idris-mode/issues/443\n(provide 'idris-repl-test)\n\n;;; idris-repl-test.el ends here\n" }, { "path": "test/idris-test-utils.el", "content": ";;; idris-test-utils.el --- Tests utility for idris-mode -*- lexical-binding: t -*-\n\n;; Copyright (C) 2021 Yasuhiko Watanabe\n\n;; Author: Yasuhiko Watanabe\n;; Keywords: languages\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; This is a collection of utilities used in tests for idris-mode.\n\n;;; Code:\n(require 'subr-x)\n\n(defun idris-test-run-goto-char (test-fun &rest args)\n \"To run commands like idris-case-split, we have to move the cursor to an appropriate location.\nThis funtion moves the cursor to the next line of first + inside comment starting on the first column.\n\nmodule Test\ndata Cases = A | B\ntest : Cases -> Cases\n-- +++\ntest var = ?cases_rhs\n ^\n |\n +--------- cursor moves here and apply test-fun to args\n\"\n (progn\n (goto-char (point-min))\n (search-forward-regexp \"^--.*\\\\+\")\n (goto-char (1- (point)))\n (let ((col (current-column)))\n (forward-line)\n (move-to-column col))\n (apply test-fun args)\n ))\n\n\n;; Under consideration.\n(defmacro idris-ert-command-action (test-case test-fun buffer-p)\n \"Common test code to run idris-mode command which modifies the buffer.\nIt is used for the command\n- if command succeeds, it modifies buffer and stays in original buffer.\n- otherwise test failure\nAs this is not for a test of Idris itself, we do not care the results.\"\n `(ert-deftest ,(intern (concat (symbol-name test-fun) \"/\" (string-remove-suffix \".idr\" test-case))) ()\n\n (let ((buffer (find-file ,test-case)))\n (with-current-buffer buffer\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1)) ;;\n (idris-test-run-goto-char (function ,test-fun))\n (let ((this-buffer (current-buffer)))\n (should (,buffer-p buffer this-buffer))))\n (idris-delete-ibc t)\n (not-modified)\n (kill-buffer))\n (idris-quit)))\n\n(defmacro idris-ert-command-action2 (test-case test-fun buffer-p)\n \"Common test code to run idris-mode command which modifies the buffer.\nIt is used for the command\n- if command succeeds, it modifies buffer and stays in original buffer.\n- otherwise test failure\nAs this is not for a test of Idris itself, we do not care the results.\"\n `(ert-deftest ,(intern (concat (symbol-name test-fun) \"/\" (string-remove-suffix \".idr\" test-case))) ()\n\n (let ((buffer (find-file ,test-case)))\n (with-current-buffer buffer\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1)) ;;\n (idris-test-run-goto-char (function ,test-fun) nil)\n (let ((this-buffer (current-buffer)))\n (should (,buffer-p buffer this-buffer))))\n (not-modified)\n (kill-buffer))\n (idris-quit)))\n\n\n(defun idris-test-eq-buffer (orig modified)\n (and (buffer-modified-p orig) (eq orig modified)))\n\n(defmacro check-rest (&rest args)\n `(listp (quote ,args)))\n\n(defmacro idris-test-with-temp-buffer-point-min (contents &rest body)\n \"Create temp buffer in `idris-mode' inserting CONTENTS.\nBODY is code to be executed within the temp buffer. Point is\n at the beginning of buffer.\"\n (declare (indent 1) (debug t))\n `(with-temp-buffer\n ;; requires idris.el\n ;; (and (featurep 'semantic) (unload-feature 'semantic))\n ;; (and (featurep 'idris) (unload-feature 'idris))\n (let (hs-minor-mode)\n (insert ,contents)\n (idris-mode)\n (goto-char (point-min))\n ;; (message \"(current-buffer): %s\" (current-buffer))\n (when idris-debug-p (switch-to-buffer (current-buffer))\n ;; (font-lock-fontify-buffer)\n (font-lock-ensure)\n )\n ,@body)\n (sit-for 0.1)))\n\n(defmacro idris-test-with-temp-buffer (contents &rest body)\n \"Create temp buffer in `idris-mode' inserting CONTENTS.\nBODY is code to be executed within the temp buffer. Point is\n at the end of buffer.\"\n (declare (indent 1) (debug t))\n `(with-temp-buffer\n ;; (and (featurep 'idris) (unload-feature 'idris))\n (let (hs-minor-mode)\n (insert ,contents)\n (idris-mode)\n (when idris-debug-p (switch-to-buffer (current-buffer))\n ;; (font-lock-fontify-buffer)\n (font-lock-ensure)\n )\n ;; (message \"ERT %s\" (point))\n ,@body)\n (sit-for 0.1)))\n\n(provide 'idris-test-utils)\n;;; idris-test-utils.el ends here\n" }, { "path": "test/idris-tests.el", "content": ";;; idris-tests.el --- Tests for idris-mode -*- lexical-binding: t -*-\n\n;; Copyright (C) 2014 David Raymond Christiansen\n\n;; Author: David Raymond Christiansen \n;; Keywords: languages\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; This is a collection of simple tests for idris-mode.\n;; Structuring:\n;; Packages modules (files) have their own corresponding test files.\n;; idris-commands.el -> idris-commands-test.el\n;; idris-navigate.el -> idris-navigate-test.el\n;; ..\n;; Tests for modules that are too small or not yet covered enough by tests\n;; can be left as part of the idris-tests.el\n;;\n;; Naming tests:\n;; `ert-deftest idris-X-Y`\n;; where X stands for function or state to be tested\n;; and Y for additional context or behaviour.\n;; Example:\n;; `ert-deftest idris-quit`\n;; `ert-deftest idris-quit-logging-enabled`\n\n;;; Code:\n\n;; Implementations\n(require 'idris-mode)\n\n;; Testing\n;; load-file-name is present in batch mode and buffer-file-name in interactive\n(let ((test-dir (file-name-directory (or load-file-name (buffer-file-name)))))\n (add-to-list 'load-path test-dir)\n ;; In batch mode default dir points to ../ and causing issues with saving\n ;; Idris fixtures so we set it to the test-dir to avoid the issues.\n (setq default-directory test-dir))\n\n(require 'ert)\n(require 'seq)\n\n(ert-deftest trivial-test ()\n (should t))\n\n(ert-deftest idris-editor-port ()\n (let ((output \"Can't find import Prelude\\n37072\\n\"))\n (should (string-match idris-process-port-output-regexp output))\n (should (string= \"Can't find import Prelude\\n\" (match-string 1 output)))\n (should (string= \"37072\" (match-string 2 output))))\n (let ((output \"37072\\n\"))\n (should (string-match idris-process-port-output-regexp output))\n (should (null (match-string 1 output)))\n (should (string= \"37072\" (match-string 2 output)))))\n\n(ert-deftest idris-test-find-cmdline-args ()\n \"Test that `idris-mode' calculates command line arguments from .ipkg files.\"\n ;; Outside of a project, none are found\n (let ((buffer (find-file \"test-data/ProofSearch.idr\")))\n (with-current-buffer buffer\n (should (null (idris-ipkg-flags-for-current-buffer)))\n (kill-buffer)))\n ;; Inside of a project, the correct ones are found\n (let ((buffer (find-file \"test-data/cmdline/src/Command/Line/Test.idr\")))\n (with-current-buffer buffer\n (should (equal (idris-ipkg-flags-for-current-buffer)\n (list \"-p\" \"effects\")))\n (kill-buffer))))\n\n(ert-deftest idris-test-error-buffer ()\n \"Test that loading a type-incorrect Idris buffer results in an error message buffer.\"\n (let ((buffer (find-file-noselect \"test-data/TypeError.idr\")))\n (with-current-buffer buffer\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (kill-buffer))\n (should (get-buffer idris-notes-buffer-name))\n (with-current-buffer (get-buffer idris-notes-buffer-name)\n (goto-char (point-min))\n (should (re-search-forward \"Nat\" nil t))) ;; check that the buffer has something error-like\n (idris-quit)))\n\n(ert-deftest idris-test-ipkg-packages-with-underscores-and-dashes ()\n \"Test that loading an ipkg file can have dependencies on packages with _ or - in the name.\"\n (let ((buffer (find-file-noselect \"test-data/package-test/Packaging.idr\")))\n (with-current-buffer buffer\n (should (equal '(\"-p\" \"idris-free\" \"-p\" \"recursion_schemes\")\n (idris-ipkg-pkgs-flags-for-current-buffer)))\n (kill-buffer buffer))))\n\n(ert-deftest idris-test-warning-overlay ()\n \"Test that `idris-warning-overaly-point' works as expected.\"\n (let* ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (warning '(\"AddClause.idr\" (5 7) (5 17) \"Some warning message\" ()))\n (idris-raw-warnings '())\n (idris-process-current-working-directory (file-name-directory (buffer-file-name buffer)))\n (expected-position)\n (expected-overlay))\n (with-current-buffer buffer\n (goto-char (point-min))\n (re-search-forward \"data Test\")\n (setq expected-position (point))\n\n (idris-warning-overlay warning)\n\n ;; Assert that the point position does not change\n ;; https://github.com/idris-community/idris2-mode/issues/36\n (should (eq (point) expected-position))\n\n ;; Assert side effect\n (should (not (null idris-raw-warnings)))\n\n ;; Assert that overlay was added\n (setq expected-overlay (car (overlays-in (point-min) (point-max))))\n (should (not (null expected-overlay)))\n (should (string= (overlay-get expected-overlay 'help-echo)\n \"Some warning message\"))\n ;; Cleanup\n (idris-delete-ibc t)\n (kill-buffer))))\n\n(defun idris-buffer-contains-semantic-highlighting-p ()\n (seq-find (lambda (overlay) (overlay-get overlay 'idris-source-highlight))\n (overlays-in (point-min) (point-max))))\n\n(ert-deftest idris-semantic-highlighthing ()\n (let* ((buffer (find-file \"test-data/AddClause.idr\"))\n (buffer-content (buffer-substring-no-properties (point-min) (point-max))))\n (idris-run)\n (dotimes (_ 5) (accept-process-output nil 0.1))\n (unwind-protect\n (progn\n (goto-char (point-max))\n (let ((idris-semantic-source-highlighting nil))\n (insert \" \") ;; to make the buffer dirty\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (should (not (idris-buffer-contains-semantic-highlighting-p))))\n\n (let ((idris-semantic-source-highlighting t))\n (insert \" \") ;; to make the buffer dirty\n (idris-load-file)\n (dotimes (_ 30) (accept-process-output nil 0.1))\n (should (idris-buffer-contains-semantic-highlighting-p))\n ;;cleanup\n (mapc 'delete-overlay (overlays-in (point-min) (point-max))))\n\n (let ((idris-semantic-source-highlighting t)\n (idris-semantic-source-highlighting-max-buffer-size 8))\n (insert \" \") ;; to make the buffer dirty\n (idris-load-file)\n (dotimes (_ 10) (accept-process-output nil 0.1))\n (should (not (idris-buffer-contains-semantic-highlighting-p)))\n (with-current-buffer \"*Messages*\"\n (should (string-match-p \"Semantic source highlighting is disabled for the current buffer.\"\n (buffer-substring-no-properties (point-min) (point-max)))))))\n\n ;; Cleanup (Tear down)\n (dotimes (_ 5) (accept-process-output nil 0.1))\n (idris-delete-ibc t)\n (erase-buffer)\n (insert buffer-content)\n (save-buffer)\n (kill-buffer)))\n (idris-quit))\n\n(load \"idris-commands-test\")\n(load \"idris-navigate-test\")\n(load \"idris-repl-test\")\n(load \"idris-xref-test\")\n(load \"idris-info-test\")\n\n(provide 'idris-tests)\n;;; idris-tests.el ends here\n" }, { "path": "test/idris-xref-test.el", "content": ";;; idris-xref-test.el --- Tests for Idris Xref backend -*- lexical-binding: t -*-\n;; Copyright (C) 2022 Marek L.\n\n;; Author: Marek L \n;; Keywords: languages, Idris, Xref, Ert\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Code:\n\n(require 'ert)\n(require 'idris-xref)\n(eval-when-compile (require 'cl-lib))\n\n(ert-deftest idris-xref-backend-definitions--error-when-no-connection ()\n \"Test that the file is loaded before making search for definition.\"\n (let ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n error-msg)\n (with-current-buffer buffer\n (goto-char (point-min))\n (search-forward \": Test\")\n (condition-case err\n (funcall-interactively 'xref-find-definitions \"Test\")\n (error (setq error-msg (error-message-string err)))))\n\n (should (string-match-p \"Buffer AddClause.idr has no process\" error-msg))\n\n ;; Cleanup\n (kill-buffer buffer)))\n\n(ert-deftest idris-xref-backend-definitions--not-supported-on-Idris-1 ()\n \"Test that user error raised when invoking `xref-find-definitions' used on Idris1.\"\n (let ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (stub-err-msg \"did not understand (synchronous Idris evaluation failed)\")\n error-msg)\n\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (&optional &rest _args)\n (user-error stub-err-msg)))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n\n (unwind-protect\n (with-current-buffer buffer\n (goto-char (point-min))\n (search-forward \": Test\")\n\n (condition-case err\n (funcall-interactively 'xref-find-definitions \"Test\")\n (error (setq error-msg (error-message-string err)))))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)))\n\n (should (string-match-p stub-err-msg error-msg))\n\n ;; Cleanup\n (kill-buffer buffer)))\n\n(ert-deftest idris-xref-backend-definitions--no-results ()\n \"Test that an user error message is displayed when no definition found.\"\n ;; Arrange\n (let ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (idris-protocol-version 3)\n error-msg)\n\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (&optional &rest _args) '()))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n\n (unwind-protect\n (with-current-buffer buffer\n (goto-char (point-min))\n (search-forward \": Test\")\n\n (condition-case err\n (funcall-interactively 'xref-find-definitions \"Test\")\n (user-error (setq error-msg (error-message-string err)))))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)))\n\n (should (string-match-p \"No definitions found for: Test\" error-msg))\n\n ;; Cleanup\n (kill-buffer buffer)))\n\n(ert-deftest idris-xref-backend-definitions--one-existing-file-result ()\n \"Test that point jumps to location in file from result.\"\n (let* ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (idris-protocol-version 3)\n (eval-result `(((\"AddClause.Test\"\n (:filename ,(buffer-file-name buffer))\n (:start 2 0)\n (:end 2 17))))))\n\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (&optional &rest _args) eval-result))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n\n (unwind-protect\n (with-current-buffer buffer\n (goto-char (point-min))\n (search-forward \": Test\")\n (should (eq 6 (line-number-at-pos (point))))\n\n (funcall-interactively 'xref-find-definitions \"Test\")\n\n (should (eq 3 (line-number-at-pos (point)))))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)))\n\n ;; Cleanup\n (kill-buffer buffer)))\n\n(ert-deftest idris-xref-backend-definitions--one-no-real-file-result ()\n \"Test that the term and filename as message is displayed.\"\n (let* ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (idris-protocol-version 3)\n (eval-result `(((\"prim__lte_Bits64\"\n (:filename \"(Interactive)\")\n (:start 0 0)\n (:end 0 0)))))\n error-msg)\n\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (&optional &rest _args) eval-result))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n\n (unwind-protect\n (with-current-buffer buffer\n (goto-char (point-min))\n (search-forward \": Test\")\n\n (condition-case err\n (funcall-interactively 'xref-find-definitions \"Test\")\n (user-error (setq error-msg (error-message-string err)))))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)))\n\n (should (string-match-p \"prim__lte_Bits64 : (Interactive)\" error-msg))\n\n ;; Cleanup\n (kill-buffer buffer)))\n\n(ert-deftest idris-xref-backend-definitions--multiple-results ()\n \"Test that results are listed in *xref* buffer.\"\n (let* ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (idris-protocol-version 3)\n (eval-result `(((\"prim__lte_Bits64\"\n (:filename \"(Interactive)\")\n (:start 0 0)\n (:end 0 0))\n (\"Prelude.Num.(-)\"\n (:filename \"(File-Not-Found)\")\n (:start 30 2)\n (:end 30 5))\n (\"AddClause.(-)\"\n (:filename \"AddClause.idr\")\n (:start 10 0)\n (:end 10 9))))))\n (cl-flet ((idris-load-file-sync-stub () nil)\n (idris-eval-stub (&optional &rest _args) eval-result))\n (advice-add 'idris-load-file-sync :override #'idris-load-file-sync-stub)\n (advice-add 'idris-eval :override #'idris-eval-stub)\n\n (unwind-protect\n (with-current-buffer buffer\n (goto-char (point-min))\n (search-forward \": Test\")\n\n (funcall-interactively 'xref-find-definitions \"Test\"))\n\n (advice-remove 'idris-load-file-sync #'idris-load-file-sync-stub)\n (advice-remove 'idris-eval #'idris-eval-stub)))\n\n (with-current-buffer \"*xref*\"\n ;; Assert\n (let ((str (buffer-substring-no-properties (point-min) (point-max))))\n (should (string-match-p \"AddClause.(-)\" str))\n (should (string-match-p \"11:\" str))\n (should (string-match-p \"AddClause.idr\" str))\n (should (string-match-p \"Prelude.Num.(-)\" str))\n (should (string-match-p \"prim__lte_Bits64\" str)))\n (kill-buffer))\n\n ;; Cleanup\n (kill-buffer buffer)))\n\n(ert-deftest idris-xref-normalise ()\n \"Test normalisation of results from Idris compiler.\nThe updated candidate should have absolute path to file when possible\nand coordinates indexed as expected by Emacs.\"\n (let* ((buffer (find-file-noselect \"test-data/AddClause.idr\"))\n (abs-buffer-file-path (buffer-file-name buffer)))\n (kill-buffer buffer)\n\n (let* ((candidate `(\"AddClause.Test\"\n (:filename ,abs-buffer-file-path)\n (:start 2 0)\n (:end 2 17)))\n (result (idris-xref-normalise candidate)))\n\n (pcase-let ((`(,_term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,_end-line ,_end-col))\n result))\n (should (string= fn abs-buffer-file-path))\n (should (eq start-line 3))\n (should (eq start-col 0))))\n\n ;; Test that the filepath is reconstructed from term\n ;; and Idris process current working directory\n (let* ((candidate `(\"AddClause.Test\"\n (:filename \"(File-Not-Found)\")\n (:start 2 0)\n (:end 2 17)))\n (idris-process-current-working-directory (file-name-directory abs-buffer-file-path))\n (result (idris-xref-normalise candidate)))\n\n (pcase-let ((`(,_term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,_end-line ,_end-col))\n result))\n (should (string= fn abs-buffer-file-path))\n (should (eq start-line 3))\n (should (eq start-col 0))))\n\n ;; Test that the original filename returned if no success to\n ;; reconstruct real absolute file path\n (let* ((candidate `(\"AddClause.Test\"\n (:filename \"(File-Not-Found)\")\n (:start 2 0)\n (:end 2 17)))\n (idris-process-current-working-directory nil)\n (result (idris-xref-normalise candidate)))\n\n (pcase-let ((`(,_term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,_end-line ,_end-col))\n result))\n (should (string= fn \"(File-Not-Found)\"))\n (should (eq start-line 3))\n (should (eq start-col 0))))\n\n ;; Test that the filepath is reconstructed from term\n ;; and (idris-xref-idris-source-directories)\n (let* ((candidate `(\"AddClause.Test\"\n (:filename \"(File-Not-Found)\")\n (:start 2 0)\n (:end 2 17)))\n (idris-process-current-working-directory nil))\n (cl-flet ((idris-xref-idris-source-directories-stub\n ()\n (cons (file-name-directory abs-buffer-file-path) '())))\n (advice-add 'idris-xref-idris-source-directories\n :override #'idris-xref-idris-source-directories-stub)\n\n (let ((result (idris-xref-normalise candidate)))\n (pcase-let ((`(,_term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,_end-line ,_end-col))\n result))\n\n (should (string= fn abs-buffer-file-path))\n (should (eq start-line 3))\n (should (eq start-col 0))))\n (advice-remove 'idris-xref-idris-source-directories\n #'idris-xref-idris-source-directories-stub)))\n\n ;; Test that the filepath is reconstructed from term\n ;; and path from idris-xref-idris-source-locations\n (let* ((candidate `(\"AddClause.Test\"\n (:filename \"(File-Not-Found)\")\n (:start 2 0)\n (:end 2 17)))\n (idris-xref-idris-source-locations (cons (file-name-directory abs-buffer-file-path) '()))\n (result (idris-xref-normalise candidate)))\n\n (pcase-let ((`(,_term (:filename ,fn)\n (:start ,start-line ,start-col)\n (:end ,_end-line ,_end-col))\n result))\n (should (string= fn abs-buffer-file-path))\n (should (eq start-line 3))\n (should (eq start-col 0))))))\n\n(provide 'idris-xref-test)\n;;; idris-xref-test.el ends here\n" }, { "path": "test/test-data/AddClause.idr", "content": "module AddClause\n\ndata Test = A | B\n\n--++++++++++++++++\ntest : Test -> Int\n\n-- Regression test for:\n-- idris-add-clause doesn't send a message when cursor is on a dash\n-- https://github.com/idris-community/idris2-mode/issues/16\n(-) : Nat\n" }, { "path": "test/test-data/AddMissing.idr", "content": "module AddMissing\n-- (idris-test-run-goto-char #'idris-add-missing)\ndata Test = A | B\n\ntest : Test -> Int\n--++\ntest A = 1\n" }, { "path": "test/test-data/CaseSplit.idr", "content": "module CaseSplit\n-- (idris-test-run-goto-char #'idris-case-split)\n-- (idris-test-run-goto-char #'idris-case-dwim)\ndata Cases = Case1 | Case2 Int\ntestCase : Cases -> Cases\n-- +++\ntestCase var = ?c\n" }, { "path": "test/test-data/Empty.idr", "content": "" }, { "path": "test/test-data/Flycheck.idr", "content": "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 x = rhs x x\n" }, { "path": "test/test-data/GenerateDef.idr", "content": "module GenerateDef\n\n-- (idris-test-run-goto-char #'idris-generate-def)\ndata Test = A | B\n--++\ntest : Test -> Int\n\n{-\nC-c C-a\t\tidris-proof-search\nC-c C-b\t\tPrefix Command\nC-c C-c\t\tidris-case-dwim\nC-c C-d\t\tPrefix Command\nC-c C-e\t\tidris-make-lemma\nC-c C-g\t\tidris-generate-def\nC-c C-l\t\tidris-load-file\nC-c RET\t\tidris-add-missing\nC-c C-n\t\tidris-load-forward-line\nC-c C-p\t\tidris-load-backward-line\nC-c C-r\t\tidris-refine\nC-c C-s\t\tidris-add-clause\nC-c C-t\t\tidris-type-at-point\nC-c C-w\t\tidris-make-with-block\nC-c C-z\t\tidris-switch-to-repl\nC-c C-S-a\tidris-proof-search-next\nC-c C-S-g\tidris-generate-def-next\nC-c C-SPC\tprop-menu-by-completing-read\n-}\n" }, { "path": "test/test-data/Literate.lidr", "content": "> module Literate\n>\n> data Test = A | B\n>\n> test : Test -> Int\n>\n> myReverse : List a -> List a\n> myReverse xs = revAcc [] xs where\n> revAcc : List a -> List a -> List a\n\n" }, { "path": "test/test-data/MakeLemma.idr", "content": "module MakeLemma\n\n-- (idris-test-run-goto-char #'idris-make-lemma)\ndata Test = A | B\n\nmy_lemmaTest : Test -> Test\n-- +++++++++++\nmy_lemmaTest x = ?my_lemmaTest_rhs\n" }, { "path": "test/test-data/MakeWithBlock.idr", "content": "module MakeWithBlock\n\n-- (idris-test-run-goto-char #'idris-make-with-block)\n\n" }, { "path": "test/test-data/MetavarTest.idr", "content": "module MetavarTest\n\nplusComm : plus n m = plus m n\nplusComm = ?plusComm_rhs\n\nplusAssoc : plus x (plus y z) = plus (plus x y) z\nplusAssoc = ?plusAssoc_rhs\n" }, { "path": "test/test-data/ProofSearch.idr", "content": "module ProofSearch\n\nprf : 5 `LTE` 20\nprf = ?search_here\n\n" }, { "path": "test/test-data/Refine.idr", "content": "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 : Test -> Test\n" }, { "path": "test/test-data/TypeAtPoint.idr", "content": "module TypeAtPoint\n\n-- (idris-test-run-goto-char #'idris-type-at-point)\n\ntest : Int -> Integer\n\ntest2 : Int -> Integer\n--+++\ntest2 = test\n" }, { "path": "test/test-data/TypeError.idr", "content": "module TypeError\n\nfoo : Nat\nfoo = \"fnord\"\n\n\n" }, { "path": "test/test-data/cmdline/commandlinetest.ipkg", "content": "package commandlinetest\n\n-- Command line test\n-- by David Raymond Christiansen\n\nopts = \"-p effects\"\nsourcedir = src\nmodules = Command.Line.Test\n" }, { "path": "test/test-data/cmdline/src/Command/Line/Test.idr", "content": "module Command.Line.Test\n" }, { "path": "test/test-data/package-test/Packaging.idr", "content": "module Packaging\n\n" }, { "path": "test/test-data/package-test/test.ipkg", "content": "package test\n\npkgs = recursion_schemes, idris-free\n" } ]